* [PATCH] [GOMP4] OpenACC 1.0+ support in fortran front-end
@ 2014-01-23 18:01 Ilmir Usmanov
2014-01-23 18:03 ` [PATCH 1/6] " Ilmir Usmanov
2014-01-24 18:04 ` [PATCH] " Thomas Schwinge
0 siblings, 2 replies; 89+ messages in thread
From: Ilmir Usmanov @ 2014-01-23 18:01 UTC (permalink / raw)
To: gcc-patches, Thomas Schwinge, jakub
Cc: Evgeny Gavrin, GarbuzovViacheslav, Dmitri Botcharnikov
Hi all.
Jakub, could you review these patches, if they are OK to gomp-4_0-branch?
Thomas, please, have a look whether this implementation applies current
OpenACC support style.
These patches port OpenACC 1.0 support in fortran front-end from
openacc-1_0-branch to gomp-4_0-branch. In addition, they extend
middle-end infrastructure with necessary GENERIC nodes.
Patches support almost all directives (except loop) and all clauses from
the specification ver. 1.0 (without subarrays).
In addition to OpenACC version 1.0, patches add functionality from
OpenACC 2.0: enter data and exit data directives.
Patches stub gimplification of OpenACC constructs and directives, except
OACC_PARALLEL node, to prevent crashes.
I didn't port loop directive, since in openacc-1_0-branch we consider it
as OpenACC construct, like kernels or parallel. Hence, OpenACC loop and
OpenMP for directives differ. It means there are no checks in C FE (in
openacc-1_0-branch) and the functionality will be modified, in both FEs
and back-end.
As far as loop directive doesn't exist in GENERIC, fortran FE doesn't
transform it from internal EXEC_OACC_LOOP statement. Consequenly, there
are no tests to check the directive.
Lately, I'm going to port loop directive, too.
Inspite of the fact that subarrays do exist in openacc-1_0-branch, they
don't present in patches. Currently, we are using our own GENERIC nodes
to represent subarrays. I'm going to replace them with existing
functionality, like ARRAY_RANGE_REF.
Full list of supported fuctionality is the following:
Constructs/directives:
Name front-end GENERIC tests
parallel Y Y Y
kernels Y Y Y
data Y Y Y
host_data Y Y Y
loop Y N N
update Y Y Y
wait Y Y N
cache Y Y N
declare Y Y Y
kernels loop Y N N
parallel loop Y N N
enter data (2.0) Y Y Y
exit data (2.0) Y Y Y
Clauses
Name front-end GENERIC tests
async Y Y Y
wait Y Y Y
num_gangs Y Y Y
num_workers Y Y Y
vector_length Y Y Y
if Y Y Y
reduction Y Y Y
copy Y Y Y
copyin Y Y Y
copyout Y Y Y
create Y Y Y
delete (2.0) Y Y Y
present Y Y Y
present_or_copy Y Y Y
present_or_copyin Y Y Y
present_or_copyout Y Y Y
present_or_create Y Y Y
deviceptr Y Y Y
private Y Y Y
firstprivate Y Y Y
default(none) (2.0) Y N Y
collapse Y Y N
gang Y Y N
worker Y Y N
vector Y Y N
seq Y Y N
auto (2.0) Y N N
tile Y N N
independent Y Y N
device_resident Y Y N
Successfully bootstraps on x86_64 with no regressions.
OK to commit?
--
Ilmir
^ permalink raw reply [flat|nested] 89+ messages in thread
* [PATCH 2/6] [GOMP4] OpenACC 1.0+ support in fortran front-end
2014-01-23 18:03 ` [PATCH 1/6] " Ilmir Usmanov
@ 2014-01-23 18:03 ` Ilmir Usmanov
2014-01-23 18:04 ` [PATCH 3/6] " Ilmir Usmanov
2014-01-24 20:47 ` [PATCH 2/6] [GOMP4] OpenACC 1.0+ support in fortran front-end Thomas Schwinge
2014-01-24 20:31 ` [PATCH 1/6] " Thomas Schwinge
1 sibling, 2 replies; 89+ messages in thread
From: Ilmir Usmanov @ 2014-01-23 18:03 UTC (permalink / raw)
To: gcc-patches, Thomas Schwinge, jakub
Cc: Evgeny Gavrin, GarbuzovViacheslav, Dmitri Botcharnikov
[-- Attachment #1: Type: text/plain, Size: 1 bytes --]
[-- Attachment #2: 0002-OpenACC-fortran-FE-part-2.patch --]
[-- Type: text/x-diff, Size: 41069 bytes --]
From 69bf2531e4512b7cdb2feba8541de1eaf9c2aa56 Mon Sep 17 00:00:00 2001
From: Ilmir Usmanov <i.usmanov@samsung.com>
Date: Thu, 23 Jan 2014 21:05:11 +0400
Subject: [PATCH 2/6] OpenACC fortran FE part 2
---
gcc/fortran/openmp.c | 1032 +++++++++++++++++++++++++++++++++++++++++++++++++-
1 file changed, 1019 insertions(+), 13 deletions(-)
diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index 6c4dccb..ce13e52 100644
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -69,11 +69,36 @@ gfc_free_omp_clauses (gfc_omp_clauses *c)
gfc_free_expr (c->final_expr);
gfc_free_expr (c->num_threads);
gfc_free_expr (c->chunk_size);
- for (i = 0; i < OMP_LIST_NUM; i++)
+ gfc_free_expr (c->async_expr);
+ gfc_free_expr (c->gang_expr);
+ gfc_free_expr (c->worker_expr);
+ gfc_free_expr (c->vector_expr);
+ gfc_free_expr (c->num_gangs_expr);
+ gfc_free_expr (c->num_workers_expr);
+ gfc_free_expr (c->vector_length_expr);
+ gfc_free_expr (c->non_clause_wait_expr);
+
+ for (i = 0; i < OACC_LIST_NUM; i++)
gfc_free_namelist (c->lists[i]);
+
+ gfc_free_exprlist (c->waitlist);
+
free (c);
}
+/* Free expression list. */
+void
+gfc_free_exprlist (gfc_exprlist *list)
+{
+ gfc_exprlist *n;
+
+ for (; list; list = n)
+ {
+ n = list->next;
+ free (list);
+ }
+}
+
/* Match a variable/common block list and construct a namelist from it. */
static match
@@ -169,6 +194,87 @@ cleanup:
return MATCH_ERROR;
}
+static match
+match_oacc_exprlist (const char *str, gfc_exprlist **list, bool allow_asterisk)
+{
+ gfc_exprlist *head, *tail, *p;
+ locus old_loc;
+ gfc_expr *expr;
+ match m;
+
+ head = tail = NULL;
+
+ old_loc = gfc_current_locus;
+
+ m = gfc_match (str);
+ if (m != MATCH_YES)
+ return m;
+
+ for (;;)
+ {
+ m = gfc_match_expr (&expr);
+ if (m == MATCH_YES || allow_asterisk)
+ {
+ p = gfc_get_exprlist ();
+ if (head == NULL)
+ head = tail = p;
+ else
+ {
+ tail->next = p;
+ tail = tail->next;
+ }
+ if (m == MATCH_YES)
+ tail->expr = expr;
+ else if (gfc_match (" *") != MATCH_YES)
+ goto syntax;
+ goto next_item;
+ }
+ if (m == MATCH_ERROR)
+ goto cleanup;
+ goto syntax;
+
+ next_item:
+ if (gfc_match_char (')') == MATCH_YES)
+ break;
+ if (gfc_match_char (',') != MATCH_YES)
+ goto syntax;
+ }
+
+ while (*list)
+ list = &(*list)->next;
+
+ *list = head;
+ return MATCH_YES;
+
+syntax:
+ gfc_error ("Syntax error in OpenACC expression list at %C");
+
+cleanup:
+ gfc_free_exprlist (head);
+ gfc_current_locus = old_loc;
+ return MATCH_ERROR;
+}
+
+static match
+match_oacc_clause_gang (gfc_oacc_clauses *cp)
+{
+ if (gfc_match_char ('(') != 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)
+ {
+ cp->gang_static = true;
+ if (gfc_match (" * )") != MATCH_YES)
+ return gfc_match (" %e )", &cp->gang_expr);
+ return MATCH_YES;
+ }
+ return gfc_match (" %e )", &cp->gang_expr);
+}
+
#define OMP_CLAUSE_PRIVATE (1 << 0)
#define OMP_CLAUSE_FIRSTPRIVATE (1 << 1)
#define OMP_CLAUSE_LASTPRIVATE (1 << 2)
@@ -186,15 +292,51 @@ cleanup:
#define OMP_CLAUSE_FINAL (1 << 14)
#define OMP_CLAUSE_MERGEABLE (1 << 15)
+/* OpenACC 2.0 clauses. */
+#define OACC_CLAUSE_IF OMP_CLAUSE_IF
+#define OACC_CLAUSE_ASYNC (1 << 16)
+#define OACC_CLAUSE_NUM_GANGS (1 << 17)
+#define OACC_CLAUSE_NUM_WORKERS (1 << 18)
+#define OACC_CLAUSE_VECTOR_LENGTH (1 << 19)
+#define OACC_CLAUSE_REDUCTION OMP_CLAUSE_REDUCTION
+#define OACC_CLAUSE_COPY (1 << 20)
+#define OACC_CLAUSE_COPYIN OMP_CLAUSE_COPYIN
+#define OACC_CLAUSE_COPYOUT (1 << 21)
+#define OACC_CLAUSE_CREATE (1 << 22)
+#define OACC_CLAUSE_PRESENT (1 << 23)
+#define OACC_CLAUSE_PRESENT_OR_COPY (1 << 24)
+#define OACC_CLAUSE_PRESENT_OR_COPYIN (1 << 25)
+#define OACC_CLAUSE_PRESENT_OR_COPYOUT (1 << 26)
+#define OACC_CLAUSE_PRESENT_OR_CREATE (1 << 27)
+#define OACC_CLAUSE_DEVICEPTR (1 << 28)
+#define OACC_CLAUSE_PRIVATE OMP_CLAUSE_PRIVATE
+#define OACC_CLAUSE_FIRSTPRIVATE OMP_CLAUSE_FIRSTPRIVATE
+#define OACC_CLAUSE_COLLAPSE OMP_CLAUSE_COLLAPSE
+#define OACC_CLAUSE_GANG (1 << 29)
+#define OACC_CLAUSE_WORKER (1 << 30)
+#define OACC_CLAUSE_VECTOR (1 << 31)
+#define OACC_CLAUSE_SEQ (1ll << 32)
+#define OACC_CLAUSE_INDEPENDENT (1ll << 33)
+#define OACC_CLAUSE_USE_DEVICE (1ll << 34)
+#define OACC_CLAUSE_DEVICE_RESIDENT (1ll << 35)
+#define OACC_CLAUSE_HOST (1ll << 36)
+#define OACC_CLAUSE_DEVICE (1ll << 37)
+#define OACC_CLAUSE_DEFAULT (1ll << 38)
+#define OACC_CLAUSE_WAIT (1ll << 39)
+#define OACC_CLAUSE_DELETE (1ll << 40)
+#define OACC_CLAUSE_AUTO (1ll << 41)
+#define OACC_CLAUSE_TILE (1ll << 42)
+
/* Match OpenMP directive clauses. MASK is a bitmask of
clauses that are allowed for a particular directive. */
static match
-gfc_match_omp_clauses (gfc_omp_clauses **cp, int mask)
+gfc_match_omp_clauses (gfc_omp_clauses **cp, long long mask, bool is_acc)
{
gfc_omp_clauses *c = gfc_get_omp_clauses ();
locus old_loc;
bool needs_space = true, first = true;
+ c->is_acc = is_acc;
*cp = NULL;
while (1)
@@ -205,6 +347,52 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, int mask)
needs_space = false;
first = false;
gfc_gobble_whitespace ();
+ if ((mask & OACC_CLAUSE_ASYNC) && !c->async)
+ if (gfc_match ("async") == MATCH_YES)
+ {
+ c->async = true;
+ if (gfc_match (" ( %e )", &c->async_expr) == MATCH_YES)
+ needs_space = false;
+ else
+ needs_space = true;
+ continue;
+ }
+ if ((mask & OACC_CLAUSE_GANG) && !c->gang)
+ if (gfc_match ("gang") == MATCH_YES)
+ {
+ c->gang = true;
+ if (match_oacc_clause_gang(c) == MATCH_YES)
+ needs_space = false;
+ else
+ needs_space = true;
+ continue;
+ }
+ if ((mask & OACC_CLAUSE_WORKER) && !c->worker)
+ if (gfc_match ("worker") == MATCH_YES)
+ {
+ c->worker = true;
+ if (gfc_match (" ( num : %e )", &c->worker_expr) == MATCH_YES
+ || gfc_match (" ( %e )", &c->worker_expr) == MATCH_YES)
+ needs_space = false;
+ else
+ needs_space = true;
+ continue;
+ }
+ if ((mask & OACC_CLAUSE_VECTOR_LENGTH) && c->vector_length_expr == NULL
+ && gfc_match ("vector_length ( %e )", &c->vector_length_expr)
+ == MATCH_YES)
+ continue;
+ if ((mask & OACC_CLAUSE_VECTOR) && !c->vector)
+ if (gfc_match ("vector") == MATCH_YES)
+ {
+ c->vector = true;
+ if (gfc_match (" ( length : %e )", &c->vector_expr) == MATCH_YES
+ || gfc_match (" ( %e )", &c->vector_expr) == MATCH_YES)
+ needs_space = false;
+ else
+ needs_space = true;
+ continue;
+ }
if ((mask & OMP_CLAUSE_IF) && c->if_expr == NULL
&& gfc_match ("if ( %e )", &c->if_expr) == MATCH_YES)
continue;
@@ -242,11 +430,157 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, int mask)
&c->lists[OMP_LIST_SHARED], true)
== MATCH_YES)
continue;
- if ((mask & OMP_CLAUSE_COPYIN)
+ if (!c->is_acc && (mask & OMP_CLAUSE_COPYIN)
&& gfc_match_omp_variable_list ("copyin (",
&c->lists[OMP_LIST_COPYIN], true)
== MATCH_YES)
continue;
+ if (c->is_acc && (mask & OACC_CLAUSE_COPYIN)
+ && gfc_match_omp_variable_list ("copyin (",
+ &c->lists[OACC_LIST_COPYIN], true)
+ == MATCH_YES)
+ continue;
+ if ((mask & OACC_CLAUSE_NUM_GANGS) && c->num_gangs_expr == NULL
+ && gfc_match ("num_gangs ( %e )", &c->num_gangs_expr) == MATCH_YES)
+ continue;
+ if ((mask & OACC_CLAUSE_NUM_WORKERS) && c->num_workers_expr == NULL
+ && gfc_match ("num_workers ( %e )", &c->num_workers_expr)
+ == MATCH_YES)
+ continue;
+ if ((mask & OACC_CLAUSE_COPY)
+ && gfc_match_omp_variable_list ("copy (",
+ &c->lists[OACC_LIST_COPY], true)
+ == MATCH_YES)
+ continue;
+ if ((mask & OACC_CLAUSE_COPYOUT)
+ && gfc_match_omp_variable_list ("copyout (",
+ &c->lists[OACC_LIST_COPYOUT], true)
+ == MATCH_YES)
+ continue;
+ if ((mask & OACC_CLAUSE_CREATE)
+ && gfc_match_omp_variable_list ("create (",
+ &c->lists[OACC_LIST_CREATE], true)
+ == MATCH_YES)
+ continue;
+ if ((mask & OACC_CLAUSE_DELETE)
+ && gfc_match_omp_variable_list ("delete (",
+ &c->lists[OACC_LIST_DELETE], true)
+ == MATCH_YES)
+ continue;
+ if ((mask & OACC_CLAUSE_PRESENT)
+ && gfc_match_omp_variable_list ("present (",
+ &c->lists[OACC_LIST_PRESENT], true)
+ == MATCH_YES)
+ continue;
+ if ((mask & OACC_CLAUSE_PRESENT_OR_COPY)
+ && gfc_match_omp_variable_list ("present_or_copy (",
+ &c->lists[OACC_LIST_PRESENT_OR_COPY], true)
+ == MATCH_YES)
+ continue;
+ if ((mask & OACC_CLAUSE_PRESENT_OR_COPY)
+ && gfc_match_omp_variable_list ("pcopy (",
+ &c->lists[OACC_LIST_PRESENT_OR_COPY], true)
+ == MATCH_YES)
+ continue;
+ if ((mask & OACC_CLAUSE_PRESENT_OR_COPYIN)
+ && gfc_match_omp_variable_list ("present_or_copyin (",
+ &c->lists[OACC_LIST_PRESENT_OR_COPYIN],
+ true)
+ == MATCH_YES)
+ continue;
+ if ((mask & OACC_CLAUSE_PRESENT_OR_COPYIN)
+ && gfc_match_omp_variable_list ("pcopyin (",
+ &c->lists[OACC_LIST_PRESENT_OR_COPYIN],
+ true)
+ == MATCH_YES)
+ continue;
+ if ((mask & OACC_CLAUSE_PRESENT_OR_COPYOUT)
+ && gfc_match_omp_variable_list ("present_or_copyout (",
+ &c->lists[OACC_LIST_PRESENT_OR_COPYOUT],
+ true)
+ == MATCH_YES)
+ continue;
+ if ((mask & OACC_CLAUSE_PRESENT_OR_COPYOUT)
+ && gfc_match_omp_variable_list ("pcopyout (",
+ &c->lists[OACC_LIST_PRESENT_OR_COPYOUT],
+ true)
+ == MATCH_YES)
+ continue;
+ if ((mask & OACC_CLAUSE_PRESENT_OR_CREATE)
+ && gfc_match_omp_variable_list ("present_or_create (",
+ &c->lists[OACC_LIST_PRESENT_OR_CREATE],
+ true)
+ == MATCH_YES)
+ continue;
+ if ((mask & OACC_CLAUSE_PRESENT_OR_CREATE)
+ && gfc_match_omp_variable_list ("pcreate (",
+ &c->lists[OACC_LIST_PRESENT_OR_CREATE],
+ true)
+ == MATCH_YES)
+ continue;
+ if ((mask & OACC_CLAUSE_DEVICEPTR)
+ && gfc_match_omp_variable_list ("deviceptr (",
+ &c->lists[OACC_LIST_DEVICEPTR], true)
+ == MATCH_YES)
+ continue;
+ if ((mask & OACC_CLAUSE_USE_DEVICE)
+ && gfc_match_omp_variable_list ("use_device (",
+ &c->lists[OACC_LIST_USE_DEVICE], true)
+ == MATCH_YES)
+ continue;
+ if ((mask & OACC_CLAUSE_DEVICE_RESIDENT)
+ && gfc_match_omp_variable_list ("device_resident (",
+ &c->lists[OACC_LIST_DEVICE_RESIDENT], true)
+ == MATCH_YES)
+ continue;
+ if ((mask & OACC_CLAUSE_HOST)
+ && gfc_match_omp_variable_list ("host (",
+ &c->lists[OACC_LIST_HOST], true)
+ == MATCH_YES)
+ continue;
+ if ((mask & OACC_CLAUSE_DEVICE)
+ && gfc_match_omp_variable_list ("device (",
+ &c->lists[OACC_LIST_DEVICE], true)
+ == MATCH_YES)
+ continue;
+ if ((mask & OACC_CLAUSE_TILE)
+ && match_oacc_exprlist ("tile (", &c->tilelist, true) == MATCH_YES)
+ continue;
+ if ((mask & OACC_CLAUSE_SEQ) && !c->seq
+ && gfc_match ("seq") == MATCH_YES)
+ {
+ c->seq = true;
+ needs_space = true;
+ continue;
+ }
+ if ((mask & OACC_CLAUSE_INDEPENDENT) && !c->independent
+ && gfc_match ("independent") == MATCH_YES)
+ {
+ c->independent = true;
+ needs_space = true;
+ continue;
+ }
+ if ((mask & OACC_CLAUSE_DEFAULT) && !c->default_none
+ && gfc_match ("default ( none )") == MATCH_YES)
+ {
+ c->default_none = true;
+ needs_space = true;
+ continue;
+ }
+ if ((mask & OACC_CLAUSE_AUTO) && !c->par_auto
+ && gfc_match ("auto") == MATCH_YES)
+ {
+ c->par_auto = true;
+ needs_space = true;
+ continue;
+ }
+ if ((mask & OACC_CLAUSE_WAIT) && !c->wait
+ && gfc_match ("wait") == MATCH_YES)
+ {
+ c->wait = true;
+ match_oacc_exprlist (" (", &c->waitlist, false);
+ continue;
+ }
old_loc = gfc_current_locus;
if ((mask & OMP_CLAUSE_REDUCTION)
&& gfc_match ("reduction ( ") == MATCH_YES)
@@ -433,6 +767,51 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, int mask)
return MATCH_YES;
}
+#define OACC_PARALLEL_CLAUSES \
+ (OACC_CLAUSE_IF | OACC_CLAUSE_ASYNC | OACC_CLAUSE_NUM_GANGS \
+ | OACC_CLAUSE_NUM_WORKERS | OACC_CLAUSE_VECTOR_LENGTH | OACC_CLAUSE_REDUCTION \
+ | OACC_CLAUSE_COPY | OACC_CLAUSE_COPYIN | OACC_CLAUSE_COPYOUT \
+ | OACC_CLAUSE_CREATE | OACC_CLAUSE_PRESENT | OACC_CLAUSE_PRESENT_OR_COPY \
+ | OACC_CLAUSE_PRESENT_OR_COPYIN | OACC_CLAUSE_PRESENT_OR_COPYOUT \
+ | OACC_CLAUSE_PRESENT_OR_CREATE | OACC_CLAUSE_DEVICEPTR | OACC_CLAUSE_PRIVATE \
+ | OACC_CLAUSE_FIRSTPRIVATE | OACC_CLAUSE_DEFAULT | OACC_CLAUSE_WAIT)
+#define OACC_KERNELS_CLAUSES \
+ (OACC_CLAUSE_IF | OACC_CLAUSE_ASYNC | OACC_CLAUSE_DEVICEPTR \
+ | OACC_CLAUSE_COPY | OACC_CLAUSE_COPYIN | OACC_CLAUSE_COPYOUT \
+ | OACC_CLAUSE_CREATE | OACC_CLAUSE_PRESENT | OACC_CLAUSE_PRESENT_OR_COPY \
+ | OACC_CLAUSE_PRESENT_OR_COPYIN | OACC_CLAUSE_PRESENT_OR_COPYOUT \
+ | OACC_CLAUSE_PRESENT_OR_CREATE | OACC_CLAUSE_DEFAULT | OACC_CLAUSE_WAIT)
+#define OACC_DATA_CLAUSES \
+ (OACC_CLAUSE_IF | OACC_CLAUSE_DEVICEPTR | OACC_CLAUSE_COPY | OACC_CLAUSE_COPYIN \
+ | OACC_CLAUSE_COPYOUT | OACC_CLAUSE_CREATE | OACC_CLAUSE_PRESENT \
+ | OACC_CLAUSE_PRESENT_OR_COPY | OACC_CLAUSE_PRESENT_OR_COPYIN \
+ | OACC_CLAUSE_PRESENT_OR_COPYOUT | OACC_CLAUSE_PRESENT_OR_CREATE)
+#define OACC_LOOP_CLAUSES \
+ (OACC_CLAUSE_COLLAPSE | OACC_CLAUSE_GANG | OACC_CLAUSE_WORKER \
+ | OACC_CLAUSE_VECTOR | OACC_CLAUSE_SEQ | OACC_CLAUSE_INDEPENDENT \
+ | OACC_CLAUSE_PRIVATE | OACC_CLAUSE_REDUCTION | OACC_CLAUSE_AUTO \
+ | OACC_CLAUSE_TILE)
+#define OACC_PARALLEL_LOOP_CLAUSES \
+ (OACC_LOOP_CLAUSES | OACC_PARALLEL_CLAUSES)
+#define OACC_KERNELS_LOOP_CLAUSES \
+ (OACC_LOOP_CLAUSES | OACC_KERNELS_CLAUSES)
+#define OACC_HOST_DATA_CLAUSES OACC_CLAUSE_USE_DEVICE
+#define OACC_DECLARE_CLAUSES \
+ (OACC_CLAUSE_COPY | OACC_CLAUSE_COPYIN | OACC_CLAUSE_COPYOUT \
+ | OACC_CLAUSE_CREATE | OACC_CLAUSE_DEVICEPTR | OACC_CLAUSE_DEVICE_RESIDENT \
+ | OACC_CLAUSE_PRESENT | OACC_CLAUSE_PRESENT_OR_COPY \
+ | OACC_CLAUSE_PRESENT_OR_COPYIN | OACC_CLAUSE_PRESENT_OR_COPYOUT \
+ | OACC_CLAUSE_PRESENT_OR_CREATE)
+#define OACC_UPDATE_CLAUSES \
+ (OACC_CLAUSE_IF | OACC_CLAUSE_ASYNC | OACC_CLAUSE_HOST | OACC_CLAUSE_DEVICE)
+#define OACC_ENTER_DATA_CLAUSES \
+ (OACC_CLAUSE_IF | OACC_CLAUSE_ASYNC | OACC_CLAUSE_WAIT | OACC_CLAUSE_COPYIN \
+ | OACC_CLAUSE_CREATE | OACC_CLAUSE_PRESENT_OR_COPYIN \
+ | OACC_CLAUSE_PRESENT_OR_CREATE)
+#define OACC_EXIT_DATA_CLAUSES \
+ (OACC_CLAUSE_IF | OACC_CLAUSE_ASYNC | OACC_CLAUSE_WAIT | OACC_CLAUSE_COPYOUT \
+ | OACC_CLAUSE_DELETE)
+
#define OMP_PARALLEL_CLAUSES \
(OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE | OMP_CLAUSE_SHARED \
| OMP_CLAUSE_COPYIN | OMP_CLAUSE_REDUCTION | OMP_CLAUSE_IF \
@@ -449,11 +828,190 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, int mask)
| OMP_CLAUSE_IF | OMP_CLAUSE_DEFAULT | OMP_CLAUSE_UNTIED \
| OMP_CLAUSE_FINAL | OMP_CLAUSE_MERGEABLE)
+
+match
+gfc_match_oacc_parallel_loop (void)
+{
+ gfc_oacc_clauses *c;
+ if (gfc_match_omp_clauses (&c, OACC_PARALLEL_LOOP_CLAUSES, true) != MATCH_YES)
+ return MATCH_ERROR;
+
+ new_st.op = EXEC_OACC_PARALLEL_LOOP;
+ new_st.ext.omp_clauses = c;
+ return MATCH_YES;
+}
+
+
+match
+gfc_match_oacc_parallel (void)
+{
+ gfc_oacc_clauses *c;
+ if (gfc_match_omp_clauses (&c, OACC_PARALLEL_CLAUSES, true) != MATCH_YES)
+ return MATCH_ERROR;
+
+ new_st.op = EXEC_OACC_PARALLEL;
+ new_st.ext.omp_clauses = c;
+ return MATCH_YES;
+}
+
+
+match
+gfc_match_oacc_kernels_loop (void)
+{
+ gfc_oacc_clauses *c;
+ if (gfc_match_omp_clauses (&c, OACC_KERNELS_LOOP_CLAUSES, true) != MATCH_YES)
+ return MATCH_ERROR;
+
+ new_st.op = EXEC_OACC_KERNELS_LOOP;
+ new_st.ext.omp_clauses = c;
+ return MATCH_YES;
+}
+
+
+match
+gfc_match_oacc_kernels (void)
+{
+ gfc_oacc_clauses *c;
+ if (gfc_match_omp_clauses (&c, OACC_KERNELS_CLAUSES, true) != MATCH_YES)
+ return MATCH_ERROR;
+
+ new_st.op = EXEC_OACC_KERNELS;
+ new_st.ext.omp_clauses = c;
+ return MATCH_YES;
+}
+
+
+match
+gfc_match_oacc_data (void)
+{
+ gfc_oacc_clauses *c;
+ if (gfc_match_omp_clauses (&c, OACC_DATA_CLAUSES, true) != MATCH_YES)
+ return MATCH_ERROR;
+
+ new_st.op = EXEC_OACC_DATA;
+ new_st.ext.omp_clauses = c;
+ return MATCH_YES;
+}
+
+
+match
+gfc_match_oacc_host_data (void)
+{
+ gfc_oacc_clauses *c;
+ if (gfc_match_omp_clauses (&c, OACC_HOST_DATA_CLAUSES, true) != MATCH_YES)
+ return MATCH_ERROR;
+
+ new_st.op = EXEC_OACC_HOST_DATA;
+ new_st.ext.omp_clauses = c;
+ return MATCH_YES;
+}
+
+
+match
+gfc_match_oacc_loop (void)
+{
+ gfc_oacc_clauses *c;
+ if (gfc_match_omp_clauses (&c, OACC_LOOP_CLAUSES, true) != MATCH_YES)
+ return MATCH_ERROR;
+
+ new_st.op = EXEC_OACC_LOOP;
+ new_st.ext.omp_clauses = c;
+ return MATCH_YES;
+}
+
+
+match
+gfc_match_oacc_declare (void)
+{
+ gfc_oacc_clauses *c;
+ if (gfc_match_omp_clauses (&c, OACC_DECLARE_CLAUSES, true) != MATCH_YES)
+ return MATCH_ERROR;
+
+ new_st.ext.omp_clauses = c;
+ return MATCH_YES;
+}
+
+
+match
+gfc_match_oacc_update (void)
+{
+ gfc_oacc_clauses *c;
+ if (gfc_match_omp_clauses (&c, OACC_UPDATE_CLAUSES, true) != MATCH_YES)
+ return MATCH_ERROR;
+
+ new_st.op = EXEC_OACC_UPDATE;
+ new_st.ext.omp_clauses = c;
+ return MATCH_YES;
+}
+
+
+match
+gfc_match_oacc_enter_data (void)
+{
+ gfc_oacc_clauses *c;
+ if (gfc_match_omp_clauses (&c, OACC_ENTER_DATA_CLAUSES, true) != MATCH_YES)
+ return MATCH_ERROR;
+
+ new_st.op = EXEC_OACC_ENTER_DATA;
+ new_st.ext.omp_clauses = c;
+ return MATCH_YES;
+}
+
+
+match
+gfc_match_oacc_exit_data (void)
+{
+ gfc_oacc_clauses *c;
+ if (gfc_match_omp_clauses (&c, OACC_EXIT_DATA_CLAUSES, true) != MATCH_YES)
+ return MATCH_ERROR;
+
+ new_st.op = EXEC_OACC_EXIT_DATA;
+ new_st.ext.omp_clauses = c;
+ return MATCH_YES;
+}
+
+
+match
+gfc_match_oacc_wait (void)
+{
+ gfc_oacc_clauses *c = gfc_get_oacc_clauses ();
+ gfc_match (" ( %e )", &c->non_clause_wait_expr);
+
+ new_st.op = EXEC_OACC_WAIT;
+ new_st.ext.omp_clauses = c;
+ return MATCH_YES;
+}
+
+
+match
+gfc_match_oacc_cache (void)
+{
+ gfc_oacc_clauses *c = gfc_get_oacc_clauses ();
+ match m = gfc_match_omp_variable_list (" (",&c->lists[OACC_LIST_CACHE], true);
+ if (m != MATCH_YES)
+ {
+ gfc_free_omp_clauses(c);
+ return m;
+ }
+
+ if (gfc_current_state() != COMP_DO)
+ {
+ gfc_error ("ACC CACHE directive must be inside of loop %C");
+ gfc_free_omp_clauses(c);
+ return MATCH_ERROR;
+ }
+
+ new_st.op = EXEC_OACC_CACHE;
+ new_st.ext.omp_clauses = c;
+ return MATCH_YES;
+}
+
+
match
gfc_match_omp_parallel (void)
{
gfc_omp_clauses *c;
- if (gfc_match_omp_clauses (&c, OMP_PARALLEL_CLAUSES) != MATCH_YES)
+ if (gfc_match_omp_clauses (&c, OMP_PARALLEL_CLAUSES, false) != MATCH_YES)
return MATCH_ERROR;
new_st.op = EXEC_OMP_PARALLEL;
new_st.ext.omp_clauses = c;
@@ -465,7 +1023,7 @@ match
gfc_match_omp_task (void)
{
gfc_omp_clauses *c;
- if (gfc_match_omp_clauses (&c, OMP_TASK_CLAUSES) != MATCH_YES)
+ if (gfc_match_omp_clauses (&c, OMP_TASK_CLAUSES, false) != MATCH_YES)
return MATCH_ERROR;
new_st.op = EXEC_OMP_TASK;
new_st.ext.omp_clauses = c;
@@ -523,7 +1081,7 @@ match
gfc_match_omp_do (void)
{
gfc_omp_clauses *c;
- if (gfc_match_omp_clauses (&c, OMP_DO_CLAUSES) != MATCH_YES)
+ if (gfc_match_omp_clauses (&c, OMP_DO_CLAUSES, false) != MATCH_YES)
return MATCH_ERROR;
new_st.op = EXEC_OMP_DO;
new_st.ext.omp_clauses = c;
@@ -620,7 +1178,7 @@ match
gfc_match_omp_parallel_do (void)
{
gfc_omp_clauses *c;
- if (gfc_match_omp_clauses (&c, OMP_PARALLEL_CLAUSES | OMP_DO_CLAUSES)
+ if (gfc_match_omp_clauses (&c, OMP_PARALLEL_CLAUSES | OMP_DO_CLAUSES, false)
!= MATCH_YES)
return MATCH_ERROR;
new_st.op = EXEC_OMP_PARALLEL_DO;
@@ -633,7 +1191,8 @@ match
gfc_match_omp_parallel_sections (void)
{
gfc_omp_clauses *c;
- if (gfc_match_omp_clauses (&c, OMP_PARALLEL_CLAUSES | OMP_SECTIONS_CLAUSES)
+ if (gfc_match_omp_clauses (&c, OMP_PARALLEL_CLAUSES | OMP_SECTIONS_CLAUSES,
+ false)
!= MATCH_YES)
return MATCH_ERROR;
new_st.op = EXEC_OMP_PARALLEL_SECTIONS;
@@ -646,7 +1205,7 @@ match
gfc_match_omp_parallel_workshare (void)
{
gfc_omp_clauses *c;
- if (gfc_match_omp_clauses (&c, OMP_PARALLEL_CLAUSES) != MATCH_YES)
+ if (gfc_match_omp_clauses (&c, OMP_PARALLEL_CLAUSES, false) != MATCH_YES)
return MATCH_ERROR;
new_st.op = EXEC_OMP_PARALLEL_WORKSHARE;
new_st.ext.omp_clauses = c;
@@ -658,7 +1217,7 @@ match
gfc_match_omp_sections (void)
{
gfc_omp_clauses *c;
- if (gfc_match_omp_clauses (&c, OMP_SECTIONS_CLAUSES) != MATCH_YES)
+ if (gfc_match_omp_clauses (&c, OMP_SECTIONS_CLAUSES, false) != MATCH_YES)
return MATCH_ERROR;
new_st.op = EXEC_OMP_SECTIONS;
new_st.ext.omp_clauses = c;
@@ -670,7 +1229,8 @@ match
gfc_match_omp_single (void)
{
gfc_omp_clauses *c;
- if (gfc_match_omp_clauses (&c, OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE)
+ if (gfc_match_omp_clauses (&c, OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE,
+ false)
!= MATCH_YES)
return MATCH_ERROR;
new_st.op = EXEC_OMP_SINGLE;
@@ -785,7 +1345,7 @@ gfc_match_omp_end_single (void)
new_st.ext.omp_bool = true;
return MATCH_YES;
}
- if (gfc_match_omp_clauses (&c, OMP_CLAUSE_COPYPRIVATE) != MATCH_YES)
+ if (gfc_match_omp_clauses (&c, OMP_CLAUSE_COPYPRIVATE, false) != MATCH_YES)
return MATCH_ERROR;
new_st.op = EXEC_OMP_END_SINGLE;
new_st.ext.omp_clauses = c;
@@ -793,6 +1353,27 @@ gfc_match_omp_end_single (void)
}
+static void
+resolve_oacc_scalar_int_expr (gfc_expr *expr, const char *clause)
+{
+ if (!gfc_resolve_expr (expr)
+ || expr->ts.type != BT_INTEGER || expr->rank != 0)
+ gfc_error ("%s clause at %L requires a scalar INTEGER expression",
+ clause, &expr->where);
+}
+
+
+static void
+resolve_oacc_positive_int_expr (gfc_expr *expr, const char *clause)
+{
+ resolve_oacc_scalar_int_expr (expr, clause);
+ if (expr->expr_type == EXPR_CONSTANT && expr->ts.type == BT_INTEGER
+ && expr->value.integer->_mp_size <= 0)
+ gfc_warning ("INTEGER expression of %s clause at %L must be positive",
+ clause, &expr->where);
+}
+
+
/* OpenMP directive resolving routines. */
static void
@@ -800,10 +1381,17 @@ resolve_omp_clauses (gfc_code *code)
{
gfc_omp_clauses *omp_clauses = code->ext.omp_clauses;
gfc_namelist *n;
+ gfc_oacc_clauses *oacc_clauses = omp_clauses;
+ gfc_exprlist *el;
int list;
static const char *clause_names[]
= { "PRIVATE", "FIRSTPRIVATE", "LASTPRIVATE", "COPYPRIVATE", "SHARED",
"COPYIN", "REDUCTION" };
+ static const char *oacc_clause_names[]
+ = { "COPY", "COPYIN", "COPYOUT", "CREATE", "DELETE",
+ "PRESENT", "PRESENT_OR_COPY", "PRESENT_OR_COPYIN", "PRESENT_OR_COPYOUT",
+ "PRESENT_OR_CREATE", "DEVICEPTR", "USE_DEVICE", "DEVICE_RESIDENT",
+ "HOST", "DEVICE", "CACHE"};
if (omp_clauses == NULL)
return;
@@ -843,7 +1431,7 @@ resolve_omp_clauses (gfc_code *code)
/* Check that no symbol appears on multiple clauses, except that
a symbol can appear on both firstprivate and lastprivate. */
- for (list = 0; list < OMP_LIST_NUM; list++)
+ for (list = 0; list < OACC_LIST_NUM; list++)
for (n = omp_clauses->lists[list]; n; n = n->next)
{
n->sym->mark = 0;
@@ -1005,6 +1593,12 @@ resolve_omp_clauses (gfc_code *code)
gfc_error ("Variable '%s' in %s clause is used in "
"NAMELIST statement at %L",
n->sym->name, name, &code->loc);
+ if (omp_clauses->is_acc
+ && list >= OACC_LIST_REDUCTION_FIRST
+ && list <= OACC_LIST_REDUCTION_LAST
+ && n->sym->as && n->sym->as->rank != 0)
+ gfc_error ("OpenACC reduction requires SCALAR variable "
+ "at %L", &code->loc);
switch (list)
{
case OMP_LIST_PLUS:
@@ -1059,6 +1653,82 @@ resolve_omp_clauses (gfc_code *code)
break;
}
}
+ if (!oacc_clauses->is_acc)
+ return;
+
+ /* In OpenACC, single variable may appear in several clauses,
+ such as COPYIN and COPYOUT. However, it's better to replace these clause
+ with COPY. Hence, we use warning instead of error. */
+ for (list = OACC_LIST_FIRST; list < OACC_LIST_NUM; list++)
+ for (n = oacc_clauses->lists[list]; n; n = n->next)
+ {
+ if (n->sym->mark)
+ gfc_warning ("Symbol '%s' present on multiple clauses at %L",
+ n->sym->name, &code->loc);
+ else
+ n->sym->mark = 1;
+ }
+ if (oacc_clauses->async)
+ if (oacc_clauses->async_expr)
+ resolve_oacc_scalar_int_expr (oacc_clauses->async_expr, "ASYNC");
+ if (oacc_clauses->num_gangs_expr)
+ resolve_oacc_positive_int_expr (oacc_clauses->num_gangs_expr, "NUM_GANGS");
+ if (oacc_clauses->num_workers_expr)
+ resolve_oacc_positive_int_expr (oacc_clauses->num_workers_expr, "NUM_WORKERS");
+ if (oacc_clauses->vector_length_expr)
+ resolve_oacc_positive_int_expr (oacc_clauses->vector_length_expr, "VECTOR_LENGTH");
+ if (oacc_clauses->gang_expr)
+ resolve_oacc_positive_int_expr (oacc_clauses->gang_expr, "GANG");
+ if (oacc_clauses->worker_expr)
+ resolve_oacc_positive_int_expr (oacc_clauses->worker_expr, "WORKER");
+ if (oacc_clauses->vector_expr)
+ resolve_oacc_positive_int_expr (oacc_clauses->vector_expr, "VECTOR");
+ if (oacc_clauses->wait)
+ if (oacc_clauses->waitlist)
+ for (el = oacc_clauses->waitlist; el; el = el->next)
+ resolve_oacc_positive_int_expr (el->expr, "WAIT");
+
+ for (list = OACC_LIST_FIRST; list < OACC_LIST_NUM; list++)
+ if ((n = oacc_clauses->lists[list]) != NULL)
+ {
+ const char *name = oacc_clause_names[list - OACC_LIST_FIRST];
+
+ if (list > OACC_LIST_DATA_CLAUSE_LAST)
+ {
+ if (n->sym->attr.pointer)
+ gfc_error ("POINTER object '%s' in %s clause at %L",
+ n->sym->name, name, &code->loc);
+ if (n->sym->as && n->sym->as->type == AS_ASSUMED_SIZE)
+ gfc_error ("Assumed size array '%s' in %s clause at %L",
+ n->sym->name, name, &code->loc);
+ }
+
+ if (list == OACC_LIST_DEVICEPTR)
+ {
+ if (n->sym->attr.pointer)
+ gfc_error ("POINTER object '%s' in %s clause at %L",
+ n->sym->name, name, &code->loc);
+ if (n->sym->attr.allocatable)
+ gfc_error ("ALLOCATABLE object '%s' in %s clause at %L",
+ n->sym->name, name, &code->loc);
+ if (n->sym->attr.value)
+ gfc_error ("VALUE object '%s' in %s clause at %L",
+ n->sym->name, name, &code->loc);
+ }
+
+ if (list >= OACC_LIST_DATA_CLAUSE_FIRST
+ && list <= OACC_LIST_DATA_CLAUSE_LAST)
+ {
+ if (n->sym->ts.type == BT_DERIVED
+ && n->sym->attr.allocatable)
+ gfc_error ("ALLOCATABLE object '%s' of DERIVED type in %s clause at %L",
+ n->sym->name, name, &code->loc);
+ if (n->sym->ts.type == BT_DERIVED
+ && n->sym->attr.pointer)
+ gfc_error ("POINTER object '%s' of DERIVED type in %s clause at %L",
+ n->sym->name, name, &code->loc);
+ }
+ }
}
@@ -1727,6 +2397,342 @@ resolve_omp_do (gfc_code *code)
}
}
+typedef struct omp_context oacc_context;
+oacc_context *oacc_current_ctx;
+
+static bool
+oacc_is_parallel (gfc_code *code)
+{
+ return code->op == EXEC_OACC_PARALLEL || code->op == EXEC_OACC_PARALLEL_LOOP;
+}
+
+static bool
+oacc_is_kernels (gfc_code *code)
+{
+ return code->op == EXEC_OACC_KERNELS || code->op == EXEC_OACC_KERNELS_LOOP;
+}
+
+static bool
+oacc_is_loop (gfc_code *code)
+{
+ return code->op == EXEC_OACC_PARALLEL_LOOP
+ || code->op == EXEC_OACC_KERNELS_LOOP
+ || code->op == EXEC_OACC_LOOP;
+}
+
+
+static void
+resolve_oacc_nested_loops (gfc_code *code, gfc_code* do_code, int collapse,
+ const char *clause)
+{
+ gfc_symbol *dovar;
+ gfc_code *c;
+ int i;
+
+ for (i = 1; i <= collapse; i++)
+ {
+ if (do_code->op == EXEC_DO_WHILE)
+ {
+ gfc_error ("!$ACC LOOP cannot be a DO WHILE or DO without loop control "
+ "at %L", &do_code->loc);
+ break;
+ }
+ gcc_assert (do_code->op == EXEC_DO);
+ if (do_code->ext.iterator->var->ts.type != BT_INTEGER)
+ gfc_error ("!$ACC LOOP iteration variable must be of type integer at %L",
+ &do_code->loc);
+ dovar = do_code->ext.iterator->var->symtree->n.sym;
+ if (i > 1)
+ {
+ gfc_code *do_code2 = code->block->next;
+ int j;
+
+ for (j = 1; j < i; j++)
+ {
+ gfc_symbol *ivar = do_code2->ext.iterator->var->symtree->n.sym;
+ if (dovar == ivar
+ || gfc_find_sym_in_expr (ivar, do_code->ext.iterator->start)
+ || gfc_find_sym_in_expr (ivar, do_code->ext.iterator->end)
+ || gfc_find_sym_in_expr (ivar, do_code->ext.iterator->step))
+ {
+ gfc_error ("!$ACC LOOP %s loops don't form rectangular iteration space at %L",
+ clause, &do_code->loc);
+ break;
+ }
+ if (j < i)
+ break;
+ do_code2 = do_code2->block->next;
+ }
+ }
+ if (i == collapse)
+ break;
+ for (c = do_code->next; c; c = c->next)
+ if (c->op != EXEC_NOP && c->op != EXEC_CONTINUE)
+ {
+ gfc_error ("%s !$ACC LOOP loops not perfectly nested at %L",
+ clause, &c->loc);
+ break;
+ }
+ if (c)
+ break;
+ do_code = do_code->block;
+ if (do_code->op != EXEC_DO && do_code->op != EXEC_DO_WHILE)
+ {
+ gfc_error ("not enough DO loops for %s !$ACC LOOP at %L",
+ clause, &code->loc);
+ break;
+ }
+ do_code = do_code->next;
+ if (do_code == NULL
+ || (do_code->op != EXEC_DO && do_code->op != EXEC_DO_WHILE))
+ {
+ gfc_error ("not enough DO loops for %s !$ACC LOOP at %L",
+ clause, &code->loc);
+ break;
+ }
+ }
+}
+
+static void
+resolve_oacc_params_in_parallel (gfc_code *code, const char *clause)
+{
+ oacc_context *c;
+
+ if (oacc_is_parallel (code))
+ gfc_error ("LOOP %s in PARALLEL section allows no argument or static at %L",
+ clause, &code->loc);
+ for (c = oacc_current_ctx; c; c = c->previous)
+ {
+ if (oacc_is_loop (c->code))
+ break;
+ if (oacc_is_parallel (c->code))
+ gfc_error ("LOOP %s in PARALLEL section allows no argument or static at %L",
+ clause, &code->loc);
+ }
+}
+
+
+static void
+resolve_oacc_loop_blocks (gfc_code *code)
+{
+ oacc_context *c;
+
+ if (!oacc_is_loop (code))
+ return;
+
+ if (code->op == EXEC_OACC_LOOP)
+ for (c = oacc_current_ctx; c; c = c->previous)
+ {
+ if (oacc_is_loop (c->code))
+ {
+ if (code->ext.omp_clauses->gang)
+ {
+ if (c->code->ext.omp_clauses->gang)
+ gfc_error ("Loop parallelized across gangs is not allowed "
+ "inside another loop parallelized across gangs at %L",
+ &code->loc);
+ 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",
+ &code->loc);
+ }
+ if (code->ext.omp_clauses->worker)
+ {
+ if (c->code->ext.omp_clauses->worker)
+ gfc_error ("Loop parallelized across workers is not allowed "
+ "inside another loop parallelized across workers at %L",
+ &code->loc);
+ if (c->code->ext.omp_clauses->vector)
+ gfc_error ("Loop parallelized across workers is not allowed "
+ "inside another loop parallelized across vectors at %L",
+ &code->loc);
+ }
+ if (code->ext.omp_clauses->vector)
+ if (c->code->ext.omp_clauses->vector)
+ gfc_error ("Loop parallelized across vectors is not allowed "
+ "inside another loop parallelized across vectors at %L",
+ &code->loc);
+ }
+
+ if (oacc_is_parallel (c->code) || oacc_is_kernels (c->code))
+ break;
+ }
+
+ if (code->ext.omp_clauses->seq)
+ {
+ if (code->ext.omp_clauses->independent)
+ gfc_error ("Both SEQ and INDEPENDENT are not allowed in %L", &code->loc);
+ if (code->ext.omp_clauses->gang)
+ gfc_error ("Both SEQ and GANG are not allowed in %L", &code->loc);
+ if (code->ext.omp_clauses->worker)
+ gfc_error ("Both SEQ and WORKER are not allowed in %L", &code->loc);
+ if (code->ext.omp_clauses->vector)
+ gfc_error ("Both SEQ and VECTOR are not allowed in %L", &code->loc);
+ if (code->ext.omp_clauses->par_auto)
+ gfc_error ("Both SEQ and AUTO are not allowed in %L", &code->loc);
+ }
+ if (code->ext.omp_clauses->par_auto)
+ {
+ if (code->ext.omp_clauses->gang)
+ gfc_error ("Both AUTO and GANG are not allowed in %L", &code->loc);
+ if (code->ext.omp_clauses->worker)
+ gfc_error ("Both AUTO and WORKER are not allowed in %L", &code->loc);
+ if (code->ext.omp_clauses->vector)
+ gfc_error ("Both AUTO and VECTOR are not allowed in %L", &code->loc);
+ }
+ if (!code->ext.omp_clauses->tilelist)
+ {
+ if (code->ext.omp_clauses->gang)
+ {
+ if (code->ext.omp_clauses->worker)
+ gfc_error ("Both GANG and WORKER are not allowed in %L", &code->loc);
+ if (code->ext.omp_clauses->vector)
+ gfc_error ("Both GANG and VECTOR are not allowed in %L", &code->loc);
+ }
+ if (code->ext.omp_clauses->worker)
+ if (code->ext.omp_clauses->vector)
+ gfc_error ("Both WORKER and VECTOR are not allowed in %L", &code->loc);
+ }
+ else if (code->ext.omp_clauses->gang
+ && code->ext.omp_clauses->worker
+ && code->ext.omp_clauses->vector)
+ gfc_error ("All GANG, WORKER and VECTOR are not allowed in %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");
+
+ if (code->ext.omp_clauses->worker
+ && code->ext.omp_clauses->worker_expr)
+ resolve_oacc_params_in_parallel (code, "WORKER");
+
+ if (code->ext.omp_clauses->tilelist)
+ {
+ gfc_exprlist *el;
+ int num = 0;
+ for (el = code->ext.omp_clauses->tilelist; el; el = el->next)
+ {
+ num++;
+ if (el->expr == NULL)
+ continue;
+ resolve_oacc_positive_int_expr (el->expr, "TILE");
+ if (el->expr->expr_type != EXPR_CONSTANT)
+ gfc_error ("TILE requires constant expression at %L", &code->loc);
+ }
+ resolve_oacc_nested_loops (code, code->block->next, num, "tiled");
+ }
+}
+
+
+void
+gfc_resolve_oacc_blocks (gfc_code *code, gfc_namespace *ns)
+{
+ oacc_context ctx;
+
+ resolve_oacc_loop_blocks (code);
+
+ ctx.code = code;
+ ctx.previous = oacc_current_ctx;
+ oacc_current_ctx = &ctx;
+
+ gfc_resolve_blocks (code->block, ns);
+
+ oacc_current_ctx = ctx.previous;
+}
+
+
+static void
+resolve_oacc_loop(gfc_code *code)
+{
+ gfc_code *do_code;
+ int collapse;
+ int list;
+
+ if (code->ext.omp_clauses)
+ resolve_omp_clauses (code);
+
+ for (list = OACC_LIST_REDUCTION_FIRST; list <= OACC_LIST_REDUCTION_LAST; list++)
+ if (code->ext.omp_clauses->lists[list])
+ {
+ bool kernels_region = false;
+ oacc_context *c;
+
+ if (code->op == EXEC_OACC_KERNELS_LOOP)
+ kernels_region = true;
+ if (!kernels_region)
+ for (c = oacc_current_ctx; c != NULL && !kernels_region; c = c->previous)
+ if (c->code->op == EXEC_OACC_KERNELS)
+ kernels_region = true;
+
+ if (kernels_region)
+ {
+ gfc_error ("REDUCTION clause is not allowed in KERNELS region at %L",
+ &code->loc);
+ break;
+ }
+ }
+
+ do_code = code->block->next;
+ collapse = code->ext.omp_clauses->collapse;
+
+ if (collapse <= 0)
+ collapse = 1;
+ resolve_oacc_nested_loops (code, do_code, collapse, "collapsed");
+}
+
+
+static void
+resolve_oacc_cache (gfc_code *)
+{
+ //TODO: resolve subarrays
+}
+
+
+static void
+resolve_oacc_wait (gfc_code *code)
+{
+ gfc_exprlist* el;
+
+ for (el = code->ext.omp_clauses->waitlist; el; el = el->next)
+ resolve_oacc_positive_int_expr (el->expr, "WAIT");
+}
+
+
+void
+gfc_resolve_oacc_directive (gfc_code *code, gfc_namespace *ns ATTRIBUTE_UNUSED)
+{
+ switch (code->op)
+ {
+ case EXEC_OACC_PARALLEL:
+ case EXEC_OACC_KERNELS:
+ case EXEC_OACC_DATA:
+ case EXEC_OACC_HOST_DATA:
+ case EXEC_OACC_UPDATE:
+ case EXEC_OACC_ENTER_DATA:
+ case EXEC_OACC_EXIT_DATA:
+ resolve_omp_clauses (code);
+ break;
+ case EXEC_OACC_PARALLEL_LOOP:
+ case EXEC_OACC_KERNELS_LOOP:
+ case EXEC_OACC_LOOP:
+ resolve_oacc_loop (code);
+ break;
+ case EXEC_OACC_CACHE:
+ resolve_oacc_cache (code);
+ break;
+ case EXEC_OACC_WAIT:
+ resolve_oacc_wait (code);
+ break;
+ default:
+ break;
+ }
+}
+
/* Resolve OpenMP directive clauses and check various requirements
of each directive. */
--
1.8.3.2
^ permalink raw reply [flat|nested] 89+ messages in thread
* [PATCH 1/6] [GOMP4] OpenACC 1.0+ support in fortran front-end
2014-01-23 18:01 [PATCH] [GOMP4] OpenACC 1.0+ support in fortran front-end Ilmir Usmanov
@ 2014-01-23 18:03 ` Ilmir Usmanov
2014-01-23 18:03 ` [PATCH 2/6] " Ilmir Usmanov
2014-01-24 20:31 ` [PATCH 1/6] " Thomas Schwinge
2014-01-24 18:04 ` [PATCH] " Thomas Schwinge
1 sibling, 2 replies; 89+ messages in thread
From: Ilmir Usmanov @ 2014-01-23 18:03 UTC (permalink / raw)
To: gcc-patches, Thomas Schwinge, jakub
Cc: Evgeny Gavrin, GarbuzovViacheslav, Dmitri Botcharnikov
[-- Attachment #1: Type: text/plain, Size: 1 bytes --]
[-- Attachment #2: 0001-OpenACC-fortran-FE-part-1.patch --]
[-- Type: text/x-diff, Size: 52355 bytes --]
From 84dc72f88c1b23ae995afdda0b946ebd73af102f Mon Sep 17 00:00:00 2001
From: Ilmir Usmanov <i.usmanov@samsung.com>
Date: Thu, 23 Jan 2014 21:04:37 +0400
Subject: [PATCH 1/6] OpenACC fortran FE part 1
---
gcc/fortran/decl.c | 1 +
gcc/fortran/dump-parse-tree.c | 203 ++++++++++++++++++++
gcc/fortran/gfortran.h | 81 +++++++-
gcc/fortran/match.c | 34 +++-
gcc/fortran/match.h | 15 ++
gcc/fortran/parse.c | 425 ++++++++++++++++++++++++++++++++++++++----
gcc/fortran/parse.h | 4 +-
gcc/fortran/resolve.c | 36 ++++
gcc/fortran/scanner.c | 382 +++++++++++++++++++++++++++++--------
gcc/fortran/st.c | 14 +-
10 files changed, 1082 insertions(+), 113 deletions(-)
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 0a0f8e0..e988983 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -6000,6 +6000,7 @@ gfc_match_end (gfc_statement *st)
case COMP_CONTAINS:
case COMP_DERIVED_CONTAINS:
+ case COMP_OACC_STRUCTURED_BLOCK:
state = gfc_state_stack->previous->state;
block_name = gfc_state_stack->previous->sym == NULL
? NULL : gfc_state_stack->previous->sym->name;
diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c
index 14ff004..74be9ba 100644
--- a/gcc/fortran/dump-parse-tree.c
+++ b/gcc/fortran/dump-parse-tree.c
@@ -1230,6 +1230,194 @@ show_omp_node (int level, gfc_code *c)
fprintf (dumpfile, " (%s)", c->ext.omp_name);
}
+/* Show a single OpenACC directive node and everything underneath it
+ if necessary. */
+
+static void
+show_oacc_node (int level, gfc_code *c)
+{
+ gfc_oacc_clauses *acc_clauses = NULL;
+ const char *name = NULL;
+
+ switch (c->op)
+ {
+ case EXEC_OACC_PARALLEL_LOOP: name = "PARALLEL LOOP"; break;
+ case EXEC_OACC_PARALLEL: name = "PARALLEL"; break;
+ case EXEC_OACC_KERNELS_LOOP: name = "KERNELS LOOP"; break;
+ case EXEC_OACC_KERNELS: name = "KERNELS"; break;
+ case EXEC_OACC_DATA: name = "DATA"; break;
+ case EXEC_OACC_HOST_DATA: name = "HOST_DATA"; break;
+ case EXEC_OACC_LOOP: name = "LOOP"; break;
+ case EXEC_OACC_UPDATE: name = "UPDATE"; break;
+ case EXEC_OACC_WAIT: name = "WAIT"; break;
+ case EXEC_OACC_CACHE: name = "CACHE"; break;
+ case EXEC_OACC_ENTER_DATA: name = "ENTER DATA"; break;
+ case EXEC_OACC_EXIT_DATA: name = "EXIT DATA"; break;
+ default:
+ gcc_unreachable ();
+ }
+ fprintf (dumpfile, "!$ACC %s", name);
+ acc_clauses = c->ext.omp_clauses;
+ if (acc_clauses)
+ {
+ int list;
+
+ if (acc_clauses->if_expr)
+ {
+ fputs (" IF(", dumpfile);
+ show_expr (acc_clauses->if_expr);
+ fputc (')', dumpfile);
+ }
+ if (acc_clauses->async)
+ {
+ fputs (" ASYNC", dumpfile);
+ if (acc_clauses->async_expr)
+ {
+ fputc ('(', dumpfile);
+ show_expr (acc_clauses->async_expr);
+ fputc (')', dumpfile);
+ }
+ }
+ if (acc_clauses->num_gangs_expr)
+ {
+ fputs (" NUM_GANGS(", dumpfile);
+ show_expr (acc_clauses->num_gangs_expr);
+ fputc (')', dumpfile);
+ }
+ if (acc_clauses->num_workers_expr)
+ {
+ fputs (" NUM_WORKERS(", dumpfile);
+ show_expr (acc_clauses->num_workers_expr);
+ fputc (')', dumpfile);
+ }
+ if (acc_clauses->vector_length_expr)
+ {
+ fputs (" VECTOR_LENGTH(", dumpfile);
+ show_expr (acc_clauses->vector_length_expr);
+ fputc (')', dumpfile);
+ }
+ if (acc_clauses->collapse)
+ {
+ fputs (" COLLAPSE(", dumpfile);
+ fprintf (dumpfile, "%d", acc_clauses->collapse);
+ fputc (')', dumpfile);
+ }
+ if (acc_clauses->gang)
+ {
+ fputs (" GANG", dumpfile);
+ if (acc_clauses->gang_expr)
+ {
+ fputc ('(', dumpfile);
+ show_expr (acc_clauses->gang_expr);
+ fputc (')', dumpfile);
+ }
+ }
+ if (acc_clauses->worker)
+ {
+ fputs (" WORKER", dumpfile);
+ if (acc_clauses->worker_expr)
+ {
+ fputc ('(', dumpfile);
+ show_expr (acc_clauses->worker_expr);
+ fputc (')', dumpfile);
+ }
+ }
+ if (acc_clauses->vector)
+ {
+ fputs (" VECTOR", dumpfile);
+ if (acc_clauses->vector_expr)
+ {
+ fputc ('(', dumpfile);
+ show_expr (acc_clauses->vector_expr);
+ fputc (')', dumpfile);
+ }
+ }
+ if (acc_clauses->non_clause_wait_expr)
+ {
+ fputc ('(', dumpfile);
+ show_expr (acc_clauses->non_clause_wait_expr);
+ fputc (')', dumpfile);
+ }
+ if (acc_clauses->seq)
+ fputs (" SEQ", dumpfile);
+ if (acc_clauses->independent)
+ fputs (" INDEPENDENT", dumpfile);
+ for (list = 0; list < OACC_LIST_NUM; list++)
+ if (acc_clauses->lists[list] != NULL)
+ {
+ const char *name;
+ if (list < OACC_LIST_REDUCTION_FIRST)
+ {
+ switch (list)
+ {
+ case OACC_LIST_COPY: name = "COPY"; break;
+ case OACC_LIST_COPYIN: name = "COPYIN"; break;
+ case OACC_LIST_COPYOUT: name = "COPYOUT"; break;
+ case OACC_LIST_CREATE: name = "CREATE"; break;
+ case OACC_LIST_DELETE: name = "DELETE"; break;
+ case OACC_LIST_PRESENT: name = "PRESENT"; break;
+ case OACC_LIST_PRESENT_OR_COPY:
+ name = "PRESENT_OR_COPY"; break;
+ case OACC_LIST_PRESENT_OR_COPYIN:
+ name = "PRESENT_OR_COPYIN"; break;
+ case OACC_LIST_PRESENT_OR_COPYOUT:
+ name = "PRESENT_OR_COPYOUT"; break;
+ case OACC_LIST_PRESENT_OR_CREATE:
+ name = "PRESENT_OR_CREATE"; break;
+ case OACC_LIST_DEVICEPTR: name = "DEVICEPTR"; break;
+ case OMP_LIST_PRIVATE: name = "PRIVATE"; break;
+ case OMP_LIST_FIRSTPRIVATE: name = "FIRSTPRIVATE"; break;
+ case OACC_LIST_USE_DEVICE: name = "USE_DEVICE"; break;
+ case OACC_LIST_DEVICE_RESIDENT: name = "USE_DEVICE"; break;
+ case OACC_LIST_HOST: name = "HOST"; break;
+ case OACC_LIST_DEVICE: name = "DEVICE"; break;
+ case OACC_LIST_CACHE: name = ""; break;
+ default:
+ gcc_unreachable ();
+ }
+ if (acc_clauses->lists[list] != NULL)
+ fprintf (dumpfile, " %s(", name);
+ }
+ else
+ {
+ switch (list)
+ {
+ case OMP_LIST_PLUS: name = "+"; break;
+ case OMP_LIST_MULT: name = "*"; break;
+ case OMP_LIST_SUB: name = "-"; break;
+ case OMP_LIST_AND: name = ".AND."; break;
+ case OMP_LIST_OR: name = ".OR."; break;
+ case OMP_LIST_EQV: name = ".EQV."; break;
+ case OMP_LIST_NEQV: name = ".NEQV."; break;
+ case OMP_LIST_MAX: name = "MAX"; break;
+ case OMP_LIST_MIN: name = "MIN"; break;
+ case OMP_LIST_IAND: name = "IAND"; break;
+ case OMP_LIST_IOR: name = "IOR"; break;
+ case OMP_LIST_IEOR: name = "IEOR"; break;
+ default:
+ gcc_unreachable ();
+ }
+ fprintf (dumpfile, " REDUCTION(%s:", name);
+ }
+ if (acc_clauses->lists[list] != NULL)
+ {
+ show_namelist (acc_clauses->lists[list]);
+ fputc (')', dumpfile);
+ }
+ }
+ }
+ if (c->op == EXEC_OACC_UPDATE || c->op == EXEC_OACC_WAIT
+ || c->op == EXEC_OACC_CACHE || c->op == EXEC_OACC_ENTER_DATA
+ || c->op == EXEC_OACC_EXIT_DATA)
+ return;
+ show_code (level + 1, c->block->next);
+ fputc ('\n', dumpfile);
+ if (c->op == EXEC_OACC_LOOP)
+ return;
+ code_indent (level, 0);
+ fprintf (dumpfile, "!$ACC END %s", name);
+}
+
/* Show a single code node and everything underneath it if necessary. */
@@ -2193,6 +2381,21 @@ show_code_node (int level, gfc_code *c)
fprintf (dumpfile, " EOR=%d", dt->eor->value);
break;
+ case EXEC_OACC_PARALLEL_LOOP:
+ case EXEC_OACC_PARALLEL:
+ case EXEC_OACC_KERNELS_LOOP:
+ case EXEC_OACC_KERNELS:
+ case EXEC_OACC_DATA:
+ case EXEC_OACC_HOST_DATA:
+ case EXEC_OACC_LOOP:
+ case EXEC_OACC_UPDATE:
+ case EXEC_OACC_WAIT:
+ case EXEC_OACC_CACHE:
+ case EXEC_OACC_ENTER_DATA:
+ case EXEC_OACC_EXIT_DATA:
+ show_oacc_node (level, c);
+ break;
+
case EXEC_OMP_ATOMIC:
case EXEC_OMP_BARRIER:
case EXEC_OMP_CRITICAL:
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index df4b356..4955b3a 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -203,6 +203,12 @@ typedef enum
ST_WRITE, ST_ASSIGNMENT, ST_POINTER_ASSIGNMENT, ST_SELECT_CASE, ST_SEQUENCE,
ST_SIMPLE_IF, ST_STATEMENT_FUNCTION, ST_DERIVED_DECL, ST_LABEL_ASSIGNMENT,
ST_ENUM, ST_ENUMERATOR, ST_END_ENUM, ST_SELECT_TYPE, ST_TYPE_IS, ST_CLASS_IS,
+ ST_OACC_PARALLEL_LOOP, ST_OACC_END_PARALLEL_LOOP, ST_OACC_PARALLEL,
+ ST_OACC_END_PARALLEL, ST_OACC_KERNELS, ST_OACC_END_KERNELS, ST_OACC_DATA,
+ ST_OACC_END_DATA, ST_OACC_HOST_DATA, ST_OACC_END_HOST_DATA, ST_OACC_LOOP,
+ ST_OACC_DECLARE, ST_OACC_UPDATE, ST_OACC_WAIT, ST_OACC_CACHE,
+ ST_OACC_KERNELS_LOOP, ST_OACC_END_KERNELS_LOOP,
+ ST_OACC_ENTER_DATA, ST_OACC_EXIT_DATA,
ST_OMP_ATOMIC, ST_OMP_BARRIER, ST_OMP_CRITICAL, ST_OMP_END_ATOMIC,
ST_OMP_END_CRITICAL, ST_OMP_END_DO, ST_OMP_END_MASTER, ST_OMP_END_ORDERED,
ST_OMP_END_PARALLEL, ST_OMP_END_PARALLEL_DO, ST_OMP_END_PARALLEL_SECTIONS,
@@ -1025,16 +1031,29 @@ gfc_namelist;
#define gfc_get_namelist() XCNEW (gfc_namelist)
+/* Likewise to gfc_namelist, but contains expressions. */
+typedef struct gfc_exprlist
+{
+ struct gfc_expr *expr;
+ struct gfc_exprlist *next;
+}
+gfc_exprlist;
+
+#define gfc_get_exprlist() XCNEW (gfc_exprlist)
+
enum
{
OMP_LIST_PRIVATE,
+ OACC_LIST_PRIVATE = OMP_LIST_PRIVATE,
OMP_LIST_FIRSTPRIVATE,
+ OACC_LIST_FIRSTPRIVATE = OMP_LIST_FIRSTPRIVATE,
OMP_LIST_LASTPRIVATE,
OMP_LIST_COPYPRIVATE,
OMP_LIST_SHARED,
OMP_LIST_COPYIN,
OMP_LIST_PLUS,
OMP_LIST_REDUCTION_FIRST = OMP_LIST_PLUS,
+ OACC_LIST_REDUCTION_FIRST = OMP_LIST_REDUCTION_FIRST,
OMP_LIST_MULT,
OMP_LIST_SUB,
OMP_LIST_AND,
@@ -1047,7 +1066,29 @@ enum
OMP_LIST_IOR,
OMP_LIST_IEOR,
OMP_LIST_REDUCTION_LAST = OMP_LIST_IEOR,
- OMP_LIST_NUM
+ OACC_LIST_REDUCTION_LAST = OMP_LIST_REDUCTION_LAST,
+ OMP_LIST_NUM,
+
+ OACC_LIST_COPY = OMP_LIST_NUM,
+ OACC_LIST_FIRST = OACC_LIST_COPY,
+ OACC_LIST_DATA_CLAUSE_FIRST = OACC_LIST_COPY,
+ OACC_LIST_COPYIN,
+ OACC_LIST_COPYOUT,
+ OACC_LIST_CREATE,
+ OACC_LIST_DELETE,
+ OACC_LIST_PRESENT,
+ OACC_LIST_PRESENT_OR_COPY,
+ OACC_LIST_PRESENT_OR_COPYIN,
+ OACC_LIST_PRESENT_OR_COPYOUT,
+ OACC_LIST_PRESENT_OR_CREATE,
+ OACC_LIST_DEVICEPTR,
+ OACC_LIST_DATA_CLAUSE_LAST = OACC_LIST_DEVICEPTR,
+ OACC_LIST_USE_DEVICE,
+ OACC_LIST_DEVICE_RESIDENT,
+ OACC_LIST_HOST,
+ OACC_LIST_DEVICE,
+ OACC_LIST_CACHE,
+ OACC_LIST_NUM
};
/* Because a symbol can belong to multiple namelists, they must be
@@ -1077,17 +1118,42 @@ typedef struct gfc_omp_clauses
struct gfc_expr *if_expr;
struct gfc_expr *final_expr;
struct gfc_expr *num_threads;
- gfc_namelist *lists[OMP_LIST_NUM];
+ gfc_namelist *lists[OACC_LIST_NUM];
enum gfc_omp_sched_kind sched_kind;
struct gfc_expr *chunk_size;
enum gfc_omp_default_sharing default_sharing;
int collapse;
bool nowait, ordered, untied, mergeable;
+
+ /* OpenACC. */
+ bool is_acc;
+ struct gfc_expr *async_expr;
+ struct gfc_expr *gang_expr;
+ struct gfc_expr *worker_expr;
+ struct gfc_expr *vector_expr;
+ struct gfc_expr *num_gangs_expr;
+ struct gfc_expr *num_workers_expr;
+ struct gfc_expr *vector_length_expr;
+ struct gfc_expr *non_clause_wait_expr;
+ gfc_exprlist *waitlist;
+ gfc_exprlist *tilelist;
+ bool async, gang, worker, vector, seq, independent;
+ bool default_none, wait, par_auto, gang_static;
}
gfc_omp_clauses;
#define gfc_get_omp_clauses() XCNEW (gfc_omp_clauses)
+typedef gfc_omp_clauses gfc_oacc_clauses;
+
+static inline gfc_oacc_clauses*
+gfc_get_oacc_clauses (void)
+{
+ gfc_oacc_clauses *result = XCNEW (gfc_oacc_clauses);
+ result->is_acc = true;
+ return result;
+}
+
/* The gfc_st_label structure is a BBT attached to a namespace that
records the usage of statement labels within that space. */
@@ -1444,6 +1510,9 @@ typedef struct gfc_namespace
this namespace. */
struct gfc_data *data;
+ /* !$ACC DECLARE clauses */
+ gfc_oacc_clauses *declare_clauses;
+
gfc_charlen *cl_list, *old_cl_list;
gfc_dt_list *derived_types;
@@ -2102,6 +2171,10 @@ typedef enum
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_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_OMP_CRITICAL, EXEC_OMP_DO, EXEC_OMP_FLUSH, EXEC_OMP_MASTER,
EXEC_OMP_ORDERED, EXEC_OMP_PARALLEL, EXEC_OMP_PARALLEL_DO,
EXEC_OMP_PARALLEL_SECTIONS, EXEC_OMP_PARALLEL_WORKSHARE,
@@ -2744,6 +2817,10 @@ void gfc_resolve_omp_parallel_blocks (gfc_code *, gfc_namespace *);
void gfc_resolve_omp_do_blocks (gfc_code *, gfc_namespace *);
void gfc_omp_save_and_clear_state (struct gfc_omp_saved_state *);
void gfc_omp_restore_state (struct gfc_omp_saved_state *);
+void gfc_free_exprlist (gfc_exprlist *);
+void gfc_resolve_oacc_directive (gfc_code *, gfc_namespace *);
+void gfc_resolve_oacc_parallel_loop_blocks (gfc_code *, gfc_namespace *);
+void gfc_resolve_oacc_blocks (gfc_code *, gfc_namespace *);
/* expr.c */
void gfc_free_actual_arglist (gfc_actual_arglist *);
diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c
index 539780a..73b667f 100644
--- a/gcc/fortran/match.c
+++ b/gcc/fortran/match.c
@@ -2515,7 +2515,8 @@ match_exit_cycle (gfc_statement st, gfc_exec_op op)
/* Find the loop specified by the label (or lack of a label). */
for (o = NULL, p = gfc_state_stack; p; p = p->previous)
- if (o == NULL && p->state == COMP_OMP_STRUCTURED_BLOCK)
+ if (o == NULL && (p->state == COMP_OMP_STRUCTURED_BLOCK
+ || p->state == COMP_OACC_STRUCTURED_BLOCK))
o = p;
else if (p->state == COMP_CRITICAL)
{
@@ -2594,7 +2595,36 @@ match_exit_cycle (gfc_statement st, gfc_exec_op op)
o = o->previous;
if (cnt > 0
&& o != NULL
- && o->state == COMP_OMP_STRUCTURED_BLOCK
+ && (o->state == COMP_OMP_STRUCTURED_BLOCK
+ || o->state == COMP_OACC_STRUCTURED_BLOCK)
+ && (o->head->op == EXEC_OACC_LOOP
+ || o->head->op == EXEC_OACC_PARALLEL_LOOP))
+ {
+ int collapse = 1;
+ gcc_assert (o->head->next != NULL
+ && (o->head->next->op == EXEC_DO
+ || o->head->next->op == EXEC_DO_WHILE)
+ && o->previous != NULL
+ && o->previous->tail->op == o->head->op);
+ if (o->previous->tail->ext.omp_clauses != NULL
+ && o->previous->tail->ext.omp_clauses->collapse > 1)
+ collapse = o->previous->tail->ext.omp_clauses->collapse;
+ if (st == ST_EXIT && cnt <= collapse)
+ {
+ gfc_error ("EXIT statement at %C terminating !$ACC LOOP loop");
+ return MATCH_ERROR;
+ }
+ if (st == ST_CYCLE && cnt < collapse)
+ {
+ gfc_error ("CYCLE statement at %C to non-innermost collapsed"
+ " !$ACC LOOP loop");
+ return MATCH_ERROR;
+ }
+ }
+ if (cnt > 0
+ && o != NULL
+ && (o->state == COMP_OMP_STRUCTURED_BLOCK
+ || o->state == COMP_OACC_STRUCTURED_BLOCK)
&& (o->head->op == EXEC_OMP_DO
|| o->head->op == EXEC_OMP_PARALLEL_DO))
{
diff --git a/gcc/fortran/match.h b/gcc/fortran/match.h
index 1a701f0..0018ad3 100644
--- a/gcc/fortran/match.h
+++ b/gcc/fortran/match.h
@@ -122,6 +122,21 @@ gfc_common_head *gfc_get_common (const char *, int);
/* openmp.c. */
+/* OpenACC directive matchers. */
+match gfc_match_oacc_cache (void);
+match gfc_match_oacc_wait (void);
+match gfc_match_oacc_update (void);
+match gfc_match_oacc_declare (void);
+match gfc_match_oacc_loop (void);
+match gfc_match_oacc_host_data (void);
+match gfc_match_oacc_data (void);
+match gfc_match_oacc_kernels (void);
+match gfc_match_oacc_kernels_loop (void);
+match gfc_match_oacc_parallel (void);
+match gfc_match_oacc_parallel_loop (void);
+match gfc_match_oacc_enter_data (void);
+match gfc_match_oacc_exit_data (void);
+
/* OpenMP directive matchers. */
match gfc_match_omp_eos (void);
match gfc_match_omp_atomic (void);
diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index e8b9885..00e49ce 100644
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -532,6 +532,90 @@ decode_statement (void)
}
static gfc_statement
+decode_oacc_directive (void)
+{
+ locus old_locus;
+ char c;
+
+ gfc_enforce_clean_symbol_state ();
+
+ gfc_clear_error (); /* Clear any pending errors. */
+ gfc_clear_warning (); /* Clear any pending warnings. */
+
+ if (gfc_pure (NULL))
+ {
+ gfc_error_now ("OpenACC directives at %C may not appear in PURE "
+ "or ELEMENTAL procedures");
+ gfc_error_recovery ();
+ return ST_NONE;
+ }
+
+ if (gfc_implicit_pure (NULL))
+ gfc_current_ns->proc_name->attr.implicit_pure = 0;
+
+ old_locus = gfc_current_locus;
+
+ /* General OpenACC directive matching: Instead of testing every possible
+ statement, we eliminate most possibilities by peeking at the
+ first character. */
+
+ c = gfc_peek_ascii_char ();
+
+ switch (c)
+ {
+ case 'c':
+ match ("cache", gfc_match_oacc_cache, ST_OACC_CACHE);
+ break;
+ case 'd':
+ match ("data", gfc_match_oacc_data, ST_OACC_DATA);
+ match ("declare", gfc_match_oacc_declare, ST_OACC_DECLARE);
+ break;
+ case 'e':
+ match ("end data", gfc_match_omp_eos, ST_OACC_END_DATA);
+ match ("end host_data", gfc_match_omp_eos, ST_OACC_END_HOST_DATA);
+ match ("end kernels loop", gfc_match_omp_eos, ST_OACC_END_KERNELS_LOOP);
+ match ("end kernels", gfc_match_omp_eos, ST_OACC_END_KERNELS);
+ match ("end parallel loop", gfc_match_omp_eos, ST_OACC_END_PARALLEL_LOOP);
+ match ("end parallel", gfc_match_omp_eos, ST_OACC_END_PARALLEL);
+ match ("enter data", gfc_match_oacc_enter_data, ST_OACC_ENTER_DATA);
+ match ("exit data", gfc_match_oacc_exit_data, ST_OACC_EXIT_DATA);
+ break;
+ case 'h':
+ match ("host_data", gfc_match_oacc_host_data, ST_OACC_HOST_DATA);
+ break;
+ case 'p':
+ match ("parallel loop", gfc_match_oacc_parallel_loop, ST_OACC_PARALLEL_LOOP);
+ match ("parallel", gfc_match_oacc_parallel, ST_OACC_PARALLEL);
+ break;
+ case 'k':
+ match ("kernels loop", gfc_match_oacc_kernels_loop, ST_OACC_KERNELS_LOOP);
+ match ("kernels", gfc_match_oacc_kernels, ST_OACC_KERNELS);
+ break;
+ case 'l':
+ match ("loop", gfc_match_oacc_loop, ST_OACC_LOOP);
+ break;
+ case 'u':
+ match ("update", gfc_match_oacc_update, ST_OACC_UPDATE);
+ break;
+ case 'w':
+ match ("wait", gfc_match_oacc_wait, ST_OACC_WAIT);
+ break;
+ }
+
+ /* All else has failed, so give up. See if any of the matchers has
+ stored an error message of some sort. */
+
+ if (gfc_error_check () == 0)
+ gfc_error_now ("Unclassifiable OpenACC directive at %C");
+
+ reject_statement ();
+
+ gfc_error_recovery ();
+
+ return ST_NONE;
+}
+
+static gfc_statement
decode_omp_directive (void)
{
locus old_locus;
@@ -668,6 +752,21 @@ decode_gcc_attribute (void)
#undef match
+static void
+verify_token_free (const char* token, int length, bool last_was_use_stmt)
+{
+ int i;
+ char c;
+
+ c = gfc_next_ascii_char ();
+ for (i = 0; i < length; i++, c = gfc_next_ascii_char ())
+ gcc_assert (c == token[i]);
+
+ gcc_assert (gfc_is_whitespace(c));
+ gfc_gobble_whitespace ();
+ if (last_was_use_stmt)
+ use_modules ();
+}
/* Get the next statement in free form source. */
@@ -737,7 +836,7 @@ next_free (void)
else if (c == '!')
{
/* Comments have already been skipped by the time we get here,
- except for GCC attributes and OpenMP directives. */
+ except for GCC attributes and OpenMP/OpenACC directives. */
gfc_next_ascii_char (); /* Eat up the exclamation sign. */
c = gfc_peek_ascii_char ();
@@ -754,21 +853,38 @@ next_free (void)
return decode_gcc_attribute ();
}
- else if (c == '$' && gfc_option.gfc_flag_openmp)
- {
- int i;
-
- c = gfc_next_ascii_char ();
- for (i = 0; i < 4; i++, c = gfc_next_ascii_char ())
- gcc_assert (c == "$omp"[i]);
-
- gcc_assert (c == ' ' || c == '\t');
- gfc_gobble_whitespace ();
- if (last_was_use_stmt)
- use_modules ();
- return decode_omp_directive ();
- }
-
+
+ else if (c == '$')
+ {
+ /* Since both OpenMP and OpenACC directives starts with
+ !$ character sequence, we must check all flags combinations */
+ if (gfc_option.gfc_flag_openmp && !gfc_option.gfc_flag_openacc)
+ {
+ verify_token_free ("$omp", 4, last_was_use_stmt);
+ return decode_omp_directive ();
+ }
+ else if (gfc_option.gfc_flag_openmp && gfc_option.gfc_flag_openacc)
+ {
+ gfc_next_ascii_char (); /* Eat up dollar character */
+ c = gfc_peek_ascii_char ();
+
+ if (c == 'o')
+ {
+ verify_token_free ("omp", 3, last_was_use_stmt);
+ return decode_omp_directive ();
+ }
+ else if (c == 'a')
+ {
+ verify_token_free ("acc", 3, last_was_use_stmt);
+ return decode_oacc_directive ();
+ }
+ }
+ else if (gfc_option.gfc_flag_openacc)
+ {
+ verify_token_free ("$acc", 4, last_was_use_stmt);
+ return decode_oacc_directive ();
+ }
+ }
gcc_unreachable ();
}
@@ -784,6 +900,26 @@ next_free (void)
return decode_statement ();
}
+static bool
+verify_token_fixed (const char *token, int length, bool last_was_use_stmt)
+{
+ int i;
+ char c = gfc_next_char_literal (NONSTRING);
+
+ for (i = 0; i < length; i++, c = gfc_next_char_literal (NONSTRING))
+ gcc_assert ((char) gfc_wide_tolower (c) == token[i]);
+
+ if (c != ' ' && c != '0')
+ {
+ gfc_buffer_error (0);
+ gfc_error ("Bad continuation line at %C");
+ return false;
+ }
+ if (last_was_use_stmt)
+ use_modules ();
+
+ return true;
+}
/* Get the next statement in fixed-form source. */
@@ -843,21 +979,38 @@ next_fixed (void)
return decode_gcc_attribute ();
}
- else if (c == '$' && gfc_option.gfc_flag_openmp)
- {
- for (i = 0; i < 4; i++, c = gfc_next_char_literal (NONSTRING))
- gcc_assert ((char) gfc_wide_tolower (c) == "$omp"[i]);
-
- if (c != ' ' && c != '0')
- {
- gfc_buffer_error (0);
- gfc_error ("Bad continuation line at %C");
- return ST_NONE;
- }
- if (last_was_use_stmt)
- use_modules ();
- return decode_omp_directive ();
- }
+ else if (c == '$')
+ {
+ if (gfc_option.gfc_flag_openmp && !gfc_option.gfc_flag_openacc)
+ {
+ if (!verify_token_fixed ("omp", 3, last_was_use_stmt))
+ return ST_NONE;
+ return decode_omp_directive ();
+ }
+ else if (gfc_option.gfc_flag_openmp
+ && gfc_option.gfc_flag_openacc)
+ {
+ c = gfc_next_char_literal(NONSTRING);
+ if (c == 'o' || c == 'O')
+ {
+ if (!verify_token_fixed ("mp", 2, last_was_use_stmt))
+ return ST_NONE;
+ return decode_omp_directive ();
+ }
+ else if (c == 'a' || c == 'A')
+ {
+ if (!verify_token_fixed ("cc", 2, last_was_use_stmt))
+ return ST_NONE;
+ return decode_oacc_directive ();
+ }
+ }
+ else if (gfc_option.gfc_flag_openacc)
+ {
+ if (!verify_token_fixed ("acc", 3, last_was_use_stmt))
+ return ST_NONE;
+ return decode_oacc_directive ();
+ }
+ }
/* FALLTHROUGH */
/* Comments have already been skipped by the time we get
@@ -1015,7 +1168,9 @@ next_statement (void)
case ST_LABEL_ASSIGNMENT: case ST_FLUSH: case ST_OMP_FLUSH: \
case ST_OMP_BARRIER: case ST_OMP_TASKWAIT: case ST_OMP_TASKYIELD: \
case ST_ERROR_STOP: case ST_SYNC_ALL: case ST_SYNC_IMAGES: \
- case ST_SYNC_MEMORY: case ST_LOCK: case ST_UNLOCK
+ case ST_SYNC_MEMORY: case ST_LOCK: case ST_UNLOCK: case ST_OACC_UPDATE: \
+ case ST_OACC_WAIT: case ST_OACC_CACHE: case ST_OACC_ENTER_DATA: \
+ case ST_OACC_EXIT_DATA
/* Statements that mark other executable statements. */
@@ -1027,7 +1182,9 @@ next_statement (void)
case ST_OMP_CRITICAL: case ST_OMP_MASTER: case ST_OMP_SINGLE: \
case ST_OMP_DO: case ST_OMP_PARALLEL_DO: case ST_OMP_ATOMIC: \
case ST_OMP_WORKSHARE: case ST_OMP_PARALLEL_WORKSHARE: \
- case ST_OMP_TASK: case ST_CRITICAL
+ case ST_OMP_TASK: case ST_CRITICAL: \
+ case ST_OACC_PARALLEL_LOOP: case ST_OACC_PARALLEL: case ST_OACC_KERNELS: \
+ case ST_OACC_DATA: case ST_OACC_HOST_DATA: case ST_OACC_LOOP: case ST_OACC_KERNELS_LOOP
/* Declaration statements */
@@ -1054,6 +1211,8 @@ push_state (gfc_state_data *p, gfc_compile_state new_state, gfc_symbol *sym)
p->sym = sym;
p->head = p->tail = NULL;
p->do_variable = NULL;
+ if (p->state != COMP_DO && p->state != COMP_DO_CONCURRENT)
+ p->ext.declare_clauses = NULL;
/* If this the state of a construct like BLOCK, DO or IF, the corresponding
construct statement was accepted right before pushing the state. Thus,
@@ -1519,6 +1678,63 @@ gfc_ascii_statement (gfc_statement st)
case ST_END_ENUM:
p = "END ENUM";
break;
+ case ST_OACC_PARALLEL_LOOP:
+ p = "!$ACC PARALLEL LOOP";
+ break;
+ case ST_OACC_END_PARALLEL_LOOP:
+ p = "!$ACC END PARALLEL LOOP";
+ break;
+ case ST_OACC_PARALLEL:
+ p = "!$ACC PARALLEL";
+ break;
+ case ST_OACC_END_PARALLEL:
+ p = "!$ACC END PARALLEL";
+ break;
+ case ST_OACC_KERNELS:
+ p = "!$ACC KERNELS";
+ break;
+ case ST_OACC_END_KERNELS:
+ p = "!$ACC END KERNELS";
+ break;
+ case ST_OACC_KERNELS_LOOP:
+ p = "!$ACC KERNELS LOOP";
+ break;
+ case ST_OACC_END_KERNELS_LOOP:
+ p = "!$ACC END KERNELS LOOP";
+ break;
+ case ST_OACC_DATA:
+ p = "!$ACC DATA";
+ break;
+ case ST_OACC_END_DATA:
+ p = "!$ACC END DATA";
+ break;
+ case ST_OACC_HOST_DATA:
+ p = "!$ACC HOST_DATA";
+ break;
+ case ST_OACC_END_HOST_DATA:
+ p = "!$ACC END HOST_DATA";
+ break;
+ case ST_OACC_LOOP:
+ p = "!$ACC LOOP";
+ break;
+ case ST_OACC_DECLARE:
+ p = "!$ACC DECLARE";
+ break;
+ case ST_OACC_UPDATE:
+ p = "!$ACC UPDATE";
+ break;
+ case ST_OACC_WAIT:
+ p = "!$ACC WAIT";
+ break;
+ case ST_OACC_CACHE:
+ p = "!$ACC CACHE";
+ break;
+ case ST_OACC_ENTER_DATA:
+ p = "!$ACC ENTER DATA";
+ break;
+ case ST_OACC_EXIT_DATA:
+ p = "!$ACC EXIT DATA";
+ break;
case ST_OMP_ATOMIC:
p = "!$OMP ATOMIC";
break;
@@ -1883,6 +2099,7 @@ verify_st_order (st_state *p, gfc_statement st, bool silent)
case ST_PUBLIC:
case ST_PRIVATE:
case ST_DERIVED_DECL:
+ case ST_OACC_DECLARE:
case_decl:
if (p->state >= ORDER_EXEC)
goto order;
@@ -2784,6 +3001,21 @@ declSt:
st = next_statement ();
goto loop;
+ case ST_OACC_DECLARE:
+ if (!verify_st_order(&ss, st, false))
+ {
+ reject_statement ();
+ st = next_statement ();
+ goto loop;
+ }
+ if (gfc_state_stack->ext.declare_clauses == NULL)
+ {
+ gfc_state_stack->ext.declare_clauses = new_st.ext.omp_clauses;
+ }
+ accept_statement (st);
+ st = next_statement ();
+ goto loop;
+
default:
break;
}
@@ -3643,6 +3875,113 @@ parse_omp_atomic (void)
}
+/* Parse the statements of an OpenACC structured block. */
+
+static void
+parse_oacc_structured_block (gfc_statement acc_st)
+{
+ gfc_statement st, acc_end_st;
+ gfc_code *cp, *np;
+ gfc_state_data s;
+
+ accept_statement (acc_st);
+
+ cp = gfc_state_stack->tail;
+ push_state (&s, COMP_OACC_STRUCTURED_BLOCK, NULL);
+ np = new_level (cp);
+ np->op = cp->op;
+ np->block = NULL;
+ switch (acc_st)
+ {
+ case ST_OACC_PARALLEL:
+ acc_end_st = ST_OACC_END_PARALLEL;
+ break;
+ case ST_OACC_KERNELS:
+ acc_end_st = ST_OACC_END_KERNELS;
+ break;
+ case ST_OACC_DATA:
+ acc_end_st = ST_OACC_END_DATA;
+ break;
+ case ST_OACC_HOST_DATA:
+ acc_end_st = ST_OACC_END_HOST_DATA;
+ break;
+ default:
+ gcc_unreachable ();
+ }
+
+ do
+ {
+ st = parse_executable (ST_NONE);
+ if (st == ST_NONE)
+ unexpected_eof ();
+ else if (st != acc_end_st)
+ unexpected_statement (st);
+ }
+ while (st != acc_end_st);
+
+ gcc_assert (new_st.op == EXEC_NOP);
+
+ gfc_clear_new_st ();
+ gfc_commit_symbols ();
+ gfc_warning_check ();
+ pop_state ();
+}
+
+/* Parse the statements of OpenACC loop/parallel loop/kernels loop. */
+
+static gfc_statement
+parse_oacc_loop (gfc_statement acc_st)
+{
+ gfc_statement st;
+ gfc_code *cp, *np;
+ gfc_state_data s;
+
+ accept_statement (acc_st);
+
+ cp = gfc_state_stack->tail;
+ push_state (&s, COMP_OACC_STRUCTURED_BLOCK, NULL);
+ np = new_level (cp);
+ np->op = cp->op;
+ np->block = NULL;
+
+ for (;;)
+ {
+ st = next_statement ();
+ if (st == ST_NONE)
+ unexpected_eof ();
+ else if (st == ST_DO)
+ break;
+ else
+ unexpected_statement (st);
+ }
+
+ parse_do_block ();
+ if (gfc_statement_label != NULL
+ && gfc_state_stack->previous != NULL
+ && gfc_state_stack->previous->state == COMP_DO
+ && gfc_state_stack->previous->ext.end_do_label == gfc_statement_label)
+ {
+ pop_state ();
+ return ST_IMPLIED_ENDDO;
+ }
+
+ check_do_closure ();
+ pop_state ();
+
+ st = next_statement ();
+ if ((acc_st == ST_OACC_PARALLEL_LOOP && st == ST_OACC_END_PARALLEL_LOOP) ||
+ (acc_st == ST_OACC_KERNELS_LOOP && st == ST_OACC_END_KERNELS_LOOP))
+ {
+ gcc_assert (new_st.op == EXEC_NOP);
+ gfc_clear_new_st ();
+ gfc_commit_symbols ();
+ gfc_warning_check ();
+ st = next_statement ();
+ }
+ return st;
+}
+
+
/* Parse the statements of an OpenMP structured block. */
static void
@@ -3910,6 +4249,21 @@ parse_executable (gfc_statement st)
parse_forall_block ();
break;
+ case ST_OACC_PARALLEL_LOOP:
+ case ST_OACC_KERNELS_LOOP:
+ case ST_OACC_LOOP:
+ st = parse_oacc_loop (st);
+ if (st == ST_IMPLIED_ENDDO)
+ return st;
+ continue;
+
+ case ST_OACC_PARALLEL:
+ case ST_OACC_KERNELS:
+ case ST_OACC_DATA:
+ case ST_OACC_HOST_DATA:
+ parse_oacc_structured_block (st);
+ break;
+
case ST_OMP_PARALLEL:
case ST_OMP_PARALLEL_SECTIONS:
case ST_OMP_SECTIONS:
@@ -4220,6 +4574,11 @@ contains:
done:
gfc_current_ns->code = gfc_state_stack->head;
+ if (gfc_state_stack->state == COMP_PROGRAM
+ || gfc_state_stack->state == COMP_MODULE
+ || gfc_state_stack->state == COMP_SUBROUTINE
+ || gfc_state_stack->state == COMP_FUNCTION)
+ gfc_current_ns->declare_clauses = gfc_state_stack->ext.declare_clauses;
}
diff --git a/gcc/fortran/parse.h b/gcc/fortran/parse.h
index acafe6c..7fe1ea3 100644
--- a/gcc/fortran/parse.h
+++ b/gcc/fortran/parse.h
@@ -29,7 +29,8 @@ typedef enum
COMP_BLOCK_DATA, COMP_INTERFACE, COMP_DERIVED, COMP_DERIVED_CONTAINS,
COMP_BLOCK, COMP_ASSOCIATE, COMP_IF,
COMP_DO, COMP_SELECT, COMP_FORALL, COMP_WHERE, COMP_CONTAINS, COMP_ENUM,
- COMP_SELECT_TYPE, COMP_OMP_STRUCTURED_BLOCK, COMP_CRITICAL, COMP_DO_CONCURRENT
+ COMP_SELECT_TYPE, COMP_OMP_STRUCTURED_BLOCK, COMP_CRITICAL, COMP_DO_CONCURRENT,
+ COMP_OACC_STRUCTURED_BLOCK
}
gfc_compile_state;
@@ -49,6 +50,7 @@ typedef struct gfc_state_data
union
{
gfc_st_label *end_do_label;
+ gfc_oacc_clauses *declare_clauses;
}
ext;
}
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 4befb9fd..eb74817 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -8976,6 +8976,18 @@ gfc_resolve_blocks (gfc_code *b, gfc_namespace *ns)
case EXEC_WAIT:
break;
+ case EXEC_OACC_PARALLEL_LOOP:
+ case EXEC_OACC_PARALLEL:
+ case EXEC_OACC_KERNELS_LOOP:
+ case EXEC_OACC_KERNELS:
+ case EXEC_OACC_DATA:
+ case EXEC_OACC_HOST_DATA:
+ case EXEC_OACC_LOOP:
+ case EXEC_OACC_UPDATE:
+ case EXEC_OACC_WAIT:
+ case EXEC_OACC_CACHE:
+ case EXEC_OACC_ENTER_DATA:
+ case EXEC_OACC_EXIT_DATA:
case EXEC_OMP_ATOMIC:
case EXEC_OMP_CRITICAL:
case EXEC_OMP_DO:
@@ -9725,6 +9737,15 @@ resolve_code (gfc_code *code, gfc_namespace *ns)
omp_workshare_save = -1;
switch (code->op)
{
+ case EXEC_OACC_PARALLEL_LOOP:
+ case EXEC_OACC_PARALLEL:
+ case EXEC_OACC_KERNELS_LOOP:
+ case EXEC_OACC_KERNELS:
+ case EXEC_OACC_DATA:
+ case EXEC_OACC_HOST_DATA:
+ case EXEC_OACC_LOOP:
+ gfc_resolve_oacc_blocks (code, ns);
+ break;
case EXEC_OMP_PARALLEL_WORKSHARE:
omp_workshare_save = omp_workshare_flag;
omp_workshare_flag = 1;
@@ -10051,6 +10072,21 @@ resolve_code (gfc_code *code, gfc_namespace *ns)
"expression", &code->expr1->where);
break;
+ case EXEC_OACC_PARALLEL_LOOP:
+ case EXEC_OACC_PARALLEL:
+ case EXEC_OACC_KERNELS_LOOP:
+ case EXEC_OACC_KERNELS:
+ case EXEC_OACC_DATA:
+ case EXEC_OACC_HOST_DATA:
+ case EXEC_OACC_LOOP:
+ case EXEC_OACC_UPDATE:
+ case EXEC_OACC_WAIT:
+ case EXEC_OACC_CACHE:
+ case EXEC_OACC_ENTER_DATA:
+ case EXEC_OACC_EXIT_DATA:
+ gfc_resolve_oacc_directive (code, ns);
+ break;
+
case EXEC_OMP_ATOMIC:
case EXEC_OMP_BARRIER:
case EXEC_OMP_CRITICAL:
diff --git a/gcc/fortran/scanner.c b/gcc/fortran/scanner.c
index 882e2d5..e6da23b 100644
--- a/gcc/fortran/scanner.c
+++ b/gcc/fortran/scanner.c
@@ -55,9 +55,11 @@ gfc_directorylist *include_dirs, *intrinsic_modules_dirs;
static gfc_file *file_head, *current_file;
-static int continue_flag, end_flag, openmp_flag, gcc_attribute_flag;
+static int continue_flag, end_flag, gcc_attribute_flag;
+static int openmp_flag, openacc_flag; /* If !$omp/!&acc occurred in current comment line */
static int continue_count, continue_line;
static locus openmp_locus;
+static locus openacc_locus;
static locus gcc_attribute_locus;
gfc_source_form gfc_current_form;
@@ -728,11 +730,89 @@ skip_gcc_attribute (locus start)
return r;
}
+/* Return true if CC was matched. */
+static bool
+skip_oacc_attribute (locus start, locus old_loc, bool continue_flag)
+{
+ bool r = false;
+ char c;
+ if ((c = next_char ()) == 'c' || c == 'C')
+ if ((c = next_char ()) == 'c' || c == 'C')
+ r = true;
+
+ if (r)
+ {
+ if ((c = next_char ()) == ' ' || c == '\t'
+ || continue_flag)
+ {
+ while (gfc_is_whitespace (c))
+ c = next_char ();
+ if (c != '\n' && c != '!')
+ {
+ openacc_flag = 1;
+ openacc_locus = old_loc;
+ gfc_current_locus = start;
+ }
+ else
+ r = false;
+ }
+ else
+ {
+ gfc_warning_now ("!$ACC at %C starts a commented "
+ "line as it neither is followed "
+ "by a space nor is a "
+ "continuation line");
+ r = false;
+ }
+ }
+
+ return r;
+}
+
+/* Return true if MP was matched. */
+static bool
+skip_omp_attribute (locus start, locus old_loc, bool continue_flag)
+{
+ bool r = false;
+ char c;
+
+ if ((c = next_char ()) == 'm' || c == 'M')
+ if ((c = next_char ()) == 'p' || c == 'P')
+ r = true;
+
+ if (r)
+ {
+ if ((c = next_char ()) == ' ' || c == '\t'
+ || continue_flag)
+ {
+ while (gfc_is_whitespace (c))
+ c = next_char ();
+ if (c != '\n' && c != '!')
+ {
+ openmp_flag = 1;
+ openmp_locus = old_loc;
+ gfc_current_locus = start;
+ }
+ else
+ r = false;
+ }
+ else
+ {
+ gfc_warning_now ("!$OMP at %C starts a commented "
+ "line as it neither is followed "
+ "by a space nor is a "
+ "continuation line");
+ r = false;
+ }
+ }
+
+ return r;
+}
/* Comment lines are null lines, lines containing only blanks or lines
on which the first nonblank line is a '!'.
- Return true if !$ openmp conditional compilation sentinel was
+ Return true if !$ openmp or openacc conditional compilation sentinel was
seen. */
static bool
@@ -762,58 +842,98 @@ skip_free_comments (void)
if (c == '!')
{
/* Keep the !GCC$ line. */
- if (at_bol && skip_gcc_attribute (start))
+ if (at_bol && skip_gcc_attribute (start))
return false;
- /* If -fopenmp, we need to handle here 2 things:
- 1) don't treat !$omp as comments, but directives
- 2) handle OpenMP conditional compilation, where
+ /* If -fopenmp/-fopenacc, we need to handle here 2 things:
+ 1) don't treat !$omp/!$acc as comments, but directives
+ 2) handle OpenMP/OpenACC conditional compilation, where
!$ should be treated as 2 spaces (for initial lines
only if followed by space). */
- if (gfc_option.gfc_flag_openmp && at_bol)
- {
- locus old_loc = gfc_current_locus;
- if (next_char () == '$')
- {
- c = next_char ();
- if (c == 'o' || c == 'O')
- {
- if (((c = next_char ()) == 'm' || c == 'M')
- && ((c = next_char ()) == 'p' || c == 'P'))
- {
- if ((c = next_char ()) == ' ' || c == '\t'
- || continue_flag)
- {
- while (gfc_is_whitespace (c))
- c = next_char ();
- if (c != '\n' && c != '!')
- {
- openmp_flag = 1;
- openmp_locus = old_loc;
- gfc_current_locus = start;
- return false;
- }
- }
- else
- gfc_warning_now ("!$OMP at %C starts a commented "
- "line as it neither is followed "
- "by a space nor is a "
- "continuation line");
- }
- gfc_current_locus = old_loc;
- next_char ();
- c = next_char ();
- }
- if (continue_flag || c == ' ' || c == '\t')
- {
- gfc_current_locus = old_loc;
- next_char ();
- openmp_flag = 0;
- return true;
- }
- }
- gfc_current_locus = old_loc;
- }
+ if (at_bol)
+ {
+ if (gfc_option.gfc_flag_openmp && gfc_option.gfc_flag_openacc)
+ {
+ locus old_loc = gfc_current_locus;
+ if (next_char () == '$')
+ {
+ c = next_char ();
+ if (c == 'o' || c == 'O')
+ {
+ if (skip_omp_attribute (start, old_loc, continue_flag))
+ return false;
+ gfc_current_locus = old_loc;
+ next_char ();
+ c = next_char ();
+ }
+ else if (c == 'a' || c == 'A')
+ {
+ if (skip_oacc_attribute (start, old_loc, continue_flag))
+ return false;
+ gfc_current_locus = old_loc;
+ next_char ();
+ c = next_char ();
+ }
+ if (continue_flag || c == ' ' || c == '\t')
+ {
+ gfc_current_locus = old_loc;
+ next_char ();
+ openmp_flag = openacc_flag = 0;
+ return true;
+ }
+ }
+ gfc_current_locus = old_loc;
+ }
+ else if (gfc_option.gfc_flag_openmp&& !gfc_option.gfc_flag_openacc)
+ {
+ locus old_loc = gfc_current_locus;
+ if (next_char () == '$')
+ {
+ c = next_char ();
+ if (c == 'o' || c == 'O')
+ {
+ if (skip_omp_attribute (start, old_loc, continue_flag))
+ return false;
+ gfc_current_locus = old_loc;
+ next_char ();
+ c = next_char ();
+ }
+ if (continue_flag || c == ' ' || c == '\t')
+ {
+ gfc_current_locus = old_loc;
+ next_char ();
+ openmp_flag = 0;
+ return true;
+ }
+ }
+ gfc_current_locus = old_loc;
+ }
+ else if (gfc_option.gfc_flag_openacc && !gfc_option.gfc_flag_openmp)
+ {
+ locus old_loc = gfc_current_locus;
+ if (next_char() == '$')
+ {
+ c = next_char();
+ if (c == 'a' || c == 'A')
+ {
+ if (skip_oacc_attribute (start, old_loc,
+ continue_flag))
+ return false;
+ gfc_current_locus = old_loc;
+ next_char();
+ c = next_char();
+ }
+ if (continue_flag || c == ' ' || c == '\t')
+ {
+ gfc_current_locus = old_loc;
+ next_char();
+ openacc_flag = 0;
+ return true;
+ }
+ }
+ gfc_current_locus = old_loc;
+ }
+ }
skip_comment_line ();
continue;
}
@@ -824,6 +944,9 @@ skip_free_comments (void)
if (openmp_flag && at_bol)
openmp_flag = 0;
+ if (openacc_flag && at_bol)
+ openacc_flag = 0;
+
gcc_attribute_flag = 0;
gfc_current_locus = start;
return false;
@@ -886,9 +1009,10 @@ skip_fixed_comments (void)
return;
}
- /* If -fopenmp, we need to handle here 2 things:
- 1) don't treat !$omp|c$omp|*$omp as comments, but directives
- 2) handle OpenMP conditional compilation, where
+ /* If -fopenmp/-fopenacc, we need to handle here 2 things:
+ 1) don't treat !$omp/!$acc|c$omp/c$acc|*$omp / *$acc as comments,
+ but directives
+ 2) handle OpenMP/OpenACC conditional compilation, where
!$|c$|*$ should be treated as 2 spaces if the characters
in columns 3 to 6 are valid fixed form label columns
characters. */
@@ -955,6 +1079,67 @@ skip_fixed_comments (void)
}
gfc_current_locus = start;
}
+
+ if (gfc_option.gfc_flag_openacc)
+ {
+ if (next_char () == '$')
+ {
+ c = next_char ();
+ if (c == 'a' || c == 'A')
+ {
+ if (((c = next_char ()) == 'c' || c == 'C')
+ && ((c = next_char ()) == 'c' || c == 'C'))
+ {
+ c = next_char ();
+ if (c != '\n'
+ && ((openacc_flag && continue_flag)
+ || c == ' ' || c == '\t' || c == '0'))
+ {
+ do
+ c = next_char ();
+ while (gfc_is_whitespace (c));
+ if (c != '\n' && c != '!')
+ {
+ /* Canonicalize to *$acc. */
+ *start.nextc = '*';
+ openacc_flag = 1;
+ gfc_current_locus = start;
+ return;
+ }
+ }
+ }
+ }
+ else
+ {
+ int digit_seen = 0;
+
+ for (col = 3; col < 6; col++, c = next_char ())
+ if (c == ' ')
+ continue;
+ else if (c == '\t')
+ {
+ col = 6;
+ break;
+ }
+ else if (c < '0' || c > '9')
+ break;
+ else
+ digit_seen = 1;
+
+ if (col == 6 && c != '\n'
+ && ((continue_flag && !digit_seen)
+ || c == ' ' || c == '\t' || c == '0'))
+ {
+ gfc_current_locus = start;
+ start.nextc[0] = ' ';
+ start.nextc[1] = ' ';
+ continue;
+ }
+ }
+ }
+ gfc_current_locus = start;
+ }
+
skip_comment_line ();
continue;
}
@@ -1025,10 +1210,11 @@ gfc_char_t
gfc_next_char_literal (gfc_instring in_string)
{
locus old_loc;
- int i, prev_openmp_flag;
+ int i, prev_openmp_flag, prev_openacc_flag;
gfc_char_t c;
continue_flag = 0;
+ prev_openacc_flag = prev_openmp_flag = 0;
restart:
c = next_char ();
@@ -1040,7 +1226,7 @@ restart:
if (gfc_current_form == FORM_FREE)
{
- bool openmp_cond_flag;
+ bool openmpacc_cond_flag;
if (!in_string && c == '!')
{
@@ -1054,6 +1240,11 @@ restart:
sizeof (gfc_current_locus)) == 0)
goto done;
+ if (openacc_flag
+ && memcmp (&gfc_current_locus, &openacc_locus,
+ sizeof (gfc_current_locus)) == 0)
+ goto done;
+
/* This line can't be continued */
do
{
@@ -1108,7 +1299,11 @@ restart:
goto done;
}
- prev_openmp_flag = openmp_flag;
+ if (gfc_option.gfc_flag_openmp)
+ prev_openmp_flag = openmp_flag;
+ if (gfc_option.gfc_flag_openacc)
+ prev_openacc_flag = openacc_flag;
+
continue_flag = 1;
if (c == '!')
skip_comment_line ();
@@ -1132,19 +1327,29 @@ restart:
}
/* Now find where it continues. First eat any comment lines. */
- openmp_cond_flag = skip_free_comments ();
+ openmpacc_cond_flag = skip_free_comments ();
if (gfc_current_locus.lb != NULL
&& continue_line < gfc_linebuf_linenum (gfc_current_locus.lb))
continue_line = gfc_linebuf_linenum (gfc_current_locus.lb);
- if (prev_openmp_flag != openmp_flag)
- {
- gfc_current_locus = old_loc;
- openmp_flag = prev_openmp_flag;
- c = '&';
- goto done;
- }
+ if (gfc_option.gfc_flag_openmp)
+ if (prev_openmp_flag != openmp_flag)
+ {
+ gfc_current_locus = old_loc;
+ openmp_flag = prev_openmp_flag;
+ c = '&';
+ goto done;
+ }
+
+ if (gfc_option.gfc_flag_openacc)
+ if (prev_openacc_flag != openacc_flag)
+ {
+ gfc_current_locus = old_loc;
+ openacc_flag = prev_openacc_flag;
+ c = '&';
+ goto done;
+ }
/* Now that we have a non-comment line, probe ahead for the
first non-whitespace character. If it is another '&', then
@@ -1168,6 +1373,17 @@ restart:
while (gfc_is_whitespace (c))
c = next_char ();
}
+ if (openacc_flag)
+ {
+ for (i = 0; i < 5; i++, c = next_char ())
+ {
+ gcc_assert(gfc_wide_tolower (c) == (unsigned char ) "!$acc"[i]);
+ if (i == 4)
+ old_loc = gfc_current_locus;
+ }
+ while (gfc_is_whitespace (c))
+ c = next_char ();
+ }
if (c != '&')
{
@@ -1180,7 +1396,7 @@ restart:
}
/* Both !$omp and !$ -fopenmp continuation lines have & on the
continuation line only optionally. */
- else if (openmp_flag || openmp_cond_flag)
+ else if (openmp_flag || openacc_flag || openmpacc_cond_flag)
gfc_current_locus.nextc--;
else
{
@@ -1217,7 +1433,11 @@ restart:
gfc_warning_now ("Line truncated at %L", &gfc_current_locus);
}
- prev_openmp_flag = openmp_flag;
+ if (gfc_option.gfc_flag_openmp)
+ prev_openmp_flag = openmp_flag;
+ if (gfc_option.gfc_flag_openacc)
+ prev_openacc_flag = openacc_flag;
+
continue_flag = 1;
old_loc = gfc_current_locus;
@@ -1225,26 +1445,40 @@ restart:
skip_fixed_comments ();
/* See if this line is a continuation line. */
- if (openmp_flag != prev_openmp_flag)
- {
- openmp_flag = prev_openmp_flag;
- goto not_continuation;
- }
-
- if (!openmp_flag)
+ if (gfc_option.gfc_flag_openmp)
+ if (openmp_flag != prev_openmp_flag)
+ {
+ openmp_flag = prev_openmp_flag;
+ goto not_continuation;
+ }
+ if (gfc_option.gfc_flag_openacc)
+ if (openacc_flag != prev_openacc_flag)
+ {
+ openacc_flag = prev_openacc_flag;
+ goto not_continuation;
+ }
+
+ if (!openmp_flag && !openacc_flag)
for (i = 0; i < 5; i++)
{
c = next_char ();
if (c != ' ')
goto not_continuation;
}
- else
+ else if (openmp_flag)
for (i = 0; i < 5; i++)
{
c = next_char ();
if (gfc_wide_tolower (c) != (unsigned char) "*$omp"[i])
goto not_continuation;
}
+ else if (openacc_flag)
+ for (i = 0; i > 5; i++)
+ {
+ c = next_char ();
+ if (gfc_wide_tolower (c) != (unsigned char) "*$omp"[i])
+ goto not_continuation;
+ }
c = next_char ();
if (c == '0' || c == ' ' || c == '\n')
diff --git a/gcc/fortran/st.c b/gcc/fortran/st.c
index f8b341c..4d0a725 100644
--- a/gcc/fortran/st.c
+++ b/gcc/fortran/st.c
@@ -184,7 +184,19 @@ gfc_free_statement (gfc_code *p)
case EXEC_FORALL:
gfc_free_forall_iterator (p->ext.forall_iterator);
break;
-
+
+ case EXEC_OACC_PARALLEL_LOOP:
+ case EXEC_OACC_PARALLEL:
+ case EXEC_OACC_KERNELS_LOOP:
+ case EXEC_OACC_KERNELS:
+ case EXEC_OACC_DATA:
+ case EXEC_OACC_HOST_DATA:
+ case EXEC_OACC_LOOP:
+ case EXEC_OACC_UPDATE:
+ case EXEC_OACC_WAIT:
+ case EXEC_OACC_CACHE:
+ case EXEC_OACC_ENTER_DATA:
+ case EXEC_OACC_EXIT_DATA:
case EXEC_OMP_DO:
case EXEC_OMP_END_SINGLE:
case EXEC_OMP_PARALLEL:
--
1.8.3.2
^ permalink raw reply [flat|nested] 89+ messages in thread
* [PATCH 3/6] [GOMP4] OpenACC 1.0+ support in fortran front-end
2014-01-23 18:03 ` [PATCH 2/6] " Ilmir Usmanov
@ 2014-01-23 18:04 ` Ilmir Usmanov
2014-01-23 18:05 ` [PATCH 4/6] " Ilmir Usmanov
2014-01-24 20:47 ` [PATCH 2/6] [GOMP4] OpenACC 1.0+ support in fortran front-end Thomas Schwinge
1 sibling, 1 reply; 89+ messages in thread
From: Ilmir Usmanov @ 2014-01-23 18:04 UTC (permalink / raw)
To: gcc-patches, Thomas Schwinge, jakub
Cc: Evgeny Gavrin, GarbuzovViacheslav, Dmitri Botcharnikov
[-- Attachment #1: Type: text/plain, Size: 1 bytes --]
[-- Attachment #2: 0003-OpenACC-fortran-FE-part-3.patch --]
[-- Type: text/x-diff, Size: 23016 bytes --]
From 0658580cf665b8da8cc4533901989b7a1d54f73a Mon Sep 17 00:00:00 2001
From: Ilmir Usmanov <i.usmanov@samsung.com>
Date: Thu, 23 Jan 2014 21:06:00 +0400
Subject: [PATCH 3/6] OpenACC fortran FE part 3
---
gcc/fortran/trans-decl.c | 7 +
gcc/fortran/trans-openmp.c | 526 ++++++++++++++++++++++++++++++++++++++++++++-
gcc/fortran/trans-stmt.h | 4 +
gcc/fortran/trans.c | 15 ++
4 files changed, 543 insertions(+), 9 deletions(-)
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index f974c6e..a7dde4f 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -5529,6 +5529,13 @@ gfc_generate_function_code (gfc_namespace * ns)
if ((gfc_option.rtcheck & GFC_RTCHECK_BOUNDS) && !sym->attr.is_bind_c)
add_argument_checking (&body, sym);
+ /* Generate !$ACC DECLARE directive. */
+ if (ns->declare_clauses)
+ {
+ tmp = gfc_trans_oacc_declare(&body, ns);
+ gfc_add_expr_to_block(&body, tmp);
+ }
+
tmp = gfc_trans_code (ns->code);
gfc_add_expr_to_block (&body, tmp);
diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
index d23af17..c43b375 100644
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -418,6 +418,12 @@ gfc_omp_firstprivatize_type_sizes (struct gimplify_omp_ctx *ctx, tree type)
}
}
+static inline tree
+gfc_trans_oacc_add_clause (tree node, tree tail)
+{
+ OACC_CLAUSE_CHAIN (node) = tail;
+ return node;
+}
static inline tree
gfc_trans_add_clause (tree node, tree tail)
@@ -480,6 +486,27 @@ gfc_trans_omp_variable (gfc_symbol *sym)
return t;
}
+static inline tree
+gfc_trans_oacc_variable (gfc_symbol *sym)
+{
+ return gfc_trans_omp_variable (sym);
+}
+
+static inline tree
+gfc_convert_oacc_expr_to_tree (stmtblock_t *block, gfc_expr *expr)
+{
+ gfc_se se;
+ tree result;
+
+ gfc_init_se (&se, NULL );
+ gfc_conv_expr (&se, expr);
+ gfc_add_block_to_block (block, &se.pre);
+ result = gfc_evaluate_now (se.expr, block);
+ gfc_add_block_to_block (block, &se.post);
+
+ return result;
+}
+
static tree
gfc_trans_omp_variable_list (enum omp_clause_code code, gfc_namelist *namelist,
tree list)
@@ -498,20 +525,33 @@ gfc_trans_omp_variable_list (enum omp_clause_code code, gfc_namelist *namelist,
return list;
}
+static tree
+gfc_trans_oacc_variable_list (enum omp_clause_code code,
+ gfc_namelist *namelist, tree list)
+{
+ return gfc_trans_omp_variable_list (code, namelist, list);
+}
+
static void
-gfc_trans_omp_array_reduction (tree c, gfc_symbol *sym, locus where)
+gfc_trans_omp_array_reduction (tree c, gfc_symbol *sym, locus where,
+ bool is_acc)
{
gfc_symtree *root1 = NULL, *root2 = NULL, *root3 = NULL, *root4 = NULL;
gfc_symtree *symtree1, *symtree2, *symtree3, *symtree4 = NULL;
gfc_symbol init_val_sym, outer_sym, intrinsic_sym;
gfc_expr *e1, *e2, *e3, *e4;
gfc_ref *ref;
- tree decl, backend_decl, stmt, type, outer_decl;
+ tree decl, backend_decl, stmt, type, outer_decl, prev_decl;
+ enum tree_code reduction_code;
locus old_loc = gfc_current_locus;
const char *iname;
bool t;
- decl = OMP_CLAUSE_DECL (c);
+ if (is_acc)
+ decl = prev_decl = OACC_CLAUSE_DECL (c);
+ else
+ decl = prev_decl = OMP_CLAUSE_DECL (c);
+
gfc_current_locus = where;
type = TREE_TYPE (decl);
outer_decl = create_tmp_var_raw (type, NULL);
@@ -542,7 +582,7 @@ gfc_trans_omp_array_reduction (tree c, gfc_symbol *sym, locus where)
outer_sym.attr.result = 0;
outer_sym.attr.flavor = FL_VARIABLE;
outer_sym.backend_decl = outer_decl;
- if (decl != OMP_CLAUSE_DECL (c))
+ if (decl != prev_decl)
outer_sym.backend_decl = build_fold_indirect_ref (outer_decl);
/* Create fake symtrees for it. */
@@ -587,7 +627,12 @@ gfc_trans_omp_array_reduction (tree c, gfc_symbol *sym, locus where)
gcc_assert (t);
iname = NULL;
- switch (OMP_CLAUSE_REDUCTION_CODE (c))
+ if (is_acc)
+ reduction_code = OACC_CLAUSE_REDUCTION_CODE (c);
+ else
+ reduction_code = OMP_CLAUSE_REDUCTION_CODE (c);
+
+ switch (reduction_code)
{
case PLUS_EXPR:
case MINUS_EXPR:
@@ -702,7 +747,11 @@ gfc_trans_omp_array_reduction (tree c, gfc_symbol *sym, locus where)
stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0));
else
poplevel (0, 0);
- OMP_CLAUSE_REDUCTION_INIT (c) = stmt;
+
+ if (is_acc)
+ OACC_CLAUSE_REDUCTION_INIT (c) = stmt;
+ else
+ OMP_CLAUSE_REDUCTION_INIT (c) = stmt;
/* Create the merge statement list. */
pushlevel ();
@@ -726,10 +775,18 @@ gfc_trans_omp_array_reduction (tree c, gfc_symbol *sym, locus where)
stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0));
else
poplevel (0, 0);
- OMP_CLAUSE_REDUCTION_MERGE (c) = stmt;
/* And stick the placeholder VAR_DECL into the clause as well. */
- OMP_CLAUSE_REDUCTION_PLACEHOLDER (c) = outer_decl;
+ if (is_acc)
+ {
+ OACC_CLAUSE_REDUCTION_MERGE (c) = stmt;
+ OACC_CLAUSE_REDUCTION_PLACEHOLDER (c) = outer_decl;
+ }
+ else
+ {
+ OMP_CLAUSE_REDUCTION_MERGE (c) = stmt;
+ OMP_CLAUSE_REDUCTION_PLACEHOLDER (c) = outer_decl;
+ }
gfc_current_locus = old_loc;
@@ -745,6 +802,28 @@ gfc_trans_omp_array_reduction (tree c, gfc_symbol *sym, locus where)
}
static tree
+gfc_trans_oacc_reduction_list (gfc_namelist *namelist, tree list,
+ enum tree_code reduction_code, locus where)
+{
+ for (; namelist != NULL; namelist = namelist->next)
+ if (namelist->sym->attr.referenced)
+ {
+ tree t = gfc_trans_oacc_variable (namelist->sym);
+ if (t != error_mark_node)
+ {
+ tree node = build_oacc_clause (where.lb->location,
+ OACC_CLAUSE_REDUCTION);
+ OACC_CLAUSE_DECL (node) = t;
+ OACC_CLAUSE_REDUCTION_CODE (node) = reduction_code;
+ if (namelist->sym->attr.dimension)
+ gfc_trans_omp_array_reduction (node, namelist->sym, where, true);
+ list = gfc_trans_oacc_add_clause (node, list);
+ }
+ }
+ return list;
+}
+
+static tree
gfc_trans_omp_reduction_list (gfc_namelist *namelist, tree list,
enum tree_code reduction_code, locus where)
{
@@ -759,7 +838,7 @@ gfc_trans_omp_reduction_list (gfc_namelist *namelist, tree list,
OMP_CLAUSE_DECL (node) = t;
OMP_CLAUSE_REDUCTION_CODE (node) = reduction_code;
if (namelist->sym->attr.dimension)
- gfc_trans_omp_array_reduction (node, namelist->sym, where);
+ gfc_trans_omp_array_reduction (node, namelist->sym, where, false);
list = gfc_trans_add_clause (node, list);
}
}
@@ -767,6 +846,253 @@ gfc_trans_omp_reduction_list (gfc_namelist *namelist, tree list,
}
static tree
+gfc_trans_oacc_clauses (stmtblock_t *block, gfc_oacc_clauses *clauses,
+ locus where)
+{
+ tree oacc_clauses = NULL_TREE, c;
+ int list;
+ enum omp_clause_code clause_code;
+
+ if (clauses == NULL)
+ return NULL_TREE;
+
+ for (list = 0; list < OACC_LIST_NUM; list++)
+ {
+ gfc_namelist *n = clauses->lists[list];
+
+ if (n == NULL)
+ continue;
+ if (list >= OACC_LIST_REDUCTION_FIRST
+ && list <= OACC_LIST_REDUCTION_LAST)
+ {
+ enum tree_code reduction_code;
+ switch (list)
+ {
+ case OMP_LIST_PLUS:
+ reduction_code = PLUS_EXPR;
+ break;
+ case OMP_LIST_MULT:
+ reduction_code = MULT_EXPR;
+ break;
+ case OMP_LIST_SUB:
+ reduction_code = MINUS_EXPR;
+ break;
+ case OMP_LIST_AND:
+ reduction_code = TRUTH_ANDIF_EXPR;
+ break;
+ case OMP_LIST_OR:
+ reduction_code = TRUTH_ORIF_EXPR;
+ break;
+ case OMP_LIST_EQV:
+ reduction_code = EQ_EXPR;
+ break;
+ case OMP_LIST_NEQV:
+ reduction_code = NE_EXPR;
+ break;
+ case OMP_LIST_MAX:
+ reduction_code = MAX_EXPR;
+ break;
+ case OMP_LIST_MIN:
+ reduction_code = MIN_EXPR;
+ break;
+ case OMP_LIST_IAND:
+ reduction_code = BIT_AND_EXPR;
+ break;
+ case OMP_LIST_IOR:
+ reduction_code = BIT_IOR_EXPR;
+ break;
+ case OMP_LIST_IEOR:
+ reduction_code = BIT_XOR_EXPR;
+ break;
+ default:
+ gcc_unreachable ();
+ }
+ oacc_clauses
+ = gfc_trans_oacc_reduction_list (n, oacc_clauses, reduction_code,
+ where);
+ continue;
+ }
+ switch (list)
+ {
+ case OACC_LIST_COPY:
+ clause_code = OACC_CLAUSE_COPY;
+ goto add_clause;
+ case OACC_LIST_COPYIN:
+ clause_code = OACC_CLAUSE_COPYIN;
+ goto add_clause;
+ case OACC_LIST_COPYOUT:
+ clause_code = OACC_CLAUSE_COPYOUT;
+ goto add_clause;
+ case OACC_LIST_CREATE:
+ clause_code = OACC_CLAUSE_CREATE;
+ goto add_clause;
+ case OACC_LIST_PRESENT:
+ clause_code = OACC_CLAUSE_PRESENT;
+ goto add_clause;
+ case OACC_LIST_PRESENT_OR_COPY:
+ clause_code = OACC_CLAUSE_PRESENT_OR_COPY;
+ goto add_clause;
+ case OACC_LIST_PRESENT_OR_COPYIN:
+ clause_code = OACC_CLAUSE_PRESENT_OR_COPYIN;
+ goto add_clause;
+ case OACC_LIST_PRESENT_OR_COPYOUT:
+ clause_code = OACC_CLAUSE_PRESENT_OR_COPYOUT;
+ goto add_clause;
+ case OACC_LIST_PRESENT_OR_CREATE:
+ clause_code = OACC_CLAUSE_PRESENT_OR_CREATE;
+ goto add_clause;
+ case OACC_LIST_USE_DEVICE:
+ clause_code = OACC_CLAUSE_USE_DEVICE;
+ goto add_clause;
+ case OACC_LIST_DEVICEPTR:
+ clause_code = OACC_CLAUSE_DEVICEPTR;
+ goto add_clause;
+ case OACC_LIST_PRIVATE:
+ clause_code = OACC_CLAUSE_PRIVATE;
+ goto add_clause;
+ case OACC_LIST_FIRSTPRIVATE:
+ clause_code = OACC_CLAUSE_FIRSTPRIVATE;
+ goto add_clause;
+ case OACC_LIST_DEVICE_RESIDENT:
+ clause_code = OACC_CLAUSE_DEVICE_RESIDENT;
+ goto add_clause;
+ case OACC_LIST_HOST:
+ clause_code = OACC_CLAUSE_HOST;
+ goto add_clause;
+ case OACC_LIST_DEVICE:
+ clause_code = OACC_CLAUSE_DEVICE;
+ goto add_clause;
+ case OACC_LIST_CACHE:
+ clause_code = OACC_NO_CLAUSE_CACHE;
+ /* FALLTHROUGH */
+ add_clause:
+ oacc_clauses
+ = gfc_trans_oacc_variable_list (clause_code, n, oacc_clauses);
+ break;
+ default:
+ break;
+ }
+ }
+
+ if (clauses->if_expr)
+ {
+ tree if_var = gfc_convert_oacc_expr_to_tree (block, clauses->if_expr);
+ c = build_oacc_clause (where.lb->location, OACC_CLAUSE_IF);
+ OACC_CLAUSE_IF_EXPR (c) = if_var;
+ oacc_clauses = gfc_trans_oacc_add_clause (c, oacc_clauses);
+ }
+ if (clauses->async)
+ {
+ c = build_oacc_clause (where.lb->location, OACC_CLAUSE_ASYNC);
+ if (clauses->async_expr)
+ OACC_CLAUSE_ASYNC_EXPR (c) =
+ gfc_convert_oacc_expr_to_tree (block, clauses->async_expr);
+ else
+ OACC_CLAUSE_ASYNC_EXPR (c) = NULL;
+ oacc_clauses = gfc_trans_oacc_add_clause (c, oacc_clauses);
+ }
+ if (clauses->seq)
+ {
+ c = build_oacc_clause (where.lb->location, OACC_CLAUSE_SEQ);
+ oacc_clauses = gfc_trans_oacc_add_clause (c, oacc_clauses);
+ }
+ if (clauses->independent)
+ {
+ c = build_oacc_clause (where.lb->location, OACC_CLAUSE_INDEPENDENT);
+ oacc_clauses = gfc_trans_oacc_add_clause (c, oacc_clauses);
+ }
+ if (clauses->num_gangs_expr)
+ {
+ tree num_gangs_var =
+ gfc_convert_oacc_expr_to_tree (block, clauses->num_gangs_expr);
+ c = build_oacc_clause (where.lb->location, OACC_CLAUSE_NUM_GANGS);
+ OACC_CLAUSE_NUM_GANGS_EXPR (c) = num_gangs_var;
+ oacc_clauses = gfc_trans_oacc_add_clause (c, oacc_clauses);
+ }
+ if (clauses->num_workers_expr)
+ {
+ tree num_workers_var =
+ gfc_convert_oacc_expr_to_tree (block, clauses->num_workers_expr);
+ c = build_oacc_clause (where.lb->location, OACC_CLAUSE_NUM_WORKERS);
+ OACC_CLAUSE_NUM_WORKERS_EXPR (c)= num_workers_var;
+ oacc_clauses = gfc_trans_oacc_add_clause (c, oacc_clauses);
+ }
+ if (clauses->vector_length_expr)
+ {
+ tree vector_length_var =
+ gfc_convert_oacc_expr_to_tree (block, clauses->vector_length_expr);
+ c = build_oacc_clause (where.lb->location, OACC_CLAUSE_VECTOR_LENGTH);
+ OACC_CLAUSE_VECTOR_LENGTH_EXPR (c)= vector_length_var;
+ oacc_clauses = gfc_trans_oacc_add_clause (c, oacc_clauses);
+ }
+ if (clauses->vector)
+ {
+ if (clauses->vector_expr)
+ {
+ tree vector_var =
+ gfc_convert_oacc_expr_to_tree (block, clauses->vector_expr);
+ c = build_oacc_clause (where.lb->location, OACC_CLAUSE_VECTOR);
+ OACC_CLAUSE_VECTOR_EXPR (c)= vector_var;
+ oacc_clauses = gfc_trans_oacc_add_clause (c, oacc_clauses);
+ }
+ else
+ {
+ c = build_oacc_clause (where.lb->location, OACC_CLAUSE_VECTOR);
+ oacc_clauses = gfc_trans_oacc_add_clause (c, oacc_clauses);
+ }
+ }
+ if (clauses->worker)
+ {
+ if (clauses->worker_expr)
+ {
+ tree worker_var =
+ gfc_convert_oacc_expr_to_tree (block, clauses->worker_expr);
+ c = build_oacc_clause (where.lb->location, OACC_CLAUSE_WORKER);
+ OACC_CLAUSE_WORKER_EXPR (c)= worker_var;
+ oacc_clauses = gfc_trans_oacc_add_clause (c, oacc_clauses);
+ }
+ else
+ {
+ c = build_oacc_clause (where.lb->location, OACC_CLAUSE_WORKER);
+ oacc_clauses = gfc_trans_oacc_add_clause (c, oacc_clauses);
+ }
+ }
+ if (clauses->gang)
+ {
+ if (clauses->gang_expr)
+ {
+ tree gang_var =
+ gfc_convert_oacc_expr_to_tree (block, clauses->gang_expr);
+ c = build_oacc_clause (where.lb->location, OACC_CLAUSE_GANG);
+ OACC_CLAUSE_GANG_EXPR (c)= gang_var;
+ oacc_clauses = gfc_trans_oacc_add_clause (c, oacc_clauses);
+ }
+ else
+ {
+ c = build_oacc_clause (where.lb->location, OACC_CLAUSE_GANG);
+ oacc_clauses = gfc_trans_oacc_add_clause (c, oacc_clauses);
+ }
+ }
+ if (clauses->non_clause_wait_expr)
+ {
+ tree wait_var =
+ gfc_convert_oacc_expr_to_tree (block, clauses->non_clause_wait_expr);
+ c = build_oacc_clause (where.lb->location, OACC_NO_CLAUSE_WAIT);
+ OACC_WAIT_EXPR (c)= wait_var;
+ oacc_clauses = gfc_trans_oacc_add_clause (c, oacc_clauses);
+ }
+ if (clauses->collapse)
+ {
+ c = build_oacc_clause (where.lb->location, OACC_CLAUSE_COLLAPSE);
+ OACC_CLAUSE_COLLAPSE_EXPR (c)
+ = build_int_cst (integer_type_node, clauses->collapse);
+ oacc_clauses = gfc_trans_oacc_add_clause (c, oacc_clauses);
+ }
+
+ return oacc_clauses;
+}
+
+static tree
gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
locus where)
{
@@ -778,6 +1104,9 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
if (clauses == NULL)
return NULL_TREE;
+ if (clauses->is_acc)
+ return gfc_trans_oacc_clauses (block, clauses, where);
+
for (list = 0; list < OMP_LIST_NUM; list++)
{
gfc_namelist *n = clauses->lists[list];
@@ -1027,6 +1356,87 @@ gfc_trans_omp_code (gfc_code *code, bool force_empty)
return stmt;
}
+static inline tree
+gfc_trans_oacc_code (gfc_code *code, bool force_empty)
+{
+ return gfc_trans_omp_code (code, force_empty);
+}
+
+
+/* Trans OpenACC directives. */
+/* parallel, kernels, data and host_data. */
+static tree
+gfc_trans_oacc_construct (gfc_code *code)
+{
+ stmtblock_t block;
+ tree stmt, oacc_clauses;
+ enum tree_code construct_code;
+
+ switch (code->op)
+ {
+ case EXEC_OACC_PARALLEL:
+ construct_code = OACC_PARALLEL;
+ break;
+ case EXEC_OACC_KERNELS:
+ construct_code = OACC_KERNELS;
+ break;
+ case EXEC_OACC_DATA:
+ construct_code = OACC_DATA;
+ break;
+ case EXEC_OACC_HOST_DATA:
+ construct_code = OACC_HOST_DATA;
+ break;
+ default:
+ gcc_unreachable ();
+ }
+
+ gfc_start_block (&block);
+ oacc_clauses = gfc_trans_oacc_clauses (&block, code->ext.omp_clauses,
+ code->loc);
+ stmt = gfc_trans_oacc_code (code->block->next, true);
+ stmt = build2_loc (input_location, construct_code, void_type_node, stmt,
+ oacc_clauses);
+ gfc_add_expr_to_block (&block, stmt);
+ return gfc_finish_block (&block);
+}
+
+/* update, enter_data, exit_data, wait, cache. */
+static tree
+gfc_trans_oacc_executable_directive (gfc_code *code)
+{
+ stmtblock_t block;
+ tree stmt, oacc_clauses;
+ enum tree_code construct_code;
+
+ switch (code->op)
+ {
+ case EXEC_OACC_UPDATE:
+ construct_code = OACC_UPDATE;
+ break;
+ case EXEC_OACC_ENTER_DATA:
+ construct_code = OACC_ENTER_DATA;
+ break;
+ case EXEC_OACC_EXIT_DATA:
+ construct_code = OACC_EXIT_DATA;
+ break;
+ case EXEC_OACC_WAIT:
+ construct_code = OACC_WAIT;
+ break;
+ case EXEC_OACC_CACHE:
+ construct_code = OACC_CACHE;
+ break;
+ default:
+ gcc_unreachable ();
+ }
+
+ gfc_start_block (&block);
+ oacc_clauses = gfc_trans_oacc_clauses (&block, code->ext.omp_clauses,
+ code->loc);
+ stmt = build1_loc (input_location, construct_code, void_type_node,
+ oacc_clauses);
+ gfc_add_expr_to_block (&block, stmt);
+ return gfc_finish_block (&block);
+}
static tree gfc_trans_omp_sections (gfc_code *, gfc_omp_clauses *);
static tree gfc_trans_omp_workshare (gfc_code *, gfc_omp_clauses *);
@@ -1302,6 +1712,68 @@ typedef struct dovar_init_d {
tree init;
} dovar_init;
+static tree
+gfc_trans_oacc_loop (gfc_code *, gfc_oacc_clauses *)
+{
+ gfc_error ("Unimplemented");
+ return NULL_TREE;
+}
+
+/* parallel loop and kernels loop. */
+static tree
+gfc_trans_oacc_combined_directive (gfc_code *code)
+{
+ stmtblock_t block;
+ gfc_oacc_clauses construct_clauses, loop_clauses;
+ tree stmt, oacc_clauses = NULL_TREE;
+ enum tree_code construct_code;
+
+ switch (code->op)
+ {
+ case EXEC_OACC_PARALLEL_LOOP:
+ construct_code = OACC_PARALLEL;
+ break;
+ case EXEC_OACC_KERNELS_LOOP:
+ construct_code = OACC_KERNELS;
+ break;
+ default:
+ gcc_unreachable ();
+ }
+
+ gfc_start_block (&block);
+
+ memset (&loop_clauses, 0, sizeof (loop_clauses));
+ if (code->ext.omp_clauses != NULL)
+ {
+ memcpy (&construct_clauses, code->ext.omp_clauses,
+ sizeof (construct_clauses));
+ loop_clauses.collapse = construct_clauses.collapse;
+ loop_clauses.gang = construct_clauses.gang;
+ loop_clauses.vector = construct_clauses.vector;
+ loop_clauses.worker = construct_clauses.worker;
+ loop_clauses.seq = construct_clauses.seq;
+ loop_clauses.independent = construct_clauses.independent;
+ construct_clauses.collapse = 0;
+ construct_clauses.gang = false;
+ construct_clauses.vector = false;
+ construct_clauses.worker = false;
+ construct_clauses.seq = false;
+ construct_clauses.independent = false;
+ oacc_clauses = gfc_trans_oacc_clauses (&block, &construct_clauses,
+ code->loc);
+ }
+ if (loop_clauses.seq)
+ pushlevel ();
+ stmt = gfc_trans_oacc_loop (code, &loop_clauses);
+ if (TREE_CODE (stmt) != BIND_EXPR)
+ stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0));
+ else
+ poplevel (0, 0);
+ stmt = build2_loc (input_location, construct_code, void_type_node, stmt,
+ oacc_clauses);
+ gfc_add_expr_to_block (&block, stmt);
+ return gfc_finish_block (&block);
+}
static tree
gfc_trans_omp_do (gfc_code *code, stmtblock_t *pblock,
@@ -1915,6 +2387,42 @@ gfc_trans_omp_workshare (gfc_code *code, gfc_omp_clauses *clauses)
}
tree
+gfc_trans_oacc_declare (stmtblock_t *block, gfc_namespace *ns)
+{
+ tree oacc_clauses;
+ oacc_clauses = gfc_trans_oacc_clauses (block, ns->declare_clauses,
+ ns->code->loc);
+ return build1_loc (input_location, OACC_DECLARE, void_type_node,
+ oacc_clauses);
+}
+
+tree
+gfc_trans_oacc_directive (gfc_code *code)
+{
+ switch (code->op)
+ {
+ case EXEC_OACC_PARALLEL_LOOP:
+ case EXEC_OACC_KERNELS_LOOP:
+ return gfc_trans_oacc_combined_directive (code);
+ case EXEC_OACC_PARALLEL:
+ case EXEC_OACC_KERNELS:
+ case EXEC_OACC_DATA:
+ case EXEC_OACC_HOST_DATA:
+ return gfc_trans_oacc_construct (code);
+ case EXEC_OACC_LOOP:
+ return gfc_trans_oacc_loop (code, code->ext.omp_clauses);
+ case EXEC_OACC_UPDATE:
+ case EXEC_OACC_WAIT:
+ case EXEC_OACC_CACHE:
+ case EXEC_OACC_ENTER_DATA:
+ case EXEC_OACC_EXIT_DATA:
+ return gfc_trans_oacc_executable_directive (code);
+ default:
+ gcc_unreachable ();
+ }
+}
+
+tree
gfc_trans_omp_directive (gfc_code *code)
{
switch (code->op)
diff --git a/gcc/fortran/trans-stmt.h b/gcc/fortran/trans-stmt.h
index 415f76d..1d15030 100644
--- a/gcc/fortran/trans-stmt.h
+++ b/gcc/fortran/trans-stmt.h
@@ -64,6 +64,10 @@ tree gfc_trans_deallocate_array (tree);
/* trans-openmp.c */
tree gfc_trans_omp_directive (gfc_code *);
+/* trans-openacc.c */
+tree gfc_trans_oacc_directive (gfc_code *);
+tree gfc_trans_oacc_declare (stmtblock_t *block, gfc_namespace *);
+
/* trans-io.c */
tree gfc_trans_open (gfc_code *);
tree gfc_trans_close (gfc_code *);
diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c
index 204cbff..cad03c2 100644
--- a/gcc/fortran/trans.c
+++ b/gcc/fortran/trans.c
@@ -1851,6 +1851,21 @@ trans_code (gfc_code * code, tree cond)
res = gfc_trans_omp_directive (code);
break;
+ case EXEC_OACC_CACHE:
+ case EXEC_OACC_WAIT:
+ case EXEC_OACC_UPDATE:
+ case EXEC_OACC_LOOP:
+ case EXEC_OACC_HOST_DATA:
+ case EXEC_OACC_DATA:
+ case EXEC_OACC_KERNELS:
+ case EXEC_OACC_KERNELS_LOOP:
+ case EXEC_OACC_PARALLEL:
+ case EXEC_OACC_PARALLEL_LOOP:
+ case EXEC_OACC_ENTER_DATA:
+ case EXEC_OACC_EXIT_DATA:
+ res = gfc_trans_oacc_directive (code);
+ break;
+
default:
internal_error ("gfc_trans_code(): Bad statement code");
}
--
1.8.3.2
^ permalink raw reply [flat|nested] 89+ messages in thread
* [PATCH 4/6] [GOMP4] OpenACC 1.0+ support in fortran front-end
2014-01-23 18:04 ` [PATCH 3/6] " Ilmir Usmanov
@ 2014-01-23 18:05 ` Ilmir Usmanov
2014-01-23 18:05 ` [PATCH 5/6] " Ilmir Usmanov
2014-01-24 19:33 ` [PATCH 4/6] " Thomas Schwinge
0 siblings, 2 replies; 89+ messages in thread
From: Ilmir Usmanov @ 2014-01-23 18:05 UTC (permalink / raw)
To: gcc-patches, Thomas Schwinge, jakub
Cc: Evgeny Gavrin, GarbuzovViacheslav, Dmitri Botcharnikov
[-- Attachment #1: Type: text/plain, Size: 1 bytes --]
[-- Attachment #2: 0004-OpenACC-GENERIC-nodes.patch --]
[-- Type: text/x-diff, Size: 34220 bytes --]
From 37806068fffcab95a21b51829c900d49be14961d Mon Sep 17 00:00:00 2001
From: Ilmir Usmanov <i.usmanov@samsung.com>
Date: Thu, 23 Jan 2014 21:08:05 +0400
Subject: [PATCH 4/6] OpenACC GENERIC nodes
---
gcc/gimplify.c | 73 ++++++++++++
gcc/omp-low.c | 84 ++++++++++++--
gcc/tree-core.h | 106 +++++++++++++++++-
gcc/tree-pretty-print.c | 286 +++++++++++++++++++++++++++++++++++++++++++++++-
gcc/tree-pretty-print.h | 7 ++
gcc/tree.c | 96 ++++++++++++++--
gcc/tree.def | 50 +++++++++
gcc/tree.h | 95 +++++++++++++++-
8 files changed, 770 insertions(+), 27 deletions(-)
diff --git a/gcc/gimplify.c b/gcc/gimplify.c
index e45bed2..8af4368 100644
--- a/gcc/gimplify.c
+++ b/gcc/gimplify.c
@@ -4274,6 +4274,15 @@ is_gimple_stmt (tree t)
case ASM_EXPR:
case STATEMENT_LIST:
case OACC_PARALLEL:
+ case OACC_KERNELS:
+ case OACC_DATA:
+ case OACC_CACHE:
+ case OACC_WAIT:
+ case OACC_HOST_DATA:
+ case OACC_DECLARE:
+ case OACC_UPDATE:
+ case OACC_ENTER_DATA:
+ case OACC_EXIT_DATA:
case OMP_PARALLEL:
case OMP_FOR:
case OMP_SIMD:
@@ -6025,6 +6034,32 @@ gimplify_scan_omp_clauses (tree *list_p, gimple_seq *pre_p,
remove = true;
break;
+ case OACC_CLAUSE_COPY:
+ case OACC_CLAUSE_COPYOUT:
+ case OACC_CLAUSE_CREATE:
+ case OACC_CLAUSE_PRESENT:
+ case OACC_CLAUSE_PRESENT_OR_COPY:
+ case OACC_CLAUSE_PRESENT_OR_COPYIN:
+ case OACC_CLAUSE_PRESENT_OR_COPYOUT:
+ case OACC_CLAUSE_PRESENT_OR_CREATE:
+ case OACC_CLAUSE_HOST:
+ case OACC_CLAUSE_DEVICE:
+ case OACC_CLAUSE_DEVICEPTR:
+ case OACC_CLAUSE_DEVICE_RESIDENT:
+ case OACC_CLAUSE_USE_DEVICE:
+ case OACC_CLAUSE_DELETE:
+ case OACC_CLAUSE_ASYNC:
+ case OACC_CLAUSE_GANG:
+ case OACC_CLAUSE_WAIT:
+ case OACC_NO_CLAUSE_WAIT:
+ case OACC_NO_CLAUSE_CACHE:
+ case OACC_CLAUSE_SEQ:
+ case OACC_CLAUSE_INDEPENDENT:
+ case OACC_CLAUSE_WORKER:
+ case OACC_CLAUSE_VECTOR:
+ case OACC_CLAUSE_NUM_GANGS:
+ case OACC_CLAUSE_NUM_WORKERS:
+ case OACC_CLAUSE_VECTOR_LENGTH:
case OMP_CLAUSE_NOWAIT:
case OMP_CLAUSE_ORDERED:
case OMP_CLAUSE_UNTIED:
@@ -6339,6 +6374,32 @@ gimplify_adjust_omp_clauses (tree *list_p)
}
break;
+ case OACC_CLAUSE_COPY:
+ case OACC_CLAUSE_COPYOUT:
+ case OACC_CLAUSE_CREATE:
+ case OACC_CLAUSE_PRESENT:
+ case OACC_CLAUSE_PRESENT_OR_COPY:
+ case OACC_CLAUSE_PRESENT_OR_COPYIN:
+ case OACC_CLAUSE_PRESENT_OR_COPYOUT:
+ case OACC_CLAUSE_PRESENT_OR_CREATE:
+ case OACC_CLAUSE_HOST:
+ case OACC_CLAUSE_DEVICE:
+ case OACC_CLAUSE_DEVICEPTR:
+ case OACC_CLAUSE_DEVICE_RESIDENT:
+ case OACC_CLAUSE_USE_DEVICE:
+ case OACC_CLAUSE_DELETE:
+ case OACC_CLAUSE_ASYNC:
+ case OACC_CLAUSE_GANG:
+ case OACC_CLAUSE_WAIT:
+ case OACC_NO_CLAUSE_WAIT:
+ case OACC_NO_CLAUSE_CACHE:
+ case OACC_CLAUSE_SEQ:
+ case OACC_CLAUSE_INDEPENDENT:
+ case OACC_CLAUSE_WORKER:
+ case OACC_CLAUSE_VECTOR:
+ case OACC_CLAUSE_NUM_GANGS:
+ case OACC_CLAUSE_NUM_WORKERS:
+ case OACC_CLAUSE_VECTOR_LENGTH:
case OMP_CLAUSE_REDUCTION:
case OMP_CLAUSE_COPYIN:
case OMP_CLAUSE_COPYPRIVATE:
@@ -7846,6 +7907,18 @@ gimplify_expr (tree *expr_p, gimple_seq *pre_p, gimple_seq *post_p,
ret = GS_ALL_DONE;
break;
+ case OACC_KERNELS:
+ case OACC_DATA:
+ case OACC_CACHE:
+ case OACC_WAIT:
+ case OACC_HOST_DATA:
+ case OACC_DECLARE:
+ case OACC_UPDATE:
+ case OACC_ENTER_DATA:
+ case OACC_EXIT_DATA:
+ ret = GS_ALL_DONE;
+ break;
+
case OMP_PARALLEL:
gimplify_omp_parallel (expr_p, pre_p);
ret = GS_ALL_DONE;
diff --git a/gcc/omp-low.c b/gcc/omp-low.c
index eb755c3..6da5977 100644
--- a/gcc/omp-low.c
+++ b/gcc/omp-low.c
@@ -1543,10 +1543,12 @@ scan_sharing_clauses (tree clauses, omp_context *ctx)
break;
/* FALLTHRU */
- case OMP_CLAUSE_FIRSTPRIVATE:
- case OMP_CLAUSE_REDUCTION:
case OMP_CLAUSE_LINEAR:
gcc_assert (gimple_code (ctx->stmt) != GIMPLE_OACC_PARALLEL);
+ /* FALLTHRU. */
+
+ case OMP_CLAUSE_FIRSTPRIVATE: /* == OACC_CLAUSE_FIRSTPRIVATE. */
+ case OMP_CLAUSE_REDUCTION: /* == OACC_CLAUSE_REDUCTION. */
decl = OMP_CLAUSE_DECL (c);
do_private:
if (is_variable_sized (decl))
@@ -1583,8 +1585,10 @@ scan_sharing_clauses (tree clauses, omp_context *ctx)
break;
case OMP_CLAUSE_COPYPRIVATE:
- case OMP_CLAUSE_COPYIN:
gcc_assert (gimple_code (ctx->stmt) != GIMPLE_OACC_PARALLEL);
+ /* FALLTHRU. */
+
+ case OMP_CLAUSE_COPYIN: /* == OACC_CLAUSE_COPYIN. */
decl = OMP_CLAUSE_DECL (c);
by_ref = use_pointer_for_field (decl, NULL);
install_var_field (decl, by_ref, 3, ctx);
@@ -1596,7 +1600,6 @@ scan_sharing_clauses (tree clauses, omp_context *ctx)
break;
case OMP_CLAUSE_FINAL:
- case OMP_CLAUSE_IF:
case OMP_CLAUSE_NUM_THREADS:
case OMP_CLAUSE_NUM_TEAMS:
case OMP_CLAUSE_THREAD_LIMIT:
@@ -1605,6 +1608,9 @@ scan_sharing_clauses (tree clauses, omp_context *ctx)
case OMP_CLAUSE_DIST_SCHEDULE:
case OMP_CLAUSE_DEPEND:
gcc_assert (gimple_code (ctx->stmt) != GIMPLE_OACC_PARALLEL);
+ /* FALLTHRU. */
+
+ case OMP_CLAUSE_IF: /* == OACC_CLAUSE_IF. */
if (ctx->outer)
scan_omp_op (&OMP_CLAUSE_OPERAND (c, 0), ctx->outer);
break;
@@ -1713,6 +1719,35 @@ scan_sharing_clauses (tree clauses, omp_context *ctx)
install_var_local (decl, ctx);
break;
+ case OACC_CLAUSE_COPY:
+ case OACC_CLAUSE_COPYOUT:
+ case OACC_CLAUSE_CREATE:
+ case OACC_CLAUSE_PRESENT:
+ case OACC_CLAUSE_PRESENT_OR_COPY:
+ case OACC_CLAUSE_PRESENT_OR_COPYIN:
+ case OACC_CLAUSE_PRESENT_OR_COPYOUT:
+ case OACC_CLAUSE_PRESENT_OR_CREATE:
+ case OACC_CLAUSE_HOST:
+ case OACC_CLAUSE_DEVICE:
+ case OACC_CLAUSE_DEVICEPTR:
+ case OACC_CLAUSE_DEVICE_RESIDENT:
+ case OACC_CLAUSE_USE_DEVICE:
+ case OACC_CLAUSE_DELETE:
+ case OACC_CLAUSE_ASYNC:
+ case OACC_CLAUSE_GANG:
+ case OACC_CLAUSE_WAIT:
+ case OACC_NO_CLAUSE_WAIT:
+ case OACC_NO_CLAUSE_CACHE:
+ case OACC_CLAUSE_SEQ:
+ case OACC_CLAUSE_INDEPENDENT:
+ case OACC_CLAUSE_WORKER:
+ case OACC_CLAUSE_VECTOR:
+ case OACC_CLAUSE_NUM_GANGS:
+ case OACC_CLAUSE_NUM_WORKERS:
+ case OACC_CLAUSE_VECTOR_LENGTH:
+ /* Not implemented yet. */
+ break;
+
default:
gcc_unreachable ();
}
@@ -1733,10 +1768,12 @@ scan_sharing_clauses (tree clauses, omp_context *ctx)
/* FALLTHRU */
case OMP_CLAUSE_PRIVATE:
- case OMP_CLAUSE_FIRSTPRIVATE:
- case OMP_CLAUSE_REDUCTION:
case OMP_CLAUSE_LINEAR:
gcc_assert (gimple_code (ctx->stmt) != GIMPLE_OACC_PARALLEL);
+ /* FALLTHRU. */
+
+ case OMP_CLAUSE_FIRSTPRIVATE:
+ case OMP_CLAUSE_REDUCTION:
decl = OMP_CLAUSE_DECL (c);
if (is_variable_sized (decl))
install_var_local (decl, ctx);
@@ -1797,9 +1834,7 @@ scan_sharing_clauses (tree clauses, omp_context *ctx)
break;
case OMP_CLAUSE_COPYPRIVATE:
- case OMP_CLAUSE_COPYIN:
case OMP_CLAUSE_DEFAULT:
- case OMP_CLAUSE_IF:
case OMP_CLAUSE_NUM_THREADS:
case OMP_CLAUSE_NUM_TEAMS:
case OMP_CLAUSE_THREAD_LIMIT:
@@ -1808,7 +1843,6 @@ scan_sharing_clauses (tree clauses, omp_context *ctx)
case OMP_CLAUSE_DIST_SCHEDULE:
case OMP_CLAUSE_NOWAIT:
case OMP_CLAUSE_ORDERED:
- case OMP_CLAUSE_COLLAPSE:
case OMP_CLAUSE_UNTIED:
case OMP_CLAUSE_FINAL:
case OMP_CLAUSE_MERGEABLE:
@@ -1822,6 +1856,38 @@ scan_sharing_clauses (tree clauses, omp_context *ctx)
gcc_assert (gimple_code (ctx->stmt) != GIMPLE_OACC_PARALLEL);
break;
+ case OACC_CLAUSE_COPY:
+ case OACC_CLAUSE_COPYOUT:
+ case OACC_CLAUSE_CREATE:
+ case OACC_CLAUSE_PRESENT:
+ case OACC_CLAUSE_PRESENT_OR_COPY:
+ case OACC_CLAUSE_PRESENT_OR_COPYIN:
+ case OACC_CLAUSE_PRESENT_OR_COPYOUT:
+ case OACC_CLAUSE_PRESENT_OR_CREATE:
+ case OACC_CLAUSE_HOST:
+ case OACC_CLAUSE_DEVICE:
+ case OACC_CLAUSE_DEVICEPTR:
+ case OACC_CLAUSE_DEVICE_RESIDENT:
+ case OACC_CLAUSE_USE_DEVICE:
+ case OACC_CLAUSE_DELETE:
+ case OACC_CLAUSE_ASYNC:
+ case OACC_CLAUSE_GANG:
+ case OACC_CLAUSE_WAIT:
+ case OACC_NO_CLAUSE_WAIT:
+ case OACC_NO_CLAUSE_CACHE:
+ case OACC_CLAUSE_SEQ:
+ case OACC_CLAUSE_INDEPENDENT:
+ case OACC_CLAUSE_WORKER:
+ case OACC_CLAUSE_VECTOR:
+ case OACC_CLAUSE_NUM_GANGS:
+ case OACC_CLAUSE_NUM_WORKERS:
+ case OACC_CLAUSE_VECTOR_LENGTH:
+ case OMP_CLAUSE_COPYIN:
+ case OMP_CLAUSE_IF:
+ case OMP_CLAUSE_COLLAPSE:
+ /* Not implemented yet. */
+ break;
+
default:
gcc_unreachable ();
}
diff --git a/gcc/tree-core.h b/gcc/tree-core.h
index e2750e0..68e044f 100644
--- a/gcc/tree-core.h
+++ b/gcc/tree-core.h
@@ -216,12 +216,18 @@ enum omp_clause_code {
/* OpenMP clause: private (variable_list). */
OMP_CLAUSE_PRIVATE,
+ /* OpenACC clause: private (variable_list). */
+ OACC_CLAUSE_PRIVATE = OMP_CLAUSE_PRIVATE,
+
/* OpenMP clause: shared (variable_list). */
OMP_CLAUSE_SHARED,
/* OpenMP clause: firstprivate (variable_list). */
OMP_CLAUSE_FIRSTPRIVATE,
+ /* OpenACC clause: firstprivate (variable_list). */
+ OACC_CLAUSE_FIRSTPRIVATE = OMP_CLAUSE_FIRSTPRIVATE,
+
/* OpenMP clause: lastprivate (variable_list). */
OMP_CLAUSE_LASTPRIVATE,
@@ -234,9 +240,15 @@ enum omp_clause_code {
placeholder used in OMP_CLAUSE_REDUCTION_{INIT,MERGE}. */
OMP_CLAUSE_REDUCTION,
+ /* OpenACC clause: reduction (operator:variable_list). */
+ OACC_CLAUSE_REDUCTION = OMP_CLAUSE_REDUCTION,
+
/* OpenMP clause: copyin (variable_list). */
OMP_CLAUSE_COPYIN,
+ /* OpenACC clause: copyin (variable_list). */
+ OACC_CLAUSE_COPYIN = OMP_CLAUSE_COPYIN,
+
/* OpenMP clause: copyprivate (variable_list). */
OMP_CLAUSE_COPYPRIVATE,
@@ -261,12 +273,79 @@ enum omp_clause_code {
/* OpenMP clause: map ({alloc:,to:,from:,tofrom:,}variable-list). */
OMP_CLAUSE_MAP,
+ /* OpenACC clause: copy (variable_list). */
+ OACC_CLAUSE_COPY,
+
+ /* OpenACC clause: copyout (variable_list). */
+ OACC_CLAUSE_COPYOUT,
+
+ /* OpenACC clause: create (variable_list). */
+ OACC_CLAUSE_CREATE,
+
+ /* OpenACC clause: present (variable_list). */
+ OACC_CLAUSE_PRESENT,
+
+ /* OpenACC clause: present_or_copy (variable_list). */
+ OACC_CLAUSE_PRESENT_OR_COPY,
+
+ /* OpenACC clause: present_or_copyin (variable_list). */
+ OACC_CLAUSE_PRESENT_OR_COPYIN,
+
+ /* OpenACC clause: present_or_copyout (variable_list). */
+ OACC_CLAUSE_PRESENT_OR_COPYOUT,
+
+ /* OpenACC clause: present_or_create (variable_list). */
+ OACC_CLAUSE_PRESENT_OR_CREATE,
+
+ /* OpenACC clause: host (variable_list). */
+ OACC_CLAUSE_HOST,
+
+ /* OpenACC clause: device (variable_list). */
+ OACC_CLAUSE_DEVICE,
+
+ /* OpenACC clause: deviceptr (variable_list). */
+ OACC_CLAUSE_DEVICEPTR,
+
+ /* OpenACC clause: device_resident (variable_list). */
+ OACC_CLAUSE_DEVICE_RESIDENT,
+
+ /* OpenACC clause: use_device (variable_list). */
+ OACC_CLAUSE_USE_DEVICE,
+
+ /* OpenACC clause: delete (variable_list). */
+ OACC_CLAUSE_DELETE,
+
+ /* OpenACC clause: async [(integer-expression)]. */
+ OACC_CLAUSE_ASYNC,
+
+ /* OpenACC clause: gang [(gang-argument-list)].
+ Where
+ gang-argument-list: [gang-argument-list, ] gang-argument
+ gang-argument: [num:] integer-expression
+ | static: size-expression
+ size-expression: * | integer-expression. */
+ OACC_CLAUSE_GANG,
+
+ /* OpenACC clause: wait [(integer-expression-list)]. */
+ OACC_CLAUSE_WAIT,
+
+ /* Internal structure to hold OpenACC wait directive's variable_list.
+ #pragma acc wait [(integer-expression-list)]. */
+ OACC_NO_CLAUSE_WAIT,
+
+ /* Internal structure to hold OpenACC cache directive's variable-list.
+ #pragma acc cache (variable-_ist). */
+ OACC_NO_CLAUSE_CACHE,
+
/* Internal clause: temporary for combined loops expansion. */
OMP_CLAUSE__LOOPTEMP_,
/* OpenMP clause: if (scalar-expression). */
OMP_CLAUSE_IF,
+ /* OpenACC clause: if (scalar-expression). */
+ OACC_CLAUSE_IF = OMP_CLAUSE_IF,
+
/* OpenMP clause: num_threads (integer-expression). */
OMP_CLAUSE_NUM_THREADS,
@@ -285,6 +364,9 @@ enum omp_clause_code {
/* OpenMP clause: collapse (constant-integer-expression). */
OMP_CLAUSE_COLLAPSE,
+ /* OpenACC clause: collapse (constant-integer-expression). */
+ OACC_CLAUSE_COLLAPSE = OMP_CLAUSE_COLLAPSE,
+
/* OpenMP clause: untied. */
OMP_CLAUSE_UNTIED,
@@ -334,7 +416,28 @@ enum omp_clause_code {
OMP_CLAUSE_TASKGROUP,
/* Internally used only clause, holding SIMD uid. */
- OMP_CLAUSE__SIMDUID_
+ OMP_CLAUSE__SIMDUID_,
+
+ /* OpenACC clause: seq. */
+ OACC_CLAUSE_SEQ,
+
+ /* OpenACC clause: independent. */
+ OACC_CLAUSE_INDEPENDENT,
+
+ /* OpenACC clause: worker [( [num:] integer-expression)]. */
+ OACC_CLAUSE_WORKER,
+
+ /* OpenACC clause: worker [( [length:] integer-expression)]. */
+ OACC_CLAUSE_VECTOR,
+
+ /* OpenACC clause: num_gangs (integer-expression). */
+ OACC_CLAUSE_NUM_GANGS,
+
+ /* OpenACC clause: num_workers (integer-expression). */
+ OACC_CLAUSE_NUM_WORKERS,
+
+ /* OpenACC clause: vector_length (integer-expression). */
+ OACC_CLAUSE_VECTOR_LENGTH
};
#undef DEFTREESTRUCT
@@ -660,7 +763,6 @@ enum annot_expr_kind {
annot_expr_ivdep_kind
};
-
/*---------------------------------------------------------------------------
Type definitions
---------------------------------------------------------------------------*/
diff --git a/gcc/tree-pretty-print.c b/gcc/tree-pretty-print.c
index 320c35b..9b994e4 100644
--- a/gcc/tree-pretty-print.c
+++ b/gcc/tree-pretty-print.c
@@ -54,6 +54,248 @@ static void do_niy (pretty_printer *, const_tree);
static pretty_printer buffer;
static int initialized = 0;
+unsigned char
+dump_oacc_body (int flags, tree node, int spc,
+ unsigned char is_expr, pretty_printer* buffer)
+{
+ if (!(flags & TDF_SLIM) && OACC_BODY (node))
+ {
+ newline_and_indent (buffer, spc + 2);
+ pp_character (buffer, '{');
+ newline_and_indent (buffer, spc + 4);
+ dump_generic_node (buffer, OACC_BODY (node), spc + 4, flags, false);
+ newline_and_indent (buffer, spc + 2);
+ pp_character (buffer, '}');
+ }
+ is_expr = false;
+ return is_expr;
+}
+
+void
+dump_oacc_clause_remap (const char* name,
+ tree clause,
+ int spc,
+ int flags,
+ pretty_printer* buffer)
+{
+ pp_string (buffer, name);
+ pp_character (buffer, '(');
+ dump_generic_node (buffer, OACC_CLAUSE_DECL (clause), spc, flags, false);
+
+ pp_character (buffer, ')');
+}
+
+void
+dump_oacc_clause (pretty_printer *buffer, tree clause, int spc, int flags)
+{
+ const char *name;
+ enum omp_clause_code clause_code;
+
+ if (clause == NULL)
+ return;
+
+ clause_code = OACC_CLAUSE_CODE (clause);
+
+ switch (clause_code)
+ {
+ case OACC_CLAUSE_ASYNC:
+ pp_string (buffer, "async");
+ if (OACC_CLAUSE_DECL (clause))
+ {
+ pp_character(buffer, '(');
+ dump_generic_node (buffer, OACC_CLAUSE_DECL (clause), spc, flags, false);
+ pp_character(buffer, ')');
+ }
+ break;
+
+ case OACC_CLAUSE_VECTOR:
+ pp_string (buffer, "vector(");
+ dump_generic_node (buffer, OACC_CLAUSE_DECL (clause), spc, flags, false);
+ pp_character(buffer, ')');
+ break;
+
+ case OACC_CLAUSE_GANG:
+ pp_string (buffer, "gang(");
+ dump_generic_node (buffer, OACC_CLAUSE_DECL (clause), spc, flags, false);
+ pp_character(buffer, ')');
+ break;
+
+ case OACC_CLAUSE_WORKER:
+ pp_string (buffer, "worker(");
+ dump_generic_node (buffer, OACC_CLAUSE_DECL (clause), spc, flags, false);
+ pp_character(buffer, ')');
+ break;
+
+ case OACC_CLAUSE_INDEPENDENT:
+ name = "independent";
+ pp_string (buffer, name);
+ break;
+
+ case OACC_CLAUSE_SEQ:
+ name = "seq";
+ pp_string (buffer, name);
+ break;
+
+ case OACC_CLAUSE_COPY:
+ name = "copy";
+ dump_oacc_clause_remap (name, clause, spc, flags, buffer);
+ break;
+
+ case OACC_CLAUSE_COPYIN:
+ name = "copyin";
+ dump_oacc_clause_remap (name, clause, spc, flags, buffer);
+ break;
+
+ case OACC_CLAUSE_COPYOUT:
+ name = "copyout";
+ dump_oacc_clause_remap (name, clause, spc, flags, buffer);
+ break;
+
+ case OACC_CLAUSE_CREATE:
+ name = "create";
+ dump_oacc_clause_remap (name, clause, spc, flags, buffer);
+ break;
+
+ case OACC_CLAUSE_PRESENT:
+ name = "present";
+ dump_oacc_clause_remap (name, clause, spc, flags, buffer);
+ break;
+
+ case OACC_CLAUSE_PRESENT_OR_COPY:
+ name = "present_or_copy";
+ dump_oacc_clause_remap (name, clause, spc, flags, buffer);
+ break;
+
+ case OACC_CLAUSE_PRESENT_OR_COPYIN:
+ name = "present_or_copyin";
+ dump_oacc_clause_remap (name, clause, spc, flags, buffer);
+ break;
+
+ case OACC_CLAUSE_PRESENT_OR_COPYOUT:
+ name = "present_or_copyout";
+ dump_oacc_clause_remap (name, clause, spc, flags, buffer);
+ break;
+
+ case OACC_CLAUSE_PRESENT_OR_CREATE:
+ name = "present_or_create";
+ dump_oacc_clause_remap (name, clause, spc, flags, buffer);
+ break;
+
+ case OACC_CLAUSE_FIRSTPRIVATE:
+ name = "firstprivate";
+ dump_oacc_clause_remap (name, clause, spc, flags, buffer);
+ break;
+
+ case OACC_CLAUSE_PRIVATE:
+ name = "private";
+ dump_oacc_clause_remap (name, clause, spc, flags, buffer);
+ break;
+
+ case OACC_CLAUSE_DEVICEPTR:
+ name = "deviceptr";
+ dump_oacc_clause_remap (name, clause, spc, flags, buffer);
+ break;
+
+ case OACC_CLAUSE_USE_DEVICE:
+ name = "use_device";
+ dump_oacc_clause_remap (name, clause, spc, flags, buffer);
+ break;
+
+ case OACC_CLAUSE_DEVICE_RESIDENT:
+ name = "device_resident";
+ dump_oacc_clause_remap (name, clause, spc, flags, buffer);
+ break;
+
+ case OACC_CLAUSE_HOST:
+ name = "host";
+ dump_oacc_clause_remap (name, clause, spc, flags, buffer);
+ break;
+
+ case OACC_CLAUSE_DEVICE:
+ name = "device";
+ dump_oacc_clause_remap (name, clause, spc, flags, buffer);
+ break;
+
+ case OACC_NO_CLAUSE_CACHE:
+ name = "";
+ dump_oacc_clause_remap (name, clause, spc, flags, buffer);
+ break;
+
+ case OACC_CLAUSE_REDUCTION:
+ pp_string (buffer, "reduction(");
+ pp_string (buffer, op_symbol_code (OACC_CLAUSE_REDUCTION_CODE (clause)));
+ pp_character (buffer, ':');
+ dump_generic_node (buffer, OACC_CLAUSE_DECL (clause),
+ spc, flags, false);
+ pp_character (buffer, ')');
+ break;
+
+ case OACC_CLAUSE_IF:
+ pp_string (buffer, "if(");
+ dump_generic_node (buffer, OACC_CLAUSE_IF_EXPR (clause),
+ spc, flags, false);
+ pp_character (buffer, ')');
+ break;
+
+ case OACC_CLAUSE_NUM_GANGS:
+ pp_string (buffer, "num_gangs(");
+ dump_generic_node (buffer, OACC_CLAUSE_NUM_GANGS_EXPR (clause),
+ spc, flags, false);
+ pp_character (buffer, ')');
+ break;
+
+ case OACC_CLAUSE_NUM_WORKERS:
+ pp_string (buffer, "num_workers(");
+ dump_generic_node (buffer, OACC_CLAUSE_NUM_WORKERS_EXPR (clause),
+ spc, flags, false);
+ pp_character (buffer, ')');
+ break;
+
+ case OACC_CLAUSE_VECTOR_LENGTH:
+ pp_string (buffer, "vector_length(");
+ dump_generic_node (buffer, OACC_CLAUSE_VECTOR_LENGTH_EXPR (clause),
+ spc, flags, false);
+ pp_character (buffer, ')');
+ break;
+
+ case OACC_CLAUSE_COLLAPSE:
+ pp_string (buffer, "collapse(");
+ dump_generic_node (buffer, OACC_CLAUSE_COLLAPSE_EXPR (clause),
+ spc, flags, false);
+ pp_character (buffer, ')');
+ break;
+
+ case OACC_NO_CLAUSE_WAIT:
+ pp_string (buffer, "(");
+ dump_generic_node (buffer, OACC_WAIT_EXPR (clause),
+ spc, flags, false);
+ pp_character (buffer, ')');
+ break;
+
+ default:
+ name = "unrecognized_oacc_clause";
+ dump_oacc_clause_remap (name, clause, spc, flags, buffer);
+ break;
+ }
+}
+
+void
+dump_oacc_clauses (pretty_printer *buffer, tree clause, int spc, int flags)
+{
+ if (clause == NULL)
+ return;
+
+ pp_space (buffer);
+ while (1)
+ {
+ dump_oacc_clause (buffer, clause, spc, flags);
+ clause = OACC_CLAUSE_CHAIN (clause);
+ if (clause == NULL)
+ return;
+ pp_space (buffer);
+ }
+}
+
/* Try to print something for an unknown tree code. */
static void
@@ -2358,10 +2600,50 @@ dump_generic_node (pretty_printer *buffer, tree node, int spc, int flags,
pp_string (buffer, " > ");
break;
+
case OACC_PARALLEL:
pp_string (buffer, "#pragma acc parallel");
- dump_omp_clauses (buffer, OACC_PARALLEL_CLAUSES (node), spc, flags);
- goto dump_omp_body;
+ dump_oacc_clauses (buffer, OACC_PARALLEL_CLAUSES (node), spc, flags);
+ is_expr = dump_oacc_body(flags, node, spc, is_expr, buffer);
+ break;
+
+ case OACC_KERNELS:
+ pp_string (buffer, "#pragma acc kernels");
+ dump_oacc_clauses (buffer, OACC_KERNELS_CLAUSES(node), spc, flags);
+ is_expr = dump_oacc_body(flags, node, spc, is_expr, buffer);
+ break;
+
+ case OACC_HOST_DATA:
+ pp_string (buffer, "#pragma acc host_data");
+ dump_oacc_clauses (buffer, OACC_HOST_DATA_CLAUSES(node), spc, flags);
+ is_expr = dump_oacc_body(flags, node, spc, is_expr, buffer);
+ break;
+
+ case OACC_DATA:
+ pp_string (buffer, "#pragma acc data");
+ dump_oacc_clauses (buffer, OACC_DATA_CLAUSES(node), spc, flags);
+ is_expr = dump_oacc_body(flags, node, spc, is_expr, buffer);
+ break;
+
+ case OACC_WAIT:
+ pp_string (buffer, "#pragma acc wait");
+ dump_oacc_clauses (buffer, OACC_WAIT_CLAUSES(node), spc, flags);
+ break;
+
+ case OACC_UPDATE:
+ pp_string (buffer, "#pragma acc update");
+ dump_oacc_clauses (buffer, OACC_UPDATE_CLAUSES(node), spc, flags);
+ break;
+
+ case OACC_DECLARE:
+ pp_string (buffer, "#pragma acc declare");
+ dump_oacc_clauses (buffer, OACC_DECLARE_CLAUSES(node), spc, flags);
+ break;
+
+ case OACC_CACHE:
+ pp_string (buffer, "#pragma acc cache");
+ dump_oacc_clauses (buffer, OACC_CACHE_CLAUSES(node), spc, flags);
+ break;
case OMP_PARALLEL:
pp_string (buffer, "#pragma omp parallel");
diff --git a/gcc/tree-pretty-print.h b/gcc/tree-pretty-print.h
index 8754b0a..1014c91 100644
--- a/gcc/tree-pretty-print.h
+++ b/gcc/tree-pretty-print.h
@@ -36,6 +36,13 @@ extern void debug_generic_expr (tree);
extern void debug_generic_stmt (tree);
extern void debug_tree_chain (tree);
extern void print_generic_decl (FILE *, tree, int);
+extern unsigned char dump_oacc_body
+ (int, tree, int, unsigned char, pretty_printer*);
+extern void dump_oacc_clause_remap
+ (const char*, tree, int, int, pretty_printer*);
+extern void dump_oacc_clause (pretty_printer *, tree, int, int);
+extern void dump_oacc_clauses (pretty_printer *, tree, int, int);
+
extern void print_generic_stmt (FILE *, tree, int);
extern void print_generic_stmt_indented (FILE *, tree, int, int);
extern void print_generic_expr (FILE *, tree, int);
diff --git a/gcc/tree.c b/gcc/tree.c
index 25aa3e2..def3dc2 100644
--- a/gcc/tree.c
+++ b/gcc/tree.c
@@ -155,7 +155,8 @@ static const char * const tree_node_kind_names[] = {
"random kinds",
"lang_decl kinds",
"lang_type kinds",
- "omp clauses",
+ "acc clauses",
+ "omp clauses"
};
/* Unique id for next decl created. */
@@ -242,12 +243,12 @@ unsigned char tree_contains_struct[MAX_TREE_CODES][64];
unsigned const char omp_clause_num_ops[] =
{
0, /* OMP_CLAUSE_ERROR */
- 1, /* OMP_CLAUSE_PRIVATE */
+ 1, /* OMP_CLAUSE_PRIVATE, OACC_CLAUSE_PRIVATE */
1, /* OMP_CLAUSE_SHARED */
- 1, /* OMP_CLAUSE_FIRSTPRIVATE */
+ 1, /* OMP_CLAUSE_FIRSTPRIVATE, OACC_CLAUSE_FIRSTPRIVATE */
2, /* OMP_CLAUSE_LASTPRIVATE */
- 4, /* OMP_CLAUSE_REDUCTION */
- 1, /* OMP_CLAUSE_COPYIN */
+ 4, /* OMP_CLAUSE_REDUCTION, OACC_CLAUSE_REDUCTION */
+ 1, /* OMP_CLAUSE_COPYIN, OACC_CLAUSE_COPYIN */
1, /* OMP_CLAUSE_COPYPRIVATE */
2, /* OMP_CLAUSE_LINEAR */
2, /* OMP_CLAUSE_ALIGNED */
@@ -256,14 +257,33 @@ unsigned const char omp_clause_num_ops[] =
2, /* OMP_CLAUSE_FROM */
2, /* OMP_CLAUSE_TO */
2, /* OMP_CLAUSE_MAP */
+ 3, /* OACC_CLAUSE_COPY */
+ 3, /* OACC_CLAUSE_COPYOUT */
+ 3, /* OACC_CLAUSE_CREATE */
+ 3, /* OACC_CLAUSE_PRESENT */
+ 3, /* OACC_CLAUSE_PRESENT_OR_COPY */
+ 3, /* OACC_CLAUSE_PRESENT_OR_COPYIN */
+ 3, /* OACC_CLAUSE_PRESENT_OR_COPYOUT */
+ 3, /* OACC_CLAUSE_PRESENT_OR_CREATE */
+ 1, /* OACC_CLAUSE_HOST */
+ 1, /* OACC_CLAUSE_DEVICE */
+ 1, /* OACC_CLAUSE_DEVICEPTR */
+ 1, /* OACC_CLAUSE_DEVICE_RESIDENT */
+ 1, /* OACC_CLAUSE_USE_DEVICE */
+ 3, /* OACC_CLAUSE_DELETE */
+ 1, /* OACC_CLAUSE_ASYNC */
+ 1, /* OACC_CLAUSE_GANG */
+ 1, /* OACC_CLAUSE_WAIT */
+ 1, /* OACC_NO_CLAUSE_WAIT */
+ 1, /* OACC_NO_CLAUSE_CACHE */
1, /* OMP_CLAUSE__LOOPTEMP_ */
- 1, /* OMP_CLAUSE_IF */
+ 1, /* OMP_CLAUSE_IF, OACC_CLAUSE_IF */
1, /* OMP_CLAUSE_NUM_THREADS */
1, /* OMP_CLAUSE_SCHEDULE */
0, /* OMP_CLAUSE_NOWAIT */
0, /* OMP_CLAUSE_ORDERED */
0, /* OMP_CLAUSE_DEFAULT */
- 3, /* OMP_CLAUSE_COLLAPSE */
+ 3, /* OMP_CLAUSE_COLLAPSE, OACC_CLAUSE_COLLAPSE */
0, /* OMP_CLAUSE_UNTIED */
1, /* OMP_CLAUSE_FINAL */
0, /* OMP_CLAUSE_MERGEABLE */
@@ -281,6 +301,14 @@ unsigned const char omp_clause_num_ops[] =
0, /* OMP_CLAUSE_SECTIONS */
0, /* OMP_CLAUSE_TASKGROUP */
1, /* OMP_CLAUSE__SIMDUID_ */
+
+ 0, /* OACC_CLAUSE_SEQ */
+ 0, /* OACC_CLAUSE_INDEPENDENT */
+ 1, /* OACC_CLAUSE_WORKER */
+ 1, /* OACC_CLAUSE_VECTOR */
+ 1, /* OACC_CLAUSE_NUM_GANGS */
+ 1, /* OACC_CLAUSE_NUM_WORKERS */
+ 1, /* OACC_CLAUSE_VECTOR_LENGTH */
};
const char * const omp_clause_code_name[] =
@@ -300,6 +328,25 @@ const char * const omp_clause_code_name[] =
"from",
"to",
"map",
+ "copy",
+ "copyout",
+ "create",
+ "present",
+ "present_or_copy",
+ "present_or_copyin",
+ "present_or_copyout",
+ "present_or_create",
+ "host",
+ "device",
+ "deviceptr",
+ "device_resident",
+ "use_device",
+ "delete",
+ "async",
+ "gang",
+ "wait",
+ "_wait_",
+ "_cache_",
"_looptemp_",
"if",
"num_threads",
@@ -324,7 +371,14 @@ const char * const omp_clause_code_name[] =
"parallel",
"sections",
"taskgroup",
- "_simduid_"
+ "_simduid_",
+ "seq",
+ "indepentend",
+ "worker",
+ "vector",
+ "num_gangs",
+ "num_workers",
+ "vector_length"
};
@@ -10359,7 +10413,6 @@ build_empty_stmt (location_t loc)
return t;
}
-
/* Build an OpenMP clause with code CODE. LOC is the location of the
clause. */
@@ -11022,6 +11075,29 @@ walk_tree_1 (tree *tp, walk_tree_fn func, void *data,
case OMP_CLAUSE:
switch (OMP_CLAUSE_CODE (*tp))
{
+ case OACC_CLAUSE_COPY:
+ case OACC_CLAUSE_COPYOUT:
+ case OACC_CLAUSE_CREATE:
+ case OACC_CLAUSE_PRESENT:
+ case OACC_CLAUSE_PRESENT_OR_COPY:
+ case OACC_CLAUSE_PRESENT_OR_COPYIN:
+ case OACC_CLAUSE_PRESENT_OR_COPYOUT:
+ case OACC_CLAUSE_PRESENT_OR_CREATE:
+ case OACC_CLAUSE_HOST:
+ case OACC_CLAUSE_DEVICE:
+ case OACC_CLAUSE_DEVICEPTR:
+ case OACC_CLAUSE_DEVICE_RESIDENT:
+ case OACC_CLAUSE_USE_DEVICE:
+ case OACC_CLAUSE_DELETE:
+ case OACC_NO_CLAUSE_CACHE:
+ case OACC_CLAUSE_ASYNC:
+ case OACC_CLAUSE_WORKER:
+ case OACC_CLAUSE_VECTOR:
+ case OACC_CLAUSE_NUM_GANGS:
+ case OACC_CLAUSE_NUM_WORKERS:
+ case OACC_CLAUSE_VECTOR_LENGTH:
+ case OACC_CLAUSE_WAIT:
+ case OACC_NO_CLAUSE_WAIT:
case OMP_CLAUSE_PRIVATE:
case OMP_CLAUSE_SHARED:
case OMP_CLAUSE_FIRSTPRIVATE:
@@ -11044,6 +11120,8 @@ walk_tree_1 (tree *tp, walk_tree_fn func, void *data,
WALK_SUBTREE (OMP_CLAUSE_OPERAND (*tp, 0));
/* FALLTHRU */
+ case OACC_CLAUSE_SEQ:
+ case OACC_CLAUSE_INDEPENDENT:
case OMP_CLAUSE_NOWAIT:
case OMP_CLAUSE_ORDERED:
case OMP_CLAUSE_DEFAULT:
diff --git a/gcc/tree.def b/gcc/tree.def
index 0edddda..562da21 100644
--- a/gcc/tree.def
+++ b/gcc/tree.def
@@ -1012,6 +1012,56 @@ DEFTREECODE (MEM_REF, "mem_ref", tcc_reference, 2)
DEFTREECODE (OACC_PARALLEL, "oacc_parallel", tcc_statement, 2)
+/* #pragma acc kernels */
+/* Operand 0: BODY
+ Operand 1: CLAUSES
+*/
+DEFTREECODE (OACC_KERNELS, "oacc_kernels", tcc_statement, 2)
+
+/* #pragma acc data */
+/* Operand 0: BODY
+ Operand 1: CLAUSES
+*/
+DEFTREECODE (OACC_DATA, "oacc_data", tcc_statement, 2)
+
+/* #pragma acc host_data */
+/* Operand 0: BODY
+ Operand 1: CLAUSES
+*/
+DEFTREECODE (OACC_HOST_DATA, "oacc_host_data", tcc_statement, 2)
+
+/* #pragma acc declare */
+/* Operand 0: CLAUSES
+*/
+DEFTREECODE (OACC_DECLARE, "oacc_declare", tcc_statement, 1)
+
+/* #pragma acc update */
+/* Operand 0: CLAUSES
+*/
+DEFTREECODE (OACC_UPDATE, "oacc_update", tcc_statement, 1)
+
+/* #pragma acc enter data */
+/* Operand 0: CLAUSES
+*/
+
+DEFTREECODE (OACC_ENTER_DATA, "oacc_enter_data", tcc_statement, 1)
+
+/* #pragma acc exit data */
+/* Operand 0: CLAUSES
+*/
+
+DEFTREECODE (OACC_EXIT_DATA, "oacc_exit_data", tcc_statement, 1)
+
+/* #pragma acc wait */
+/* Operand 0: INT_EXPR
+*/
+DEFTREECODE (OACC_WAIT, "oacc_wait", tcc_statement, 1)
+
+/* #pragma acc cache */
+/* Operand 0: LIST
+*/
+DEFTREECODE (OACC_CACHE, "oacc_cache", tcc_statement, 1)
+
/* OpenMP - #pragma omp parallel [clause1 ... clauseN]
Operand 0: OMP_PARALLEL_BODY: Code to be executed by all threads.
Operand 1: OMP_PARALLEL_CLAUSES: List of clauses. */
diff --git a/gcc/tree.h b/gcc/tree.h
index ad9901c..717a41f 100644
--- a/gcc/tree.h
+++ b/gcc/tree.h
@@ -1185,11 +1185,6 @@ extern void protected_set_expr_location (tree, location_t);
#define OMP_CLAUSES(NODE) \
TREE_OPERAND (TREE_RANGE_CHECK (NODE, OACC_PARALLEL, OMP_SINGLE), 1)
-#define OACC_PARALLEL_BODY(NODE) \
- TREE_OPERAND (OACC_PARALLEL_CHECK (NODE), 0)
-#define OACC_PARALLEL_CLAUSES(NODE) \
- TREE_OPERAND (OACC_PARALLEL_CHECK (NODE), 1)
-
#define OMP_PARALLEL_BODY(NODE) TREE_OPERAND (OMP_PARALLEL_CHECK (NODE), 0)
#define OMP_PARALLEL_CLAUSES(NODE) TREE_OPERAND (OMP_PARALLEL_CHECK (NODE), 1)
@@ -1390,6 +1385,91 @@ extern void protected_set_expr_location (tree, location_t);
#define OMP_CLAUSE_DEFAULT_KIND(NODE) \
(OMP_CLAUSE_SUBCODE_CHECK (NODE, OMP_CLAUSE_DEFAULT)->omp_clause.subcode.default_kind)
+/* OpenACC directives and clause accessors. */
+
+#define OACC_BODY(NODE) \
+ TREE_OPERAND (NODE, 0)
+
+#define OACC_CLAUSE_CHAIN(NODE) OMP_CLAUSE_CHAIN(NODE)
+
+#define OACC_CLAUSE(NODE) OMP_CLAUSE(NODE)
+
+#define OACC_CLAUSE_DECL(NODE) OMP_CLAUSE_DECL(NODE)
+
+#define OACC_CLAUSE_CODE(NODE) OMP_CLAUSE_CODE(NODE)
+
+#define OACC_CLAUSE_OPERAND(T, i) OMP_CLAUSE_OPERAND(T, i)
+
+#define OACC_CLAUSE_SET_CODE(NODE, CODE) OMP_CLAUSE_SET_CODE(NODE, CODE)
+
+#define OACC_CLAUSE_LOCATION(NODE) OMP_CLAUSE_LOCATION(NODE)
+
+#define OACC_PARALLEL_BODY(NODE) TREE_OPERAND (OACC_PARALLEL_CHECK(NODE), 0)
+#define OACC_PARALLEL_CLAUSES(NODE) TREE_OPERAND (OACC_PARALLEL_CHECK(NODE), 1)
+
+#define OACC_KERNELS_BODY(NODE) TREE_OPERAND (OACC_KERNELS_CHECK(NODE), 0)
+#define OACC_KERNELS_CLAUSES(NODE) TREE_OPERAND (OACC_KERNELS_CHECK(NODE), 1)
+
+/* OpenACC clauses */
+#define OACC_CLAUSE_NUM_GANGS_EXPR(NODE) \
+ OMP_CLAUSE_OPERAND (OMP_CLAUSE_SUBCODE_CHECK (NODE, OACC_CLAUSE_NUM_GANGS), 0)
+#define OACC_CLAUSE_NUM_WORKERS_EXPR(NODE) \
+ OMP_CLAUSE_OPERAND ( \
+ OMP_CLAUSE_SUBCODE_CHECK (NODE, OACC_CLAUSE_NUM_WORKERS), 0)
+#define OACC_CLAUSE_VECTOR_LENGTH_EXPR(NODE) \
+ OMP_CLAUSE_OPERAND ( \
+ OMP_CLAUSE_SUBCODE_CHECK (NODE, OACC_CLAUSE_VECTOR_LENGTH), 0)
+#define OACC_CLAUSE_VECTOR_EXPR(NODE) \
+ OMP_CLAUSE_OPERAND ( \
+ OMP_CLAUSE_SUBCODE_CHECK (NODE, OACC_CLAUSE_VECTOR_LENGTH), 0)
+#define OACC_CLAUSE_WORKER_EXPR(NODE) \
+ OMP_CLAUSE_OPERAND ( \
+ OMP_CLAUSE_SUBCODE_CHECK (NODE, OACC_CLAUSE_WORKER), 0)
+#define OACC_CLAUSE_GANG_EXPR(NODE) \
+ OMP_CLAUSE_OPERAND ( \
+ OMP_CLAUSE_SUBCODE_CHECK (NODE, OACC_CLAUSE_GANG), 0)
+#define OACC_CLAUSE_COLLAPSE_EXPR(NODE) \
+ OMP_CLAUSE_OPERAND ( \
+ OMP_CLAUSE_SUBCODE_CHECK (NODE, OACC_CLAUSE_COLLAPSE), 0)
+#define OACC_CLAUSE_IF_EXPR(NODE) \
+ OMP_CLAUSE_OPERAND ( \
+ OMP_CLAUSE_SUBCODE_CHECK (NODE, OACC_CLAUSE_IF), 0)
+#define OACC_CLAUSE_ASYNC_EXPR(NODE) \
+ OMP_CLAUSE_OPERAND ( \
+ OMP_CLAUSE_SUBCODE_CHECK (NODE, OACC_CLAUSE_ASYNC), 0)
+#define OACC_WAIT_EXPR(NODE) \
+ OMP_CLAUSE_OPERAND ( \
+ OMP_CLAUSE_SUBCODE_CHECK (NODE, OACC_NO_CLAUSE_WAIT), 0)
+
+#define OACC_DATA_BODY(NODE) \
+ TREE_OPERAND (OACC_DATA_CHECK (NODE), 0)
+
+#define OACC_DATA_CLAUSES(NODE) \
+ TREE_OPERAND (OACC_DATA_CHECK (NODE), 1)
+
+#define OACC_DECLARE_CLAUSES(NODE) \
+ TREE_OPERAND (OACC_DECLARE_CHECK (NODE), 0)
+
+#define OACC_UPDATE_CLAUSES(NODE) \
+ TREE_OPERAND (OACC_UPDATE_CHECK (NODE), 0)
+
+#define OACC_WAIT_CLAUSES(NODE) \
+ TREE_OPERAND (OACC_WAIT_CHECK (NODE), 0)
+
+#define OACC_CACHE_CLAUSES(NODE) \
+ TREE_OPERAND (OACC_CACHE_CHECK (NODE), 0)
+
+#define OACC_HOST_DATA_BODY(NODE) \
+ TREE_OPERAND (OACC_HOST_DATA_CHECK (NODE), 0)
+#define OACC_HOST_DATA_CLAUSES(NODE) \
+ TREE_OPERAND (OACC_HOST_DATA_CHECK (NODE), 1)
+
+#define OACC_CLAUSE_REDUCTION_CODE(NODE) OMP_CLAUSE_REDUCTION_CODE(NODE)
+#define OACC_CLAUSE_REDUCTION_INIT(NODE) OMP_CLAUSE_REDUCTION_INIT(NODE)
+#define OACC_CLAUSE_REDUCTION_MERGE(NODE) OMP_CLAUSE_REDUCTION_MERGE(NODE)
+#define OACC_CLAUSE_REDUCTION_PLACEHOLDER(NODE) \
+ OMP_CLAUSE_REDUCTION_PLACEHOLDER(NODE)
+
/* SSA_NAME accessors. */
/* Returns the IDENTIFIER_NODE giving the SSA name a name or NULL_TREE
@@ -3585,6 +3665,11 @@ extern tree build_translation_unit_decl (tree);
extern tree build_block (tree, tree, tree, tree);
extern tree build_empty_stmt (location_t);
extern tree build_omp_clause (location_t, enum omp_clause_code);
+static inline tree
+build_oacc_clause (location_t loc, enum omp_clause_code code)
+{
+ return build_omp_clause (loc, code);
+}
extern tree build_vl_exp_stat (enum tree_code, int MEM_STAT_DECL);
#define build_vl_exp(c, n) build_vl_exp_stat (c, n MEM_STAT_INFO)
--
1.8.3.2
^ permalink raw reply [flat|nested] 89+ messages in thread
* [PATCH 5/6] [GOMP4] OpenACC 1.0+ support in fortran front-end
2014-01-23 18:05 ` [PATCH 4/6] " Ilmir Usmanov
@ 2014-01-23 18:05 ` Ilmir Usmanov
2014-01-23 18:06 ` [PATCH 6/6] " Ilmir Usmanov
2014-01-24 19:33 ` [PATCH 4/6] " Thomas Schwinge
1 sibling, 1 reply; 89+ messages in thread
From: Ilmir Usmanov @ 2014-01-23 18:05 UTC (permalink / raw)
To: gcc-patches, Thomas Schwinge, jakub
Cc: Evgeny Gavrin, GarbuzovViacheslav, Dmitri Botcharnikov
[-- Attachment #1: Type: text/plain, Size: 1 bytes --]
[-- Attachment #2: 0005-OpenACC-fortran-tests.patch --]
[-- Type: text/x-diff, Size: 51638 bytes --]
From ae0ba17c51f6ed3529976a0cdf8f80046d1ed9b7 Mon Sep 17 00:00:00 2001
From: Ilmir Usmanov <i.usmanov@samsung.com>
Date: Thu, 23 Jan 2014 21:10:41 +0400
Subject: [PATCH 5/6] OpenACC fortran tests
---
gcc/testsuite/gfortran.dg/goacc/branch.f95 | 55 +++++
.../gfortran.dg/goacc/continuation-free-form.f95 | 24 ++
gcc/testsuite/gfortran.dg/goacc/data-clauses.f95 | 261 +++++++++++++++++++++
gcc/testsuite/gfortran.dg/goacc/data-tree.f95 | 32 +++
gcc/testsuite/gfortran.dg/goacc/declare-1.f95 | 11 +
gcc/testsuite/gfortran.dg/goacc/declare.f95 | 9 +
.../gfortran.dg/goacc/directive-names.f95 | 19 ++
.../gfortran.dg/goacc/enter-exit-data.f95 | 89 +++++++
gcc/testsuite/gfortran.dg/goacc/goacc.exp | 36 +++
gcc/testsuite/gfortran.dg/goacc/host_data-tree.f95 | 12 +
gcc/testsuite/gfortran.dg/goacc/if.f95 | 53 +++++
gcc/testsuite/gfortran.dg/goacc/kernels-tree.f95 | 33 +++
gcc/testsuite/gfortran.dg/goacc/list.f95 | 111 +++++++++
.../gfortran.dg/goacc/parallel-kernels-clauses.f95 | 96 ++++++++
.../gfortran.dg/goacc/parallel-kernels-regions.f95 | 56 +++++
gcc/testsuite/gfortran.dg/goacc/parallel-tree.f95 | 41 ++++
.../goacc/pure-elemental-procedures.f95 | 46 ++++
gcc/testsuite/gfortran.dg/goacc/reduction.f95 | 139 +++++++++++
.../gfortran.dg/goacc/sentinel-free-form.f95 | 22 ++
.../gfortran.dg/goacc/several-directives.f95 | 7 +
gcc/testsuite/gfortran.dg/goacc/sie.f95 | 252 ++++++++++++++++++++
21 files changed, 1404 insertions(+)
create mode 100644 gcc/testsuite/gfortran.dg/goacc/branch.f95
create mode 100644 gcc/testsuite/gfortran.dg/goacc/continuation-free-form.f95
create mode 100644 gcc/testsuite/gfortran.dg/goacc/data-clauses.f95
create mode 100644 gcc/testsuite/gfortran.dg/goacc/data-tree.f95
create mode 100644 gcc/testsuite/gfortran.dg/goacc/declare-1.f95
create mode 100644 gcc/testsuite/gfortran.dg/goacc/declare.f95
create mode 100644 gcc/testsuite/gfortran.dg/goacc/directive-names.f95
create mode 100644 gcc/testsuite/gfortran.dg/goacc/enter-exit-data.f95
create mode 100644 gcc/testsuite/gfortran.dg/goacc/goacc.exp
create mode 100644 gcc/testsuite/gfortran.dg/goacc/host_data-tree.f95
create mode 100644 gcc/testsuite/gfortran.dg/goacc/if.f95
create mode 100644 gcc/testsuite/gfortran.dg/goacc/kernels-tree.f95
create mode 100644 gcc/testsuite/gfortran.dg/goacc/list.f95
create mode 100644 gcc/testsuite/gfortran.dg/goacc/parallel-kernels-clauses.f95
create mode 100644 gcc/testsuite/gfortran.dg/goacc/parallel-kernels-regions.f95
create mode 100644 gcc/testsuite/gfortran.dg/goacc/parallel-tree.f95
create mode 100644 gcc/testsuite/gfortran.dg/goacc/pure-elemental-procedures.f95
create mode 100644 gcc/testsuite/gfortran.dg/goacc/reduction.f95
create mode 100644 gcc/testsuite/gfortran.dg/goacc/sentinel-free-form.f95
create mode 100644 gcc/testsuite/gfortran.dg/goacc/several-directives.f95
create mode 100644 gcc/testsuite/gfortran.dg/goacc/sie.f95
diff --git a/gcc/testsuite/gfortran.dg/goacc/branch.f95 b/gcc/testsuite/gfortran.dg/goacc/branch.f95
new file mode 100644
index 0000000..e470ce2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/branch.f95
@@ -0,0 +1,55 @@
+! { dg-do compile }
+! { dg-options "-fopenacc" }
+
+program test
+ implicit none
+
+ integer :: i
+
+ if (.true.) then
+ !$acc parallel
+ end if ! { dg-error "Unexpected" }
+ !$acc end parallel
+ end if
+
+ if (.true.) then
+ !$acc kernels
+ end if ! { dg-error "Unexpected" }
+ !$acc end kernels
+ end if
+
+ !$acc parallel
+ if (.true.) then
+ !$acc end parallel ! { dg-error "Unexpected" }
+ end if
+ !$acc end parallel
+
+ !$acc kernels
+ if (.true.) then
+ !$acc end kernels ! { dg-error "Unexpected" }
+ end if
+ !$acc end kernels
+
+ !$acc parallel
+ if (.true.) then
+ end if
+ !$acc end parallel
+
+ !$acc kernels
+ if (.true.) then
+ end if
+ !$acc end kernels
+
+ if (.true.) then
+ !$acc parallel
+ !$acc end parallel
+ end if
+
+ if (.true.) then
+ !$acc kernels
+ !$acc end kernels
+ end if
+10 i = 0
+
+
+end program test
\ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/goacc/continuation-free-form.f95 b/gcc/testsuite/gfortran.dg/goacc/continuation-free-form.f95
new file mode 100644
index 0000000..df32d9c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/continuation-free-form.f95
@@ -0,0 +1,24 @@
+! { dg-do compile }
+! { dg-options "-fopenacc" }
+
+program test
+ implicit none
+
+ integer :: i
+ real :: x
+
+ !$acc parallel &
+ !$acc loop & ! continuation
+ !$acc & reduction(+:x)
+
+ ! this line must be ignored
+ !$acc ! kernels
+ do i = 1,10
+ x = x + 0.3
+ enddo
+ ! continuation must begin with sentinel
+ !$acc end parallel & ! { dg-error "Unclassifiable OpenACC directive" }
+ ! loop
+
+ print *, x
+end
\ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/goacc/data-clauses.f95 b/gcc/testsuite/gfortran.dg/goacc/data-clauses.f95
new file mode 100644
index 0000000..cbe98b8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/data-clauses.f95
@@ -0,0 +1,261 @@
+! { dg-do compile }
+! { dg-options "-fopenacc -fmax-errors=100" }
+
+! todo: some of warnings are not necessary
+
+module test
+ implicit none
+contains
+
+ subroutine foo (vi)
+ integer, value :: vi
+ integer :: i, ia(10)
+ complex :: c, ca(10)
+ real, target:: r
+ real :: ra(10)
+ real, pointer :: rp
+ real, dimension(:), allocatable :: aa
+ type t
+ integer :: i
+ end type
+ type(t) :: ti
+ type(t), allocatable :: tia
+ type(t), target :: tit
+ type(t), pointer :: tip
+ rp => r
+ tip => tit
+
+ !$acc parallel deviceptr (rp) ! { dg-error "POINTER" }
+ !$acc end parallel
+ !$acc parallel deviceptr (vi) ! { dg-error "VALUE" }
+ !$acc end parallel
+ !$acc parallel deviceptr (aa) ! { dg-error "ALLOCATABLE" }
+ !$acc end parallel
+
+ !$acc parallel deviceptr (i, c, r, ia, ca, ra, ti)
+ !$acc end parallel
+ !$acc kernels deviceptr (i, c, r, ia, ca, ra, ti)
+ !$acc end kernels
+ !$acc data deviceptr (i, c, r, ia, ca, ra, ti)
+ !$acc end data
+
+
+ !$acc parallel copy (tip) ! { dg-error "POINTER" }
+ !$acc end parallel
+ !$acc parallel copy (tia) ! { dg-error "ALLOCATABLE" }
+ !$acc end parallel
+ !$acc parallel deviceptr (i) copy (i) ! { dg-warning "multiple clauses" }
+ !$acc end parallel
+
+ !$acc parallel copy (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end parallel
+ !$acc kernels copy (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end kernels
+ !$acc data copy (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end data
+
+
+ !$acc parallel copyin (tip) ! { dg-error "POINTER" }
+ !$acc end parallel
+ !$acc parallel copyin (tia) ! { dg-error "ALLOCATABLE" }
+ !$acc end parallel
+ !$acc parallel deviceptr (i) copyin (i) ! { dg-warning "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel copy (i) copyin (i) ! { dg-warning "multiple clauses" }
+ !$acc end parallel
+
+ !$acc parallel copyin (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end parallel
+ !$acc kernels copyin (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end kernels
+ !$acc data copyin (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end data
+
+
+ !$acc parallel copyout (tip) ! { dg-error "POINTER" }
+ !$acc end parallel
+ !$acc parallel copyout (tia) ! { dg-error "ALLOCATABLE" }
+ !$acc end parallel
+ !$acc parallel deviceptr (i) copyout (i) ! { dg-warning "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel copy (i) copyout (i) ! { dg-warning "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel copyin (i) copyout (i) ! { dg-warning "multiple clauses" }
+ !$acc end parallel
+
+ !$acc parallel copyout (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end parallel
+ !$acc kernels copyout (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end kernels
+ !$acc data copyout (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end data
+
+
+ !$acc parallel create (tip) ! { dg-error "POINTER" }
+ !$acc end parallel
+ !$acc parallel create (tia) ! { dg-error "ALLOCATABLE" }
+ !$acc end parallel
+ !$acc parallel deviceptr (i) create (i) ! { dg-warning "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel copy (i) create (i) ! { dg-warning "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel copyin (i) create (i) ! { dg-warning "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel copyout (i) create (i) ! { dg-warning "multiple clauses" }
+ !$acc end parallel
+
+ !$acc parallel create (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end parallel
+ !$acc kernels create (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end kernels
+ !$acc data create (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end data
+
+
+ !$acc parallel present (tip) ! { dg-error "POINTER" }
+ !$acc end parallel
+ !$acc parallel present (tia) ! { dg-error "ALLOCATABLE" }
+ !$acc end parallel
+ !$acc parallel deviceptr (i) present (i) ! { dg-warning "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel copy (i) present (i) ! { dg-warning "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel copyin (i) present (i) ! { dg-warning "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel copyout (i) present (i) ! { dg-warning "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel create (i) present (i) ! { dg-warning "multiple clauses" }
+ !$acc end parallel
+
+ !$acc parallel present (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end parallel
+ !$acc kernels present (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end kernels
+ !$acc data present (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end data
+
+
+ !$acc parallel pcopy (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end parallel
+ !$acc parallel pcopyin (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end parallel
+ !$acc parallel pcopyout (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end parallel
+ !$acc parallel pcreate (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end parallel
+
+
+ !$acc parallel present_or_copy (tip) ! { dg-error "POINTER" }
+ !$acc end parallel
+ !$acc parallel present_or_copy (tia) ! { dg-error "ALLOCATABLE" }
+ !$acc end parallel
+ !$acc parallel deviceptr (i) present_or_copy (i) ! { dg-warning "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel copy (i) present_or_copy (i) ! { dg-warning "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel copyin (i) present_or_copy (i) ! { dg-warning "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel copyout (i) present_or_copy (i) ! { dg-warning "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel create (i) present_or_copy (i) ! { dg-warning "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel present (i) present_or_copy (i) ! { dg-warning "multiple clauses" }
+ !$acc end parallel
+
+ !$acc parallel present_or_copy (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end parallel
+ !$acc kernels present_or_copy (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end kernels
+ !$acc data present_or_copy (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end data
+
+
+ !$acc parallel present_or_copyin (tip) ! { dg-error "POINTER" }
+ !$acc end parallel
+ !$acc parallel present_or_copyin (tia) ! { dg-error "ALLOCATABLE" }
+ !$acc end parallel
+ !$acc parallel deviceptr (i) present_or_copyin (i) ! { dg-warning "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel copy (i) present_or_copyin (i) ! { dg-warning "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel copyin (i) present_or_copyin (i) ! { dg-warning "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel copyout (i) present_or_copyin (i) ! { dg-warning "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel create (i) present_or_copyin (i) ! { dg-warning "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel present (i) present_or_copyin (i) ! { dg-warning "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel present_or_copy (i) present_or_copyin (i) ! { dg-warning "multiple clauses" }
+ !$acc end parallel
+
+ !$acc parallel present_or_copyin (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end parallel
+ !$acc kernels present_or_copyin (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end kernels
+ !$acc data present_or_copyin (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end data
+
+
+ !$acc parallel present_or_copyout (tip) ! { dg-error "POINTER" }
+ !$acc end parallel
+ !$acc parallel present_or_copyout (tia) ! { dg-error "ALLOCATABLE" }
+ !$acc end parallel
+ !$acc parallel deviceptr (i) present_or_copyout (i) ! { dg-warning "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel copy (i) present_or_copyout (i) ! { dg-warning "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel copyin (i) present_or_copyout (i) ! { dg-warning "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel copyout (i) present_or_copyout (i) ! { dg-warning "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel create (i) present_or_copyout (i) ! { dg-warning "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel present (i) present_or_copyout (i) ! { dg-warning "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel present_or_copy (i) present_or_copyout (i) ! { dg-warning "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel present_or_copyin (i) present_or_copyout (i) ! { dg-warning "multiple clauses" }
+ !$acc end parallel
+
+ !$acc parallel present_or_copyout (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end parallel
+ !$acc kernels present_or_copyout (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end kernels
+ !$acc data present_or_copyout (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end data
+
+
+ !$acc parallel present_or_create (tip) ! { dg-error "POINTER" }
+ !$acc end parallel
+ !$acc parallel present_or_create (tia) ! { dg-error "ALLOCATABLE" }
+ !$acc end parallel
+ !$acc parallel deviceptr (i) present_or_create (i) ! { dg-warning "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel copy (i) present_or_create (i) ! { dg-warning "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel copyin (i) present_or_create (i) ! { dg-warning "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel copyout (i) present_or_create (i) ! { dg-warning "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel create (i) present_or_create (i) ! { dg-warning "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel present (i) present_or_create (i) ! { dg-warning "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel present_or_copy (i) present_or_create (i) ! { dg-warning "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel present_or_copyin (i) present_or_create (i) ! { dg-warning "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel present_or_copyout (i) present_or_create (i) ! { dg-warning "multiple clauses" }
+ !$acc end parallel
+
+ !$acc parallel present_or_create (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end parallel
+ !$acc kernels present_or_create (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end kernels
+ !$acc data present_or_create (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end data
+
+ end subroutine foo
+
+end module test
\ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/goacc/data-tree.f95 b/gcc/testsuite/gfortran.dg/goacc/data-tree.f95
new file mode 100644
index 0000000..523cb39
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/data-tree.f95
@@ -0,0 +1,32 @@
+! { dg-do compile }
+! { dg-options "-fopenacc -fdump-tree-original" }
+
+! test for tree-dump-original and spaces-commas
+
+program test
+ implicit none
+ integer :: q, i, j, k, m, n, o, p, r, s, t, u, v, w
+ logical :: l
+
+ !$acc data if(l) copy(i), copyin(j), copyout(k), create(m) &
+ !$acc present(o), pcopy(p), pcopyin(r), pcopyout(s), pcreate(t) &
+ !$acc deviceptr(u)
+ !$acc end data
+
+end program test
+! { dg-final { scan-tree-dump "pragma acc data" "original" } }
+
+! { dg-final { scan-tree-dump "if" "original" } }
+! { dg-final { scan-tree-dump "copy" "original" } }
+! { dg-final { scan-tree-dump "copyin" "original" } }
+! { dg-final { scan-tree-dump "copyout" "original" } }
+! { dg-final { scan-tree-dump "create" "original" } }
+
+! { dg-final { scan-tree-dump "present" "original" } }
+! { dg-final { scan-tree-dump "present_or_copy" "original" } }
+! { dg-final { scan-tree-dump "present_or_copyin" "original" } }
+! { dg-final { scan-tree-dump "present_or_copyout" "original" } }
+! { dg-final { scan-tree-dump "present_or_create" "original" } }
+
+! { dg-final { scan-tree-dump "deviceptr" "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
\ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/goacc/declare-1.f95 b/gcc/testsuite/gfortran.dg/goacc/declare-1.f95
new file mode 100644
index 0000000..35d5f86
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/declare-1.f95
@@ -0,0 +1,11 @@
+! { dg-do compile }
+! { dg-options "-fopenacc -fdump-tree-original" }
+program test
+ implicit none
+ integer :: i
+
+ !$acc declare copy(i)
+
+end program test
+! { dg-final { scan-tree-dump "pragma acc declare copy" "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
diff --git a/gcc/testsuite/gfortran.dg/goacc/declare.f95 b/gcc/testsuite/gfortran.dg/goacc/declare.f95
new file mode 100644
index 0000000..2214426
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/declare.f95
@@ -0,0 +1,9 @@
+! { dg-do compile }
+! { dg-options "-fopenacc" }
+program test
+ implicit none
+ integer :: i
+
+ !$acc declare copy(i)
+
+end program test
\ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/goacc/directive-names.f95 b/gcc/testsuite/gfortran.dg/goacc/directive-names.f95
new file mode 100644
index 0000000..1be7eb9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/directive-names.f95
@@ -0,0 +1,19 @@
+! { dg-do compile }
+! { dg-options "-fopenacc" }
+
+program test
+ implicit none
+
+ !$acc parallel
+ !$acc end parallel
+
+ !$acc kernels
+ !$acc end kernels
+
+ !$acc data
+ !$acc end data
+
+ !$acc host_data
+ !$acc end host_data
+
+end program test
\ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/goacc/enter-exit-data.f95 b/gcc/testsuite/gfortran.dg/goacc/enter-exit-data.f95
new file mode 100644
index 0000000..cea6c0a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/enter-exit-data.f95
@@ -0,0 +1,89 @@
+! { dg-do compile }
+! { dg-options "-fopenacc -fmax-errors=100" }
+
+
+module test
+ implicit none
+contains
+
+ subroutine foo (vi)
+ logical :: l
+ integer, value :: vi
+ integer :: i, ia(10), a(10), b(2:8)
+ complex :: c, ca(10)
+ real, target:: r
+ real :: ra(10)
+ real, pointer :: rp
+ real, dimension(:), allocatable :: aa
+ type t
+ integer :: i
+ end type
+ type(t) :: ti
+ type(t), allocatable :: tia
+ type(t), target :: tit
+ type(t), pointer :: tip
+ rp => r
+ tip => tit
+
+ ! enter data
+ !$acc enter data
+ !$acc enter data if (.false.)
+ !$acc enter data if (l)
+ !$acc enter data if (.false.) if (l) ! { dg-error "Unclassifiable" }
+ !$acc enter data if (i) ! { dg-error "LOGICAL" }
+ !$acc enter data if (1) ! { dg-error "LOGICAL" }
+ !$acc enter data if (a) ! { dg-error "LOGICAL" }
+ !$acc enter data if (b(5:6)) ! { dg-error "LOGICAL" }
+ !$acc enter data async (l) ! { dg-error "INTEGER" }
+ !$acc enter data async (.true.) ! { dg-error "INTEGER" }
+ !$acc enter data async (1)
+ !$acc enter data async (i)
+ !$acc enter data async (a) ! { dg-error "INTEGER" }
+ !$acc enter data async (b(5:6)) ! { dg-error "INTEGER" }
+ !$acc enter data wait (l) ! { dg-error "INTEGER" }
+ !$acc enter data wait (.true.) ! { dg-error "INTEGER" }
+ !$acc enter data wait (i, 1)
+ !$acc enter data wait (a) ! { dg-error "INTEGER" }
+ !$acc enter data wait (b(5:6)) ! { dg-error "INTEGER" }
+ !$acc enter data copyin (tip) ! { dg-error "POINTER" }
+ !$acc enter data copyin (tia) ! { dg-error "ALLOCATABLE" }
+ !$acc enter data create (tip) ! { dg-error "POINTER" }
+ !$acc enter data create (tia) ! { dg-error "ALLOCATABLE" }
+ !$acc enter data present_or_copyin (tip) ! { dg-error "POINTER" }
+ !$acc enter data present_or_copyin (tia) ! { dg-error "ALLOCATABLE" }
+ !$acc enter data present_or_create (tip) ! { dg-error "POINTER" }
+ !$acc enter data present_or_create (tia) ! { dg-error "ALLOCATABLE" }
+ !$acc enter data copyin (i) create (i) ! { dg-warning "multiple clauses" }
+ !$acc enter data copyin (i) present_or_copyin (i) ! { dg-warning "multiple clauses" }
+ !$acc enter data create (i) present_or_copyin (i) ! { dg-warning "multiple clauses" }
+ !$acc enter data copyin (i) present_or_create (i) ! { dg-warning "multiple clauses" }
+ !$acc enter data create (i) present_or_create (i) ! { dg-warning "multiple clauses" }
+ !$acc enter data present_or_copyin (i) present_or_create (i) ! { dg-warning "multiple clauses" }
+
+ ! exit data
+ !$acc exit data
+ !$acc exit data if (.false.)
+ !$acc exit data if (l)
+ !$acc exit data if (.false.) if (l) ! { dg-error "Unclassifiable" }
+ !$acc exit data if (i) ! { dg-error "LOGICAL" }
+ !$acc exit data if (1) ! { dg-error "LOGICAL" }
+ !$acc exit data if (a) ! { dg-error "LOGICAL" }
+ !$acc exit data if (b(5:6)) ! { dg-error "LOGICAL" }
+ !$acc exit data async (l) ! { dg-error "INTEGER" }
+ !$acc exit data async (.true.) ! { dg-error "INTEGER" }
+ !$acc exit data async (1)
+ !$acc exit data async (i)
+ !$acc exit data async (a) ! { dg-error "INTEGER" }
+ !$acc exit data async (b(5:6)) ! { dg-error "INTEGER" }
+ !$acc exit data wait (l) ! { dg-error "INTEGER" }
+ !$acc exit data wait (.true.) ! { dg-error "INTEGER" }
+ !$acc exit data wait (i, 1)
+ !$acc exit data wait (a) ! { dg-error "INTEGER" }
+ !$acc exit data wait (b(5:6)) ! { dg-error "INTEGER" }
+ !$acc exit data copyout (tip) ! { dg-error "POINTER" }
+ !$acc exit data copyout (tia) ! { dg-error "ALLOCATABLE" }
+ !$acc exit data delete (tip) ! { dg-error "POINTER" }
+ !$acc exit data delete (tia) ! { dg-error "ALLOCATABLE" }
+ !$acc exit data copyout (i) delete (i) ! { dg-warning "multiple clauses" }
+ end subroutine foo
+end module test
diff --git a/gcc/testsuite/gfortran.dg/goacc/goacc.exp b/gcc/testsuite/gfortran.dg/goacc/goacc.exp
new file mode 100644
index 0000000..dc4fade
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/goacc.exp
@@ -0,0 +1,36 @@
+# Copyright (C) 2005-2013 Free Software Foundation, Inc.
+#
+# This file is part of GCC.
+#
+# GCC is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3, or (at your option)
+# any later version.
+#
+# GCC is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with GCC; see the file COPYING3. If not see
+# <http://www.gnu.org/licenses/>.
+
+# GCC testsuite that uses the `dg.exp' driver.
+
+# Load support procs.
+load_lib gfortran-dg.exp
+
+if ![check_effective_target_fopenmp] {
+ return
+}
+
+# Initialize `dg'.
+dg-init
+
+# Main loop.
+gfortran-dg-runtest [lsort \
+ [find $srcdir/$subdir *.\[fF\]{,90,95,03,08} ] ] " -fopenacc"
+
+# All done.
+dg-finish
diff --git a/gcc/testsuite/gfortran.dg/goacc/host_data-tree.f95 b/gcc/testsuite/gfortran.dg/goacc/host_data-tree.f95
new file mode 100644
index 0000000..c3b13f8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/host_data-tree.f95
@@ -0,0 +1,12 @@
+! { dg-do compile }
+! { dg-options "-fopenacc -fdump-tree-original" }
+
+program test
+ implicit none
+ integer :: i
+
+ !$acc host_data use_device(i)
+ !$acc end host_data
+end program test
+! { dg-final { scan-tree-dump "pragma acc host_data use_device" "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
diff --git a/gcc/testsuite/gfortran.dg/goacc/if.f95 b/gcc/testsuite/gfortran.dg/goacc/if.f95
new file mode 100644
index 0000000..f543c8a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/if.f95
@@ -0,0 +1,53 @@
+! { dg-do compile }
+! { dg-options "-fopenacc" }
+
+program test
+ implicit none
+
+ logical :: x
+ integer :: i
+
+ !$acc parallel if ! { dg-error "Unclassifiable OpenACC directive" }
+ !$acc parallel if () ! { dg-error "Invalid character" }
+ !$acc parallel if (i) ! { dg-error "scalar LOGICAL expression" }
+ !$acc end parallel
+ !$acc parallel if (1) ! { dg-error "scalar LOGICAL expression" }
+ !$acc end parallel
+ !$acc kernels if (i) ! { dg-error "scalar LOGICAL expression" }
+ !$acc end kernels
+ !$acc kernels if ! { dg-error "Unclassifiable OpenACC directive" }
+ !$acc kernels if () ! { dg-error "Invalid character" }
+ !$acc kernels if (1) ! { dg-error "scalar LOGICAL expression" }
+ !$acc end kernels
+ !$acc data if ! { dg-error "Unclassifiable OpenACC directive" }
+ !$acc data if () ! { dg-error "Invalid character" }
+ !$acc data if (i) ! { dg-error "scalar LOGICAL expression" }
+ !$acc end data
+ !$acc data if (1) ! { dg-error "scalar LOGICAL expression" }
+ !$acc end data
+
+ ! at most one if clause may appear
+ !$acc parallel if (.false.) if (.false.) { dg-error "Unclassifiable OpenACC directive" }
+ !$acc kernels if (.false.) if (.false.) { dg-error "Unclassifiable OpenACC directive" }
+ !$acc data if (.false.) if (.false.) { dg-error "Unclassifiable OpenACC directive" }
+
+ !$acc parallel if (x)
+ !$acc end parallel
+ !$acc parallel if (.true.)
+ !$acc end parallel
+ !$acc parallel if (i.gt.1)
+ !$acc end parallel
+ !$acc kernels if (x)
+ !$acc end kernels
+ !$acc kernels if (.true.)
+ !$acc end kernels
+ !$acc kernels if (i.gt.1)
+ !$acc end kernels
+ !$acc data if (x)
+ !$acc end data
+ !$acc data if (.true.)
+ !$acc end data
+ !$acc data if (i.gt.1)
+ !$acc end data
+
+end program test
\ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/goacc/kernels-tree.f95 b/gcc/testsuite/gfortran.dg/goacc/kernels-tree.f95
new file mode 100644
index 0000000..08614e1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/kernels-tree.f95
@@ -0,0 +1,33 @@
+! { dg-do compile }
+! { dg-options "-fopenacc -fdump-tree-original" }
+
+! test for tree-dump-original and spaces-commas
+
+program test
+ implicit none
+ integer :: q, i, j, k, m, n, o, p, r, s, t, u, v, w
+ logical :: l
+
+ !$acc kernels if(l) async copy(i), copyin(j), copyout(k), create(m) &
+ !$acc present(o), pcopy(p), pcopyin(r), pcopyout(s), pcreate(t) &
+ !$acc deviceptr(u)
+ !$acc end kernels
+
+end program test
+! { dg-final { scan-tree-dump "pragma acc kernels" "original" } }
+
+! { dg-final { scan-tree-dump "if" "original" } }
+! { dg-final { scan-tree-dump "async" "original" } }
+! { dg-final { scan-tree-dump "copy" "original" } }
+! { dg-final { scan-tree-dump "copyin" "original" } }
+! { dg-final { scan-tree-dump "copyout" "original" } }
+! { dg-final { scan-tree-dump "create" "original" } }
+
+! { dg-final { scan-tree-dump "present" "original" } }
+! { dg-final { scan-tree-dump "present_or_copy" "original" } }
+! { dg-final { scan-tree-dump "present_or_copyin" "original" } }
+! { dg-final { scan-tree-dump "present_or_copyout" "original" } }
+! { dg-final { scan-tree-dump "present_or_create" "original" } }
+
+! { dg-final { scan-tree-dump "deviceptr" "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
diff --git a/gcc/testsuite/gfortran.dg/goacc/list.f95 b/gcc/testsuite/gfortran.dg/goacc/list.f95
new file mode 100644
index 0000000..8789adc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/list.f95
@@ -0,0 +1,111 @@
+! { dg-do compile }
+! { dg-options "-fopenacc -fmax-errors=100" }
+
+program test
+ implicit none
+
+ integer :: i, j, k, l, a(10)
+ common /b/ j, k
+ real, pointer :: p1 => NULL()
+ complex :: c, d(10)
+
+ !$acc parallel private(i)
+ !$acc end parallel
+
+ !$acc parallel private(a)
+ !$acc end parallel
+
+ !$acc parallel private(c, d)
+ !$acc end parallel
+
+ !$acc parallel private(i, j, k, l, a)
+ !$acc end parallel
+
+ !$acc parallel private (i) private (j)
+ !$acc end parallel
+
+ !$acc parallel private ! { dg-error "Unclassifiable OpenACC directive" }
+
+ !$acc parallel private() ! { dg-error "Syntax error" }
+
+ !$acc parallel private(a(1:3)) ! { dg-error "Syntax error" }
+
+ !$acc parallel private(10) ! { dg-error "Syntax error" }
+
+ !$acc parallel private(/b/, /b/) ! { dg-error "present on multiple clauses" }
+ !$acc end parallel
+
+ !$acc parallel private(i, j, i) ! { dg-error "present on multiple clauses" }
+ !$acc end parallel
+
+ !$acc parallel private(p1)
+ !$acc end parallel
+
+ !$acc parallel firstprivate(i)
+ !$acc end parallel
+
+ !$acc parallel firstprivate(c, d)
+ !$acc end parallel
+
+ !$acc parallel firstprivate(a)
+ !$acc end parallel
+
+ !$acc parallel firstprivate(i, j, k, l, a)
+ !$acc end parallel
+
+ !$acc parallel firstprivate (i) firstprivate (j)
+ !$acc end parallel
+
+ !$acc parallel firstprivate ! { dg-error "Unclassifiable OpenACC directive" }
+
+ !$acc parallel firstprivate() ! { dg-error "Syntax error" }
+
+ !$acc parallel firstprivate(a(1:3)) ! { dg-error "Syntax error" }
+
+ !$acc parallel firstprivate(10) ! { dg-error "Syntax error" }
+
+ !$acc parallel firstprivate (/b/, /b/) ! { dg-error "present on multiple clauses" }
+ !$acc end parallel
+
+ !$acc parallel firstprivate (i, j, i) ! { dg-error "present on multiple clauses" }
+ !$acc end parallel
+
+ !$acc parallel firstprivate(p1)
+ !$acc end parallel
+
+ !$acc parallel private (i) firstprivate (i) ! { dg-error "present on multiple clauses" }
+ !$acc end parallel
+
+ !$acc host_data use_device(i)
+ !$acc end host_data
+
+ !$acc host_data use_device(c, d)
+ !$acc end host_data
+
+ !$acc host_data use_device(a)
+ !$acc end host_data
+
+ !$acc host_data use_device(i, j, k, l, a)
+ !$acc end host_data
+
+ !$acc host_data use_device (i) use_device (j)
+ !$acc end host_data
+
+ !$acc host_data use_device ! { dg-error "Unclassifiable OpenACC directive" }
+
+ !$acc host_data use_device() ! { dg-error "Syntax error" }
+
+ !$acc host_data use_device(a(1:3)) ! { dg-error "Syntax error" }
+
+ !$acc host_data use_device(10) ! { dg-error "Syntax error" }
+
+ !$acc host_data use_device(/b/, /b/) ! { dg-warning "present on multiple clauses" }
+ !$acc end host_data
+
+ !$acc host_data use_device(i, j, i) ! { dg-warning "present on multiple clauses" }
+ !$acc end host_data
+
+ !$acc host_data use_device(p1) ! { dg-error "POINTER" }
+ !$acc end host_data
+
+end program test
\ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/goacc/parallel-kernels-clauses.f95 b/gcc/testsuite/gfortran.dg/goacc/parallel-kernels-clauses.f95
new file mode 100644
index 0000000..4ee080d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/parallel-kernels-clauses.f95
@@ -0,0 +1,96 @@
+! { dg-do compile }
+! { dg-options "-fopenacc -fmax-errors=100" }
+
+! test clauses added in OpenACC ver 2.0
+
+program test
+ implicit none
+ integer :: i, a(10), b(5:7)
+ integer, parameter :: acc_async_noval = -1
+ integer, parameter :: acc_async_sync = -2
+ logical :: l
+
+ ! async
+ !$acc kernels async(i)
+ !$acc end kernels
+ !$acc parallel async(i)
+ !$acc end parallel
+
+ !$acc kernels async(0, 1) { dg-error "Unclassifiable" }
+ !$acc parallel async(0, 1) { dg-error "Unclassifiable" }
+
+ !$acc kernels async
+ !$acc end kernels
+ !$acc parallel async
+ !$acc end parallel
+
+ !$acc kernels async(acc_async_noval)
+ !$acc end kernels
+ !$acc parallel async(acc_async_noval)
+ !$acc end parallel
+
+ !$acc kernels async(acc_async_sync)
+ !$acc end kernels
+ !$acc parallel async(acc_async_sync)
+ !$acc end parallel
+
+ !$acc kernels async() { dg-error "Invalid character" }
+ !$acc parallel async() { dg-error "Invalid character" }
+
+ !$acc kernels async("a") { dg-error "Unclassifiable" }
+ !$acc parallel async("a") { dg-error "Unclassifiable" }
+
+ !$acc kernels async(.true.) { dg-error "Unclassifiable" }
+ !$acc parallel async(.true.) { dg-error "Unclassifiable" }
+
+ ! default(none)
+ !$acc kernels default(none)
+ !$acc end kernels
+ !$acc parallel default(none)
+ !$acc end parallel
+
+ !$acc kernels default (none)
+ !$acc end kernels
+ !$acc parallel default (none)
+ !$acc end parallel
+
+ !$acc kernels default ( none )
+ !$acc end kernels
+ !$acc parallel default ( none )
+ !$acc end parallel
+
+ !$acc kernels default { dg-error "Unclassifiable" }
+ !$acc parallel default { dg-error "Unclassifiable" }
+
+ !$acc kernels default() { dg-error "Unclassifiable" }
+ !$acc parallel default() { dg-error "Unclassifiable" }
+
+ !$acc kernels default(i) { dg-error "Unclassifiable" }
+ !$acc parallel default(i) { dg-error "Unclassifiable" }
+
+ !$acc kernels default(1) { dg-error "Unclassifiable" }
+ !$acc parallel default(1) { dg-error "Unclassifiable" }
+
+ ! Wait
+ !$acc kernels wait (l) ! { dg-error "INTEGER" }
+ !$acc end kernels
+ !$acc kernels wait (.true.) ! { dg-error "INTEGER" }
+ !$acc end kernels
+ !$acc kernels wait (i, 1)
+ !$acc end kernels
+ !$acc kernels wait (a) ! { dg-error "INTEGER" }
+ !$acc end kernels
+ !$acc kernels wait (b(5:6)) ! { dg-error "INTEGER" }
+ !$acc end kernels
+
+ !$acc parallel wait (l) ! { dg-error "INTEGER" }
+ !$acc end parallel
+ !$acc parallel wait (.true.) ! { dg-error "INTEGER" }
+ !$acc end parallel
+ !$acc parallel wait (i, 1)
+ !$acc end parallel
+ !$acc parallel wait (a) ! { dg-error "INTEGER" }
+ !$acc end parallel
+ !$acc parallel wait (b(5:6)) ! { dg-error "INTEGER" }
+ !$acc end parallel
+end
diff --git a/gcc/testsuite/gfortran.dg/goacc/parallel-kernels-regions.f95 b/gcc/testsuite/gfortran.dg/goacc/parallel-kernels-regions.f95
new file mode 100644
index 0000000..a9b5785
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/parallel-kernels-regions.f95
@@ -0,0 +1,56 @@
+! { dg-do compile }
+! { dg-options "-fopenacc" }
+
+! OpenACC 2.0 allows nested parallel/kernels regions
+! However, in middle-end there is check for nested parallel
+
+program test
+ implicit none
+
+ integer :: i
+
+ !$acc parallel
+ !$acc kernels
+ !$acc end kernels
+ !$acc end parallel
+
+ !$acc parallel
+ !$acc parallel ! { dg-error "may not be nested" }
+ !$acc end parallel
+ !$acc end parallel
+
+ !$acc parallel
+ !$acc parallel ! { dg-error "may not be nested" }
+ !$acc end parallel
+ !$acc kernels
+ !$acc end kernels
+ !$acc end parallel
+
+ !$acc kernels
+ !$acc kernels
+ !$acc end kernels
+ !$acc end kernels
+
+ !$acc kernels
+ !$acc parallel
+ !$acc end parallel
+ !$acc end kernels
+
+ !$acc kernels
+ !$acc parallel
+ !$acc end parallel
+ !$acc kernels
+ !$acc end kernels
+ !$acc end kernels
+
+ !$acc parallel
+ !$acc data
+ !$acc end data
+ !$acc end parallel
+
+ !$acc kernels
+ !$acc data
+ !$acc end data
+ !$acc end kernels
+
+end program test
\ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/goacc/parallel-tree.f95 b/gcc/testsuite/gfortran.dg/goacc/parallel-tree.f95
new file mode 100644
index 0000000..4941f66
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/parallel-tree.f95
@@ -0,0 +1,41 @@
+! { dg-do compile }
+! { dg-options "-fopenacc -fdump-tree-original" }
+
+! test for tree-dump-original and spaces-commas
+
+program test
+ implicit none
+ integer :: q, i, j, k, m, n, o, p, r, s, t, u, v, w
+ logical :: l
+
+ !$acc parallel if(l) async num_gangs(i) num_workers(i) vector_length(i) &
+ !$acc reduction(max:q), copy(i), copyin(j), copyout(k), create(m) &
+ !$acc present(o), pcopy(p), pcopyin(r), pcopyout(s), pcreate(t) &
+ !$acc deviceptr(u), private(v), firstprivate(w)
+ !$acc end parallel
+
+end program test
+! { dg-final { scan-tree-dump "pragma acc parallel" "original" } }
+
+! { dg-final { scan-tree-dump "if" "original" } }
+! { dg-final { scan-tree-dump "async" "original" } }
+! { dg-final { scan-tree-dump "num_gangs" "original" } }
+! { dg-final { scan-tree-dump "num_workers" "original" } }
+! { dg-final { scan-tree-dump "vector_length" "original" } }
+
+! { dg-final { scan-tree-dump "reduction" "original" } }
+! { dg-final { scan-tree-dump "copy" "original" } }
+! { dg-final { scan-tree-dump "copyin" "original" } }
+! { dg-final { scan-tree-dump "copyout" "original" } }
+! { dg-final { scan-tree-dump "create" "original" } }
+
+! { dg-final { scan-tree-dump "present" "original" } }
+! { dg-final { scan-tree-dump "present_or_copy" "original" } }
+! { dg-final { scan-tree-dump "present_or_copyin" "original" } }
+! { dg-final { scan-tree-dump "present_or_copyout" "original" } }
+! { dg-final { scan-tree-dump "present_or_create" "original" } }
+
+! { dg-final { scan-tree-dump "deviceptr" "original" } }
+! { dg-final { scan-tree-dump "private" "original" } }
+! { dg-final { scan-tree-dump "firstprivate" "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
diff --git a/gcc/testsuite/gfortran.dg/goacc/pure-elemental-procedures.f95 b/gcc/testsuite/gfortran.dg/goacc/pure-elemental-procedures.f95
new file mode 100644
index 0000000..18495b6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/pure-elemental-procedures.f95
@@ -0,0 +1,46 @@
+! { dg-do compile }
+! { dg-options "-fopenacc" }
+
+module test
+ implicit none
+contains
+ elemental subroutine test1
+ !$acc parallel ! { dg-error "may not appear in PURE or ELEMENTAL procedures" }
+ end subroutine test1
+
+ pure subroutine test2
+ !$acc parallel ! { dg-error "may not appear in PURE or ELEMENTAL procedures" }
+ end subroutine test2
+
+ elemental real function test3(x)
+ real, intent(in) :: x
+ !$acc parallel ! { dg-error "may not appear in PURE or ELEMENTAL procedures" }
+ test3 = x
+ end function test3
+
+ pure real function test4(x)
+ real, intent(in) :: x
+ !$acc parallel ! { dg-error "may not appear in PURE or ELEMENTAL procedures" }
+ test4 = x
+ end function test4
+
+ subroutine test5
+ real :: x = 0.0
+ integer :: i
+ !$acc parallel loop collapse(1) reduction(+:x)
+ do i = 1,10
+ x = x + 0.3
+ enddo
+ print *, x
+ end subroutine test5
+
+ real function test6(x)
+ real :: x
+ integer :: i
+ !$acc parallel loop collapse(1) reduction(+:x)
+ do i = 1,10
+ x = x + 0.3
+ enddo
+ test6 = x
+ end function test6
+end module test
\ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/goacc/reduction.f95 b/gcc/testsuite/gfortran.dg/goacc/reduction.f95
new file mode 100644
index 0000000..14d0d8d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/reduction.f95
@@ -0,0 +1,139 @@
+! { dg-do compile }
+! { dg-options "-fopenacc -fmax-errors=100" }
+
+subroutine foo (ia1)
+integer :: i1, i2, i3
+integer, dimension (*) :: ia1
+integer, dimension (10) :: ia2
+real :: r1
+real, dimension (5) :: ra1
+double precision :: d1
+double precision, dimension (4) :: da1
+complex :: c1
+complex, dimension (7) :: ca1
+logical :: l1
+logical, dimension (3) :: la1
+character (5) :: a1
+type t
+ integer :: i
+end type
+type(t) :: t1
+type(t), dimension (2) :: ta1
+real, pointer :: p1 => NULL()
+integer, allocatable :: aa1 (:,:)
+save i2
+common /blk/ i1
+
+!$acc parallel reduction (+:ia2) ! { dg-error "SCALAR variable" }
+!$acc end parallel
+!$acc parallel reduction (+:ra1) ! { dg-error "SCALAR variable" }
+!$acc end parallel
+!$acc parallel reduction (+:ca1) ! { dg-error "SCALAR variable" }
+!$acc end parallel
+!$acc parallel reduction (+:da1) ! { dg-error "SCALAR variable" }
+!$acc end parallel
+!$acc parallel reduction (.and.:la1) ! { dg-error "SCALAR variable" }
+!$acc end parallel
+!$acc parallel reduction (+:i3, r1, d1, c1)
+!$acc end parallel
+!$acc parallel reduction (*:i3, r1, d1, c1)
+!$acc end parallel
+!$acc parallel reduction (-:i3, r1, d1, c1)
+!$acc end parallel
+!$acc parallel reduction (.and.:l1)
+!$acc end parallel
+!$acc parallel reduction (.or.:l1)
+!$acc end parallel
+!$acc parallel reduction (.eqv.:l1)
+!$acc end parallel
+!$acc parallel reduction (.neqv.:l1)
+!$acc end parallel
+!$acc parallel reduction (min:i3, r1, d1)
+!$acc end parallel
+!$acc parallel reduction (max:i3, r1, d1)
+!$acc end parallel
+!$acc parallel reduction (iand:i3)
+!$acc end parallel
+!$acc parallel reduction (ior:i3)
+!$acc end parallel
+!$acc parallel reduction (ieor:i3)
+!$acc end parallel
+!$acc parallel reduction (+:/blk/) ! { dg-error "Syntax error" }
+!$acc end parallel ! { dg-error "Unexpected" }
+!$acc parallel reduction (*:p1) ! { dg-error "POINTER object" }
+!$acc end parallel
+!$acc parallel reduction (-:aa1) ! { dg-error "SCALAR variable" }
+!$acc end parallel
+!$acc parallel reduction (*:ia1) ! { dg-error "Assumed size" }
+!$acc end parallel
+!$acc parallel reduction (+:l1) ! { dg-error "must be of numeric type, got LOGICAL" }
+!$acc end parallel
+!$acc parallel reduction (*:la1) ! { dg-error "must be of numeric type, got LOGICAL" }
+!$acc end parallel
+!$acc parallel reduction (-:a1) ! { dg-error "must be of numeric type, got CHARACTER" }
+!$acc end parallel
+!$acc parallel reduction (+:t1) ! { dg-error "must be of numeric type, got TYPE" }
+!$acc end parallel
+!$acc parallel reduction (*:ta1) ! { dg-error "must be of numeric type, got TYPE" }
+!$acc end parallel
+!$acc parallel reduction (.and.:i3) ! { dg-error "must be LOGICAL" }
+!$acc end parallel
+!$acc parallel reduction (.or.:ia2) ! { dg-error "must be LOGICAL" }
+!$acc end parallel
+!$acc parallel reduction (.eqv.:r1) ! { dg-error "must be LOGICAL" }
+!$acc end parallel
+!$acc parallel reduction (.neqv.:ra1) ! { dg-error "must be LOGICAL" }
+!$acc end parallel
+!$acc parallel reduction (.and.:d1) ! { dg-error "must be LOGICAL" }
+!$acc end parallel
+!$acc parallel reduction (.or.:da1) ! { dg-error "must be LOGICAL" }
+!$acc end parallel
+!$acc parallel reduction (.eqv.:c1) ! { dg-error "must be LOGICAL" }
+!$acc end parallel
+!$acc parallel reduction (.neqv.:ca1) ! { dg-error "must be LOGICAL" }
+!$acc end parallel
+!$acc parallel reduction (.and.:a1) ! { dg-error "must be LOGICAL" }
+!$acc end parallel
+!$acc parallel reduction (.or.:t1) ! { dg-error "must be LOGICAL" }
+!$acc end parallel
+!$acc parallel reduction (.eqv.:ta1) ! { dg-error "must be LOGICAL" }
+!$acc end parallel
+!$acc parallel reduction (min:c1) ! { dg-error "must be INTEGER or REAL" }
+!$acc end parallel
+!$acc parallel reduction (max:ca1) ! { dg-error "must be INTEGER or REAL" }
+!$acc end parallel
+!$acc parallel reduction (max:l1) ! { dg-error "must be INTEGER or REAL" }
+!$acc end parallel
+!$acc parallel reduction (min:la1) ! { dg-error "must be INTEGER or REAL" }
+!$acc end parallel
+!$acc parallel reduction (max:a1) ! { dg-error "must be INTEGER or REAL" }
+!$acc end parallel
+!$acc parallel reduction (min:t1) ! { dg-error "must be INTEGER or REAL" }
+!$acc end parallel
+!$acc parallel reduction (max:ta1) ! { dg-error "must be INTEGER or REAL" }
+!$acc end parallel
+!$acc parallel reduction (iand:r1) ! { dg-error "must be INTEGER" }
+!$acc end parallel
+!$acc parallel reduction (ior:ra1) ! { dg-error "must be INTEGER" }
+!$acc end parallel
+!$acc parallel reduction (ieor:d1) ! { dg-error "must be INTEGER" }
+!$acc end parallel
+!$acc parallel reduction (ior:da1) ! { dg-error "must be INTEGER" }
+!$acc end parallel
+!$acc parallel reduction (iand:c1) ! { dg-error "must be INTEGER" }
+!$acc end parallel
+!$acc parallel reduction (ior:ca1) ! { dg-error "must be INTEGER" }
+!$acc end parallel
+!$acc parallel reduction (ieor:l1) ! { dg-error "must be INTEGER" }
+!$acc end parallel
+!$acc parallel reduction (iand:la1) ! { dg-error "must be INTEGER" }
+!$acc end parallel
+!$acc parallel reduction (ior:a1) ! { dg-error "must be INTEGER" }
+!$acc end parallel
+!$acc parallel reduction (ieor:t1) ! { dg-error "must be INTEGER" }
+!$acc end parallel
+!$acc parallel reduction (iand:ta1) ! { dg-error "must be INTEGER" }
+!$acc end parallel
+
+end subroutine
+! { dg-excess-errors "SCALAR variable" }
\ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/goacc/sentinel-free-form.f95 b/gcc/testsuite/gfortran.dg/goacc/sentinel-free-form.f95
new file mode 100644
index 0000000..04c67d5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/sentinel-free-form.f95
@@ -0,0 +1,22 @@
+! { dg-do compile }
+! { dg-options "-fopenacc" }
+
+program test
+ implicit none
+
+ integer :: i
+ real :: x
+
+ ! sentinel may only be preceeded by white space
+ x = 0.0 !$acc parallel ! comment
+ ! sentinel must appear as a single word
+ ! $acc parallel ! comment
+ !$ acc parallel ! { dg-error "Unclassifiable statement" }
+ ! directive lines must have space after sentinel
+ !$accparallel ! { dg-warning "followed by a space" }
+ do i = 1,10
+ x = x + 0.3
+ enddo
+ !$acc end parallel ! { dg-error "Unexpected" }
+ print *, x
+end
\ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/goacc/several-directives.f95 b/gcc/testsuite/gfortran.dg/goacc/several-directives.f95
new file mode 100644
index 0000000..7e1d0f9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/several-directives.f95
@@ -0,0 +1,7 @@
+! { dg-do compile }
+! { dg-options "-fopenacc" }
+
+program test
+ ! only one directive-name may appear in directive
+ !$acc parallel kernels ! { dg-error "Unclassifiable OpenACC directive" }
+end
\ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/goacc/sie.f95 b/gcc/testsuite/gfortran.dg/goacc/sie.f95
new file mode 100644
index 0000000..e49c387
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/sie.f95
@@ -0,0 +1,252 @@
+! { dg-do compile }
+! { dg-options "-fopenacc -fmax-errors=100" }
+
+! tests async, num_gangs, num_workers, vector_length, gang, worker, vector clauses
+
+program test
+ implicit none
+
+ integer :: i
+
+ !$acc parallel async
+ !$acc end parallel
+
+ !$acc parallel async(3)
+ !$acc end parallel
+
+ !$acc parallel async(i)
+ !$acc end parallel
+
+ !$acc parallel async(i+1)
+ !$acc end parallel
+
+ !$acc parallel async(-1)
+ !$acc end parallel
+
+ !$acc parallel async(0)
+ !$acc end parallel
+
+ !$acc parallel async() ! { dg-error "Invalid character in name" }
+
+ !$acc parallel async(1.5) ! { dg-error "scalar INTEGER expression" }
+ !$acc end parallel
+
+ !$acc parallel async(.true.) ! { dg-error "scalar INTEGER expression" }
+ !$acc end parallel
+
+ !$acc parallel async("1") ! { dg-error "scalar INTEGER expression" }
+ !$acc end parallel
+
+ !$acc kernels async
+ !$acc end kernels
+
+ !$acc kernels async(3)
+ !$acc end kernels
+
+ !$acc kernels async(i)
+ !$acc end kernels
+
+ !$acc kernels async(i+1)
+ !$acc end kernels
+
+ !$acc kernels async(-1)
+ !$acc end kernels
+
+ !$acc kernels async(0)
+ !$acc end kernels
+
+ !$acc kernels async() ! { dg-error "Invalid character in name" }
+
+ !$acc kernels async(1.5) ! { dg-error "scalar INTEGER expression" }
+ !$acc end kernels
+
+ !$acc kernels async(.true.) ! { dg-error "scalar INTEGER expression" }
+ !$acc end kernels
+
+ !$acc kernels async("1") ! { dg-error "scalar INTEGER expression" }
+ !$acc end kernels
+
+
+ !$acc parallel num_gangs ! { dg-error "Unclassifiable OpenACC directive" }
+
+ !$acc parallel num_gangs(3)
+ !$acc end parallel
+
+ !$acc parallel num_gangs(i)
+ !$acc end parallel
+
+ !$acc parallel num_gangs(i+1)
+ !$acc end parallel
+
+ !$acc parallel num_gangs(-1) ! { dg-warning "must be positive" }
+ !$acc end parallel
+
+ !$acc parallel num_gangs(0) ! { dg-warning "must be positive" }
+ !$acc end parallel
+
+ !$acc parallel num_gangs() ! { dg-error "Invalid character in name" }
+
+ !$acc parallel num_gangs(1.5) ! { dg-error "scalar INTEGER expression" }
+ !$acc end parallel
+
+ !$acc parallel num_gangs(.true.) ! { dg-error "scalar INTEGER expression" }
+ !$acc end parallel
+
+ !$acc parallel num_gangs("1") ! { dg-error "scalar INTEGER expression" }
+ !$acc end parallel
+
+
+ !$acc parallel num_workers ! { dg-error "Unclassifiable OpenACC directive" }
+
+ !$acc parallel num_workers(3)
+ !$acc end parallel
+
+ !$acc parallel num_workers(i)
+ !$acc end parallel
+
+ !$acc parallel num_workers(i+1)
+ !$acc end parallel
+
+ !$acc parallel num_workers(-1) ! { dg-warning "must be positive" }
+ !$acc end parallel
+
+ !$acc parallel num_workers(0) ! { dg-warning "must be positive" }
+ !$acc end parallel
+
+ !$acc parallel num_workers() ! { dg-error "Invalid character in name" }
+
+ !$acc parallel num_workers(1.5) ! { dg-error "scalar INTEGER expression" }
+ !$acc end parallel
+
+ !$acc parallel num_workers(.true.) ! { dg-error "scalar INTEGER expression" }
+ !$acc end parallel
+
+ !$acc parallel num_workers("1") ! { dg-error "scalar INTEGER expression" }
+ !$acc end parallel
+
+
+ !$acc parallel vector_length ! { dg-error "Unclassifiable OpenACC directive" }
+
+ !$acc parallel vector_length(3)
+ !$acc end parallel
+
+ !$acc parallel vector_length(i)
+ !$acc end parallel
+
+ !$acc parallel vector_length(i+1)
+ !$acc end parallel
+
+ !$acc parallel vector_length(-1) ! { dg-warning "must be positive" }
+ !$acc end parallel
+
+ !$acc parallel vector_length(0) ! { dg-warning "must be positive" }
+ !$acc end parallel
+
+ !$acc parallel vector_length() ! { dg-error "Invalid character in name" }
+
+ !$acc parallel vector_length(1.5) ! { dg-error "scalar INTEGER expression" }
+ !$acc end parallel
+
+ !$acc parallel vector_length(.true.) ! { dg-error "scalar INTEGER expression" }
+ !$acc end parallel
+
+ !$acc parallel vector_length("1") ! { dg-error "scalar INTEGER expression" }
+ !$acc end parallel
+
+
+ !$acc loop gang
+ do i = 1,10
+ enddo
+ !$acc loop gang(3)
+ do i = 1,10
+ enddo
+ !$acc loop gang(i)
+ do i = 1,10
+ enddo
+ !$acc loop gang(i+1)
+ do i = 1,10
+ enddo
+ !$acc loop gang(-1) ! { dg-warning "must be positive" }
+ do i = 1,10
+ enddo
+ !$acc loop gang(0) ! { dg-warning "must be positive" }
+ do i = 1,10
+ enddo
+ !$acc loop gang() ! { dg-error "Invalid character in name" }
+ do i = 1,10
+ enddo
+ !$acc loop gang(1.5) ! { dg-error "scalar INTEGER expression" }
+ do i = 1,10
+ enddo
+ !$acc loop gang(.true.) ! { dg-error "scalar INTEGER expression" }
+ do i = 1,10
+ enddo
+ !$acc loop gang("1") ! { dg-error "scalar INTEGER expression" }
+ do i = 1,10
+ enddo
+
+
+ !$acc loop worker
+ do i = 1,10
+ enddo
+ !$acc loop worker(3)
+ do i = 1,10
+ enddo
+ !$acc loop worker(i)
+ do i = 1,10
+ enddo
+ !$acc loop worker(i+1)
+ do i = 1,10
+ enddo
+ !$acc loop worker(-1) ! { dg-warning "must be positive" }
+ do i = 1,10
+ enddo
+ !$acc loop worker(0) ! { dg-warning "must be positive" }
+ do i = 1,10
+ enddo
+ !$acc loop worker() ! { dg-error "Invalid character in name" }
+ do i = 1,10
+ enddo
+ !$acc loop worker(1.5) ! { dg-error "scalar INTEGER expression" }
+ do i = 1,10
+ enddo
+ !$acc loop worker(.true.) ! { dg-error "scalar INTEGER expression" }
+ do i = 1,10
+ enddo
+ !$acc loop worker("1") ! { dg-error "scalar INTEGER expression" }
+ do i = 1,10
+ enddo
+
+
+ !$acc loop vector
+ do i = 1,10
+ enddo
+ !$acc loop vector(3)
+ do i = 1,10
+ enddo
+ !$acc loop vector(i)
+ do i = 1,10
+ enddo
+ !$acc loop vector(i+1)
+ do i = 1,10
+ enddo
+ !$acc loop vector(-1) ! { dg-warning "must be positive" }
+ do i = 1,10
+ enddo
+ !$acc loop vector(0) ! { dg-warning "must be positive" }
+ do i = 1,10
+ enddo
+ !$acc loop vector() ! { dg-error "Invalid character in name" }
+ do i = 1,10
+ enddo
+ !$acc loop vector(1.5) ! { dg-error "scalar INTEGER expression" }
+ do i = 1,10
+ enddo
+ !$acc loop vector(.true.) ! { dg-error "scalar INTEGER expression" }
+ do i = 1,10
+ enddo
+ !$acc loop vector("1") ! { dg-error "scalar INTEGER expression" }
+ do i = 1,10
+ enddo
+
+end program test
\ No newline at end of file
--
1.8.3.2
^ permalink raw reply [flat|nested] 89+ messages in thread
* [PATCH 6/6] [GOMP4] OpenACC 1.0+ support in fortran front-end
2014-01-23 18:05 ` [PATCH 5/6] " Ilmir Usmanov
@ 2014-01-23 18:06 ` Ilmir Usmanov
2014-01-23 18:09 ` [PATCH 7/6] " Ilmir Usmanov
0 siblings, 1 reply; 89+ messages in thread
From: Ilmir Usmanov @ 2014-01-23 18:06 UTC (permalink / raw)
To: gcc-patches, Thomas Schwinge, jakub
Cc: Evgeny Gavrin, GarbuzovViacheslav, Dmitri Botcharnikov
[-- Attachment #1: Type: text/plain, Size: 1 bytes --]
[-- Attachment #2: 0006-OpenACC-GENERIC-docs.patch --]
[-- Type: text/x-diff, Size: 1789 bytes --]
From 668a50443d0a70a633707ec49759d9e8b6d00b1e Mon Sep 17 00:00:00 2001
From: Ilmir Usmanov <i.usmanov@samsung.com>
Date: Thu, 23 Jan 2014 21:26:50 +0400
Subject: [PATCH 6/6] OpenACC GENERIC docs
---
gcc/doc/generic.texi | 40 ++++++++++++++++++++++++++++++++++++++++
1 file changed, 40 insertions(+)
diff --git a/gcc/doc/generic.texi b/gcc/doc/generic.texi
index d51033e..dd88489 100644
--- a/gcc/doc/generic.texi
+++ b/gcc/doc/generic.texi
@@ -2052,6 +2052,14 @@ edge. Rethrowing the exception is represented using @code{RESX_EXPR}.
@node OpenMP
@subsection OpenMP
@tindex OACC_PARALLEL
+@tindex OACC_KERNELS
+@tindex OACC_DATA
+@tindex OACC_HOST_DATA
+@tindex OACC_UPDATE
+@tindex OACC_ENTER_DATA
+@tindex OACC_EXIT_DATA
+@tindex OACC_WAIT
+@tindex OACC_CACHE
@tindex OMP_PARALLEL
@tindex OMP_FOR
@tindex OMP_SECTIONS
@@ -2073,6 +2081,38 @@ clauses used by the OpenMP API @w{@uref{http://www.openmp.org/}}.
Represents @code{#pragma acc parallel [clause1 @dots{} clauseN]}.
+@item OACC_KERNELS
+
+Represents @code{#pragma acc kernels [clause1 @dots{} clauseN]}.
+
+@item OACC_DATA
+
+Represents @code{#pragma acc data [clause1 @dots{} clauseN]}.
+
+@item OACC_HOST_DATA
+
+Represents @code{#pragma acc host_data [clause1 @dots{} clauseN]}.
+
+@item OACC_UPDATE
+
+Represents @code{#pragma acc update [clause1 @dots{} clauseN]}.
+
+@item OACC_ENTER_DATA
+
+Represents @code{#pragma acc enter data [clause1 @dots{} clauseN]}.
+
+@item OACC_EXIT_DATA
+
+Represents @code{#pragma acc exit data [clause1 @dots{} clauseN]}.
+
+@item OACC_WAIT
+
+Represents @code{#pragma acc wait [(num @dots{})]}.
+
+@item OACC_CACHE
+
+Represents @code{#pragma acc cache (var @dots{})}.
+
@item OMP_PARALLEL
Represents @code{#pragma omp parallel [clause1 @dots{} clauseN]}. It
--
1.8.3.2
^ permalink raw reply [flat|nested] 89+ messages in thread
* [PATCH 7/6] [GOMP4] OpenACC 1.0+ support in fortran front-end
2014-01-23 18:06 ` [PATCH 6/6] " Ilmir Usmanov
@ 2014-01-23 18:09 ` Ilmir Usmanov
0 siblings, 0 replies; 89+ messages in thread
From: Ilmir Usmanov @ 2014-01-23 18:09 UTC (permalink / raw)
To: gcc-patches, Thomas Schwinge, jakub
Cc: Evgeny Gavrin, GarbuzovViacheslav, Dmitri Botcharnikov
[-- Attachment #1: Type: text/plain, Size: 28 bytes --]
Finally, ChangeLog entry.
[-- Attachment #2: ChangeLog --]
[-- Type: text/plain, Size: 10906 bytes --]
23-01-2014 Ilmir Usmanov <i.usmanov@samsung.com>
Add OpenACC 1.0 support to fortran FE and GENERIC, except loop directive
and subarrays.
gcc/fortran/
* decl.c (gfc_match_end): Match end of OpenACC region.
* dump-parse-tree.c
(show_oacc_node): New function to dump OpenACC executable statements.
(show_code_node): Call it.
* gfortran.h
(ST_OACC_PARALLEL_LOOP, ST_OACC_END_PARALLEL_LOOP, ST_OACC_PARALLEL,
ST_OACC_END_PARALLEL, ST_OACC_KERNELS, ST_OACC_END_KERNELS,
ST_OACC_DATA, ST_OACC_END_DATA, ST_OACC_HOST_DATA,
ST_OACC_END_HOST_DATA, ST_OACC_LOOP, ST_OACC_DECLARE, ST_OACC_UPDATE,
ST_OACC_WAIT, ST_OACC_CACHE, ST_OACC_KERNELS_LOOP,
ST_OACC_END_KERNELS_LOOP, ST_OACC_ENTER_DATA,
ST_OACC_EXIT_DATA): New statements.
(gfc_exprlist): New structure to hold list of expressions.
(OACC_LIST_PRIVATE, OACC_LIST_REDUCTION_FIRST, OACC_LIST_REDUCTION_LAST,
OACC_LIST_COPY, OACC_LIST_FIRST, OACC_LIST_DATA_CLAUSE_FIRST,
OACC_LIST_COPYIN, OACC_LIST_COPYOUT, OACC_LIST_CREATE, OACC_LIST_DELETE,
OACC_LIST_PRESENT, OACC_LIST_PRESENT_OR_COPY,
OACC_LIST_PRESENT_OR_COPYIN, OACC_LIST_PRESENT_OR_COPYOUT,
OACC_LIST_PRESENT_OR_CREATE, OACC_LIST_DEVICEPTR,
OACC_LIST_DATA_CLAUSE_LAST, OACC_LIST_USE_DEVICE,
OACC_LIST_DEVICE_RESIDENT, OACC_LIST_HOST, OACC_LIST_DEVICE,
OACC_LIST_CACHE, OACC_LIST_NUM): New types of list, allowed in clauses.
(gfc_omp_clauses): Add OpenACC clauses.
(gfc_oacc_clauses): Pseudo structure.
(gfc_get_oacc_clauses): New function.
(gfc_namespace): Add OpenACC declare directive clauses.
(EXEC_OACC_KERNELS_LOOP, EXEC_OACC_PARALLEL_LOOP, 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): New executable statements.
(gfc_free_exprlist): New function declaration.
(gfc_resolve_oacc_directive): Likewise.
(gfc_resolve_oacc_parallel_loop_blocks): Likewise.
(gfc_resolve_oacc_blocks): Likewise.
* match.c (match_exit_cycle): Add support of OpenACC regions and loops.
* match.h (gfc_match_oacc_cache): New function declaration.
(gfc_match_oacc_wait, gfc_match_oacc_update): Likewise.
(gfc_match_oacc_declare, gfc_match_oacc_loop): Likewise.
(gfc_match_oacc_host_data, gfc_match_oacc_data): Likewise.
(gfc_match_oacc_kernels, gfc_match_oacc_kernels_loop): Likewise.
(gfc_match_oacc_parallel, gfc_match_oacc_parallel_loop): Likewise.
(gfc_match_oacc_enter_data, gfc_match_oacc_exit_data): Likewise.
* parse.c (decode_oacc_directive): New function.
(verify_token_free, verify_token_fixed): New helper functions.
(next_free, next_fixed): Decode !$ACC sentinel.
(case_executable): Add ST_OACC_UPDATE, ST_OACC_WAIT, ST_OACC_CACHE,
ST_OACC_ENTER_DATA and ST_OACC_EXIT_DATA directives.
(case_exec_markers): Add ST_OACC_PARALLEL_LOOP, ST_OACC_PARALLEL,
ST_OACC_KERNELS, ST_OACC_DATA, ST_OACC_HOST_DATA, ST_OACC_LOOP and
ST_OACC_KERNELS_LOOP directives.
(push_state): Initialize OpenACC declare clauses.
(gfc_ascii_statement): Dump names of OpenACC directives.
(verify_st_order): Verify OpenACC declare directive as declarative.
(parse_spec): Push clauses to state stack when declare directive is
parsed.
(parse_oacc_structured_block, parse_oacc_loop): New functions.
(parse_executable): Call them.
(parse_progunit): Move declare clauses from state stack to namespace.
* parse.h
(COMP_OACC_STRUCTURED_BLOCK): New structured block to represent OpenACC
region.
(gfc_state_data): Add declare directive's clauses.
* resolve.c (gfc_resolve_blocks): Resolve OpenACC directives.
(resolve_code): Likewise.
* scanner.c (openacc_flag, openacc_locus): New static variables.
(skip_oacc_attribute, skip_omp_attribute): New helper functions.
(skip_free_comments, skip_fixed_comments): Don't skip !$ACC sentinel.
(gfc_next_char_literal): Support OpenACC directives.
* st.c (gfc_free_statement): Free also OpenACC directives.
* openmp.c (gfc_free_omp_clauses): Remove also OpenACC clauses.
(gfc_free_exprlist): New function to clear expression list.
(match_oacc_exprlist): New function to match expression list.
(match_oacc_clause_gang): New function to match OpenACC 2.0 gang clauses.
(OACC_CLAUSE_IF, OACC_CLAUSE_ASYNC, OACC_CLAUSE_NUM_GANGS,
OACC_CLAUSE_NUM_WORKERS, OACC_CLAUSE_VECTOR_LENGTH,
OACC_CLAUSE_REDUCTION, OACC_CLAUSE_COPY, OACC_CLAUSE_COPYIN,
OACC_CLAUSE_COPYOUT, OACC_CLAUSE_CREATE, OACC_CLAUSE_PRESENT,
OACC_CLAUSE_PRESENT_OR_COPY, OACC_CLAUSE_PRESENT_OR_COPYIN,
OACC_CLAUSE_PRESENT_OR_COPYOUT, OACC_CLAUSE_PRESENT_OR_CREATE,
OACC_CLAUSE_DEVICEPTR, OACC_CLAUSE_PRIVATE, OACC_CLAUSE_FIRSTPRIVATE,
OACC_CLAUSE_COLLAPSE, OACC_CLAUSE_GANG, OACC_CLAUSE_WORKER,
OACC_CLAUSE_VECTOR, OACC_CLAUSE_SEQ, OACC_CLAUSE_INDEPENDENT,
OACC_CLAUSE_USE_DEVICE, OACC_CLAUSE_HOST, OACC_CLAUSE_DEVICE_RESIDENT,
OACC_CLAUSE_DEVICE, OACC_CLAUSE_DEFAULT, OACC_CLAUSE_WAIT,
OACC_CLAUSE_DELETE, OACC_CLAUSE_AUTO, OACC_CLAUSE_TILE): New clauses.
(OACC_PARALLEL_CLAUSES, OACC_KERNELS_CLAUSES, OACC_DATA_CLAUSES,
OACC_LOOP_CLAUSES, OACC_PARALLEL_LOOP_CLAUSES,
OACC_KERNELS_LOOP_CLAUSES, OACC_HOST_DATA_CLAUSES, OACC_DECLARE_CLAUSES,
OACC_UPDATE_CLAUSES, OACC_ENTER_DATA_CLAUSES,
OACC_EXIT_DATA_CLAUSES): New defines.
(gfc_match_oacc_parallel_loop): New matcher function.
(gfc_match_oacc_parallel, gfc_match_oacc_kernels_loop): Likewise.
(gfc_match_oacc_kernels, gfc_match_oacc_data): Likewise.
(gfc_match_oacc_host_data, gfc_match_oacc_loop): Likewise.
(gfc_match_oacc_declare, gfc_match_oacc_update): Likewise.
(gfc_match_oacc_enter_data, gfc_match_oacc_exit_data): Likewise.
(gfc_match_oacc_wait, gfc_match_oacc_cache): Likewise.
(gfc_match_omp_clauses): Match also OpenACC clauses. Add parameter.
(gfc_match_omp_parallel): Update.
(gfc_match_omp_task, gfc_match_omp_do): Likewise.
(gfc_match_omp_parallel_do, gfc_match_omp_parallel_sections): Likewise.
(gfc_match_omp_parallel_workshare, gfc_match_omp_sections): Likewise.
(gfc_match_omp_single, gfc_match_omp_end_single): Likewise.
(resolve_oacc_scalar_int_expr): New function.
(resolve_oacc_positive_int_expr): Likewise.
(resolve_omp_clauses): Resolve also OpenACC clauses.
(oacc_is_parallel): New helper function.
(oacc_is_kernels, oacc_is_loop): Likewise.
(resolve_oacc_nested_loops): New resolve function.
(resolve_oacc_params_in_parallel, resolve_oacc_loop_blocks): Likewise.
(gfc_resolve_oacc_blocks, resolve_oacc_loop): Likewise.
(resolve_oacc_cache, resolve_oacc_wait): Likewise.
(gfc_resolve_oacc_directive): Likewise.
* trans-decl.c
(gfc_generate_function_code): Insert OACC_DECLARE GENERIC node.
* trans-openmp.c (gfc_trans_oacc_add_clause): New helper function.
(gfc_trans_oacc_variable, gfc_convert_oacc_expr_to_tree): Likewise.
(gfc_trans_oacc_variable_list, gfc_trans_oacc_code): Likewise.
(gfc_trans_omp_array_reduction): Support also OpenACC. Add parameter.
(gfc_trans_omp_reduction_list): Update.
(gfc_trans_oacc_reduction_list): New transform function.
(gfc_trans_oacc_construct): Likewise.
(gfc_trans_oacc_executable_directive): Likewise.
(gfc_trans_oacc_combined_directive, gfc_trans_oacc_declare): Likewise.
(gfc_trans_oacc_directive): Use them.
(gfc_trans_oacc_loop): Stub.
(gfc_trans_oacc_clauses): Transform OpenACC clauses.
(gfc_trans_omp_clauses): Use it.
* trans-stmt.h (gfc_trans_oacc_directive): New function prototype.
(gfc_trans_oacc_declare): Likewise.
* trans.c (trans_code): Transform also OpenACC directives.
gcc/
* gimplify.c (is_gimple_stmt): Stub OpenACC directives and clauses.
(gimplify_scan_omp_clauses, gimplify_adjust_omp_clauses): Likewise.
(gimplify_expr): Likewise.
* omp-low.c (scan_sharing_clauses): Likewise.
* tree-core.h
(OACC_CLAUSE_IF, OACC_CLAUSE_ASYNC, OACC_CLAUSE_NUM_GANGS,
OACC_CLAUSE_NUM_WORKERS, OACC_CLAUSE_VECTOR_LENGTH,
OACC_CLAUSE_REDUCTION, OACC_CLAUSE_COPY, OACC_CLAUSE_COPYIN,
OACC_CLAUSE_COPYOUT, OACC_CLAUSE_CREATE, OACC_CLAUSE_PRESENT,
OACC_CLAUSE_PRESENT_OR_COPY, OACC_CLAUSE_PRESENT_OR_COPYIN,
OACC_CLAUSE_PRESENT_OR_COPYOUT, OACC_CLAUSE_PRESENT_OR_CREATE,
OACC_CLAUSE_DEVICEPTR, OACC_CLAUSE_PRIVATE, OACC_CLAUSE_FIRSTPRIVATE,
OACC_CLAUSE_COLLAPSE, OACC_CLAUSE_GANG, OACC_CLAUSE_WORKER,
OACC_CLAUSE_VECTOR, OACC_CLAUSE_SEQ, OACC_CLAUSE_INDEPENDENT,
OACC_CLAUSE_USE_DEVICE, OACC_CLAUSE_HOST, OACC_CLAUSE_DEVICE_RESIDENT,
OACC_CLAUSE_DEVICE, OACC_CLAUSE_DEFAULT, OACC_CLAUSE_WAIT,
OACC_CLAUSE_DELETE): New clauses.
* tree-pretty-print.c (dump_oacc_body): Print OpenACC region.
(dump_oacc_clause_remap): New helper function.
(dump_oacc_clause): Print OpenACC clause.
(dump_oacc_clauses): Print OpenACC clauses.
(dump_generic_node): Print OpenACC directives and its clauses.
* tree-pretty-print.h: (dump_oacc_body): New function prototype.
(dump_oacc_clause_remap, dump_oacc_clause, dump_oacc_clauses): Likewise.
* tree.c (tree_node_kind_names): New name.
(omp_clause_num_ops): Add OpenACC clauses.
(omp_clause_code_name): Likewise.
(walk_tree_1): Likewise.
* tree.def (OACC_KERNELS): New tree node.
(OACC_DATA, OACC_HOST_DATA, OACC_DECLARE, OACC_UPDATE): Likewise.
(OACC_ENTER_DATA, OACC_EXIT_DATA, OACC_WAIT, OACC_CACHE): Likewise.
* tree.h (OACC_BODY): New macros.
(OACC_CLAUSE_CHAIN, OACC_CLAUSE, OACC_CLAUSE_DECL, OACC_CLAUSE_CODE,
OACC_CLAUSE_OPERAND, OACC_CLAUSE_SET_CODE, OACC_CLAUSE_LOCATION,
OACC_PARALLEL_BODY, OACC_PARALLEL_CLAUSES, OACC_KERNELS_BODY,
OACC_KERNELS_CLAUSES, OACC_CLAUSE_NUM_GANGS_EXPR,
OACC_CLAUSE_NUM_WORKERS_EXPR, OACC_CLAUSE_VECTOR_LENGTH_EXPR,
OACC_CLAUSE_VECTOR_EXPR, OACC_CLAUSE_WORKER_EXPR, OACC_CLAUSE_GANG_EXPR,
OACC_CLAUSE_COLLAPSE_EXPR, OACC_CLAUSE_IF_EXPR, OACC_CLAUSE_ASYNC_EXPR,
OACC_WAIT_EXPR, OACC_DATA_BODY, OACC_DATA_CLAUSES, OACC_DECLARE_CLAUSES,
OACC_UPDATE_CLAUSES, OACC_WAIT_CLAUSES, OACC_CACHE_CLAUSES,
OACC_HOST_DATA_BODY, OACC_HOST_DATA_CLAUSES, OACC_CLAUSE_REDUCTION_CODE,
OACC_CLAUSE_REDUCTION_INIT, OACC_CLAUSE_REDUCTION_MERGE,
OACC_CLAUSE_REDUCTION_PLACEHOLDER): Likewise.
(build_oacc_clause): New helper function.
gcc/testsuite/gfortran.dg/goacc/
* goacc.exp: New test directory.
* branch.f95: New test.
* continuation-free-form.f95: Likewise.
* data-clauses.f95: Likewise.
* data-tree.f95: Likewise.
* declare-1.f95: Likewise.
* declare.f95: Likewise.
* directive-names.f95: Likewise.
* enter-exit-data.f95: Likewise.
* host_data-tree.f95: Likewise.
* if.f95: Likewise.
* kernels-tree.f95: Likewise.
* list.f95: Likewise.
* parallel-kernels-clauses.f95: Likewise.
* parallel-kernels-regions.f95: Likewise.
* parallel-tree.f95: Likewise.
* pure-elemental-procedures.f95: Likewise.
* reduction.f95: Likewise.
* sentinel-free-form.f95: Likewise.
* several-directives.f95: Likewise.
* sie.f95: Likewise.
gcc/doc/
* generic.texi: Document OACC_KERNELS, OACC_DATA, OACC_HOST_DATA,
OACC_DECLARE, OACC_UPDATE, OACC_ENTER_DATA, OACC_EXIT_DATA, OACC_WAIT,
OACC_CACHE.
^ permalink raw reply [flat|nested] 89+ messages in thread
* Re: [PATCH] [GOMP4] OpenACC 1.0+ support in fortran front-end
2014-01-23 18:01 [PATCH] [GOMP4] OpenACC 1.0+ support in fortran front-end Ilmir Usmanov
2014-01-23 18:03 ` [PATCH 1/6] " Ilmir Usmanov
@ 2014-01-24 18:04 ` Thomas Schwinge
2014-01-27 13:12 ` Ilmir Usmanov
1 sibling, 1 reply; 89+ messages in thread
From: Thomas Schwinge @ 2014-01-24 18:04 UTC (permalink / raw)
To: Ilmir Usmanov
Cc: Evgeny Gavrin, GarbuzovViacheslav, Dmitri Botcharnikov,
gcc-patches, jakub
[-- Attachment #1: Type: text/plain, Size: 1094 bytes --]
Hi!
On Thu, 23 Jan 2014 22:01:19 +0400, Ilmir Usmanov <i.usmanov@samsung.com> wrote:
> Jakub, could you review these patches, if they are OK to gomp-4_0-branch?
>
> Thomas, please, have a look whether this implementation applies current
> OpenACC support style.
So, in context of
<http://news.gmane.org/find-root.php?message_id=%3C87a9elqolz.fsf%40schwinge.name%3E>,
I'll give a try with reviewing the patches you sent. But, don't hold
your breath -- it's late on a Friday evening already (and even later in
your timezone). ;-)
> These patches port OpenACC 1.0 support in fortran front-end from
> openacc-1_0-branch to gomp-4_0-branch. In addition, they extend
> middle-end infrastructure with necessary GENERIC nodes.
Again, many thanks for porting these patches! That will definitely help
in synchronizing and then parallelizing our development work.
> Patches support almost all directives (except loop) and all clauses from
> the specification ver. 1.0 (without subarrays). [...]
That is totally fine; incremental development.
Grüße,
Thomas
[-- Attachment #2: Type: application/pgp-signature, Size: 489 bytes --]
^ permalink raw reply [flat|nested] 89+ messages in thread
* Re: [PATCH 4/6] [GOMP4] OpenACC 1.0+ support in fortran front-end
2014-01-23 18:05 ` [PATCH 4/6] " Ilmir Usmanov
2014-01-23 18:05 ` [PATCH 5/6] " Ilmir Usmanov
@ 2014-01-24 19:33 ` Thomas Schwinge
2014-11-05 16:29 ` [gomp4] OpenACC cache directive for C Thomas Schwinge
1 sibling, 1 reply; 89+ messages in thread
From: Thomas Schwinge @ 2014-01-24 19:33 UTC (permalink / raw)
To: Ilmir Usmanov
Cc: Evgeny Gavrin, GarbuzovViacheslav, Dmitri Botcharnikov,
gcc-patches, jakub
[-- Attachment #1: Type: text/plain, Size: 9332 bytes --]
Hi!
On Thu, 23 Jan 2014 22:04:45 +0400, Ilmir Usmanov <i.usmanov@samsung.com> wrote:
> Subject: [PATCH 4/6] OpenACC GENERIC nodes
> --- a/gcc/gimplify.c
> +++ b/gcc/gimplify.c
> @@ -7846,6 +7907,18 @@ gimplify_expr (tree *expr_p, gimple_seq *pre_p, gimple_seq *post_p,
> ret = GS_ALL_DONE;
> break;
>
> + case OACC_KERNELS:
> + case OACC_DATA:
> + case OACC_CACHE:
> + case OACC_WAIT:
> + case OACC_HOST_DATA:
> + case OACC_DECLARE:
> + case OACC_UPDATE:
> + case OACC_ENTER_DATA:
> + case OACC_EXIT_DATA:
> + ret = GS_ALL_DONE;
> + break;
Would it make sense, until it is really implemented, to add something
like:
sorry ("directive not yet implemented");
That way it'd be more obvious that this still missing.
> --- a/gcc/omp-low.c
> +++ b/gcc/omp-low.c
> @@ -1543,10 +1543,12 @@ scan_sharing_clauses (tree clauses, omp_context *ctx)
> break;
> /* FALLTHRU */
>
> - case OMP_CLAUSE_FIRSTPRIVATE:
> - case OMP_CLAUSE_REDUCTION:
> case OMP_CLAUSE_LINEAR:
> gcc_assert (gimple_code (ctx->stmt) != GIMPLE_OACC_PARALLEL);
> + /* FALLTHRU. */
> +
> + case OMP_CLAUSE_FIRSTPRIVATE: /* == OACC_CLAUSE_FIRSTPRIVATE. */
> + case OMP_CLAUSE_REDUCTION: /* == OACC_CLAUSE_REDUCTION. */
> decl = OMP_CLAUSE_DECL (c);
> do_private:
> if (is_variable_sized (decl))
By the way, what I have been using these gcc_asserts for, is to mark all
code paths that I had not yet verified to be suitable for OpenACC. As
we're now close to adding additional GIMPLE_OACC_* codes, maybe we should
have some gimple_code_is_oacc function instead of just watching out for
GIMPLE_OACC_PARALLEL? That is, if we generally do agree that we want to
continue putting such gcc_asserts into the code?
> @@ -1713,6 +1719,35 @@ scan_sharing_clauses (tree clauses, omp_context *ctx)
> install_var_local (decl, ctx);
> break;
>
> + case OACC_CLAUSE_COPY:
> + case OACC_[...]
> + /* Not implemented yet. */
> + break;
> @@ -1822,6 +1856,38 @@ scan_sharing_clauses (tree clauses, omp_context *ctx)
> gcc_assert (gimple_code (ctx->stmt) != GIMPLE_OACC_PARALLEL);
> break;
>
> + case OACC_CLAUSE_COPY:
> + case OACC_[...]
> + /* Not implemented yet. */
> + break;
Likewise for these, I wonder, add a sorry messages?
> --- a/gcc/tree-core.h
> +++ b/gcc/tree-core.h
> @@ -216,12 +216,18 @@ enum omp_clause_code {
> /* OpenMP clause: private (variable_list). */
> OMP_CLAUSE_PRIVATE,
>
> + /* OpenACC clause: private (variable_list). */
> + OACC_CLAUSE_PRIVATE = OMP_CLAUSE_PRIVATE,
I prefer to avoid such duplicate names; here and in other instances in
the following. I think they mostly just add redundancy. Instead, I
prefer to map (in my mind) the existing OMP_CLAUSE_* to
OACC_or_OMP_CLAUSE_*. Is that acceptable for you?
> /* OpenMP clause: copyin (variable_list). */
> OMP_CLAUSE_COPYIN,
>
> + /* OpenACC clause: copyin (variable_list). */
> + OACC_CLAUSE_COPYIN = OMP_CLAUSE_COPYIN,
> +
> /* OpenMP clause: copyprivate (variable_list). */
> OMP_CLAUSE_COPYPRIVATE,
>
> @@ -261,12 +273,79 @@ enum omp_clause_code {
> /* OpenMP clause: map ({alloc:,to:,from:,tofrom:,}variable-list). */
> OMP_CLAUSE_MAP,
>
> + /* OpenACC clause: copy (variable_list). */
> + OACC_CLAUSE_COPY,
> +
> + /* OpenACC clause: [data clauses...]
Now, the data clauses. In my patch series posted at
<http://news.gmane.org/find-root.php?message_id=%3C87ppnuvbv6.fsf%40schwinge.name%3E>,
I have chosen the approach to map the OpenACC data clauses all into the
existing OMP_CLAUSE_MAP's map_kind, and extend that as required. That
seemed the more appropriate approach to me, as it's the very same
functionality. Also, OMP_CLAUSE_COPYIN semantically is something
different from OACC_CLAUSE_COPYIN.
> + /* OpenACC clause: host (variable_list). */
> + OACC_CLAUSE_HOST,
If we're adding new names for implementing OpenACC things, maybe we
should also name these OMP_*, to keep things simple to read in the code
that uses them.
While they clearly do stem from OpenMP, with a future generalization task
in mind, I understand the OMP_CLAUSE_* (and generally OMP_*) names to no
longer mean something specific to OpenMP (or OpenACC, for that matter),
but instead to define a generic interface to the respective
functionality, that just happens to have OMP_* names due to its OpenMP
legacy. For myself, I decided to apply this to clauses only, so -- at
least for now -- I have not spent any time on generalizing the OpenACC
and OpenMP directives themselves. (For example, very roughly, would an
OpenACC parallel directive be something like a (suitably extended) OpenMP
parallel directive inside a OpenMP target region?) So, I think it's find
to add new tree codes for the OpenACC directives (as you've done), and
any generalization work can be done later, once we have a good
understanding of what the required basic primitives actually are.
Back to the OpenACC host clause. However, to not give the impression
that there is a OpenMP host clause, maybe this one should be named
OMP_CLAUSE_OACC_HOST?
(And, by the way, I do agree that naming this *_HOST instead of *_SELF is
better, for *_HOST is the more descriptive name of the two synonyms.)
But then, I'm not sure we need this clause at all: can't we just again
use the existing OMP_CLAUSE_MAP with an appropriate map_kind, attached to
a *_UPDATE directive, to describe what the OpenACC host clause (and
others) semantically mean? (I have not yet looked at that in detail. If
you can't comment on this right now, I'm fine with keeping that as it is
now, and we can still change that later.)
> + /* OpenACC clause: wait [(integer-expression-list)]. */
> + OACC_CLAUSE_WAIT,
> +
> + /* Internal structure to hold OpenACC wait directive's variable_list.
> + #pragma acc wait [(integer-expression-list)]. */
> + OACC_NO_CLAUSE_WAIT,
> +
> + /* Internal structure to hold OpenACC cache directive's variable-list.
> + #pragma acc cache (variable-_ist). */
> + OACC_NO_CLAUSE_CACHE,
Hmm, yeah, while *_NO_CLAUSE_* perhaps isn't the most beautiful approach,
I think it's fine at least for now.
> @@ -660,7 +763,6 @@ enum annot_expr_kind {
> annot_expr_ivdep_kind
> };
>
> -
> /*---------------------------------------------------------------------------
> Type definitions
> ---------------------------------------------------------------------------*/
Even though myself, I don't care too much about this topic, it is
generally considered good proactice in GCC, to try to avoid such
"spurious" changes, to reduce the patches' volume. If changing such
things as formatting in regions not directly related to the code you're
editiing, as well as fixing typos is comments, and so on, that should be
separate patches, which most often can be committed directly on trunk, as
"obvious" changes.
> --- a/gcc/tree-pretty-print.c
> +++ b/gcc/tree-pretty-print.c
> @@ -54,6 +54,248 @@ static void do_niy (pretty_printer *, const_tree);
> static pretty_printer buffer;
> static int initialized = 0;
>
> +unsigned char
> +dump_oacc_body (int flags, tree node, int spc,
> + unsigned char is_expr, pretty_printer* buffer)
That's the same as dump_omp_body, right? Again, putting this into a
function instead of making it a goto label does make some sense, but it
is an independent change.
> +void
> +dump_oacc_clause_remap (const char* name,
> +void
> +dump_oacc_clause (pretty_printer *buffer, tree clause, int spc, int flags)
Same here (dump_omp_clause:print_remap, and dump_omp_clause). You are
right that if we use dump_omp_clause for the OpenACC clauses, we won't be
(easily) able to exactly reproduce the input directives, especially given
there are OMP_CLAUSE_* shared between OpenACC and OpenMP. So, with my
patch series for initial support for OpenACC data clauses, I now get
things like: »#pragma acc parallel map(from:d) map(force_tofrom:b)«
meaning »#pragma acc parallel present_or_copyin(d) copy(b)«, but I don't
think this is a problem, as that is for debugging output only. Would
that work for you?
> --- a/gcc/tree.h
> +++ b/gcc/tree.h
> @@ -1390,6 +1385,91 @@ extern void protected_set_expr_location (tree, location_t);
> #define OMP_CLAUSE_DEFAULT_KIND(NODE) \
> (OMP_CLAUSE_SUBCODE_CHECK (NODE, OMP_CLAUSE_DEFAULT)->omp_clause.subcode.default_kind)
>
> +/* OpenACC directives and clause accessors. */
> +
> +#define OACC_BODY(NODE) \
> + TREE_OPERAND (NODE, 0)
> +
> +#define OACC_[...]
Again, I'd just re-use (and extend as required) the existing OMP_* ones.
> @@ -3585,6 +3665,11 @@ extern tree build_translation_unit_decl (tree);
> extern tree build_block (tree, tree, tree, tree);
> extern tree build_empty_stmt (location_t);
> extern tree build_omp_clause (location_t, enum omp_clause_code);
> +static inline tree
> +build_oacc_clause (location_t loc, enum omp_clause_code code)
> +{
> + return build_omp_clause (loc, code);
> +}
..., and here, just use build_omp_clause at the call sites, too.
Grüße,
Thomas
[-- Attachment #2: Type: application/pgp-signature, Size: 489 bytes --]
^ permalink raw reply [flat|nested] 89+ messages in thread
* Re: [PATCH 1/6] [GOMP4] OpenACC 1.0+ support in fortran front-end
2014-01-23 18:03 ` [PATCH 1/6] " Ilmir Usmanov
2014-01-23 18:03 ` [PATCH 2/6] " Ilmir Usmanov
@ 2014-01-24 20:31 ` Thomas Schwinge
2014-01-27 19:37 ` Tobias Burnus
1 sibling, 1 reply; 89+ messages in thread
From: Thomas Schwinge @ 2014-01-24 20:31 UTC (permalink / raw)
To: Ilmir Usmanov
Cc: Evgeny Gavrin, GarbuzovViacheslav, Dmitri Botcharnikov,
gcc-patches, jakub
[-- Attachment #1: Type: text/plain, Size: 4378 bytes --]
Hi!
Regarding my comments, please keep in mind that I don't have a lot of
Fortran experience; neither as a user nor as an implementor ;-) in the
GCC front end, so don't hesitate to tell me if I'm misunderstanding
something. As I suggested, it may make sense to CC Fortran front end
maintainers for such patches.
When I say "again" in the following, that refers to things I
asked/suggested in »[PATCH 4/6] OpenACC GENERIC nodes«.
On Thu, 23 Jan 2014 22:03:09 +0400, Ilmir Usmanov <i.usmanov@samsung.com> wrote:
> Subject: [PATCH 1/6] OpenACC fortran FE part 1
> --- a/gcc/fortran/dump-parse-tree.c
> +++ b/gcc/fortran/dump-parse-tree.c
> @@ -1230,6 +1230,194 @@ show_omp_node (int level, gfc_code *c)
> fprintf (dumpfile, " (%s)", c->ext.omp_name);
> }
>
> +/* Show a single OpenACC directive node and everything underneath it
> + if necessary. */
> +
> +static void
> +show_oacc_node (int level, gfc_code *c)
Is this something that accurately needs to reproduce valid Fortran code?
Or, could we again re-use more of the existing OpenMP code, and get
nearly-valid Fortran, that differs in how some of the data clauses are
displayed, for example?
> --- a/gcc/fortran/gfortran.h
> +++ b/gcc/fortran/gfortran.h
> @@ -1025,16 +1031,29 @@ gfc_namelist;
> enum
> {
> OMP_LIST_PRIVATE,
> + OACC_LIST_PRIVATE = OMP_LIST_PRIVATE,
> OMP_LIST_FIRSTPRIVATE,
> + OACC_LIST_FIRSTPRIVATE = OMP_LIST_FIRSTPRIVATE,
Again, possible to simply re-use the existing OMP_* ones?
> @@ -1047,7 +1066,29 @@ enum
> OMP_LIST_IOR,
> OMP_LIST_IEOR,
> OMP_LIST_REDUCTION_LAST = OMP_LIST_IEOR,
> - OMP_LIST_NUM
> + OACC_LIST_REDUCTION_LAST = OMP_LIST_REDUCTION_LAST,
> + OMP_LIST_NUM,
> +
> + OACC_LIST_COPY = OMP_LIST_NUM,
> + OACC_LIST_FIRST = OACC_LIST_COPY,
> + OACC_LIST_DATA_CLAUSE_FIRST = OACC_LIST_COPY,
> + OACC_LIST_COPYIN,
> + OACC_LIST_COPYOUT,
> + OACC_LIST_CREATE,
> + OACC_LIST_DELETE,
> + OACC_LIST_PRESENT,
> + OACC_LIST_PRESENT_OR_COPY,
> + OACC_LIST_PRESENT_OR_COPYIN,
> + OACC_LIST_PRESENT_OR_COPYOUT,
> + OACC_LIST_PRESENT_OR_CREATE,
> + OACC_LIST_DEVICEPTR,
> + OACC_LIST_DATA_CLAUSE_LAST = OACC_LIST_DEVICEPTR,
> + OACC_LIST_USE_DEVICE,
> + OACC_LIST_DEVICE_RESIDENT,
> + OACC_LIST_HOST,
> + OACC_LIST_DEVICE,
> + OACC_LIST_CACHE,
> + OACC_LIST_NUM
> };
Again, for conformity, maybe stick with OMP_LIST_* names
(OMP_LIST_OACC_*?).
Do we still need the OMP_LIST_NUM value if we now got OACC_LIST_NUM to
mark the number of items, and should the latter one in fact be named
OMP_LIST_NUM then?)
Again, can we re-use the existing infrastructure for OpenMP's memory
mapping instead of adding OACC_LIST_COPY* (and similar) here?
> @@ -1077,17 +1118,42 @@ typedef struct gfc_omp_clauses
> + /* OpenACC. */
> + bool is_acc;
Can we avoid the is_acc member and instead make it clear from the context
whether this is OpenACC or OpenMP? (Just an idea.)
> + [...]
> }
> gfc_omp_clauses;
>
> #define gfc_get_omp_clauses() XCNEW (gfc_omp_clauses)
>
> +typedef gfc_omp_clauses gfc_oacc_clauses;
Again, I'd just use the existing gfc_omp_* name.
> --- a/gcc/fortran/parse.c
> +++ b/gcc/fortran/parse.c
> @@ -3643,6 +3875,113 @@ parse_omp_atomic (void)
> }
>
>
> +/* Parse the statements of an OpenACC structured block. */
> +
> +static void
> +parse_oacc_structured_block (gfc_statement acc_st)
> +{
> +[...]
> --- a/gcc/fortran/parse.h
> +++ b/gcc/fortran/parse.h
> @@ -29,7 +29,8 @@ typedef enum
> COMP_BLOCK_DATA, COMP_INTERFACE, COMP_DERIVED, COMP_DERIVED_CONTAINS,
> COMP_BLOCK, COMP_ASSOCIATE, COMP_IF,
> COMP_DO, COMP_SELECT, COMP_FORALL, COMP_WHERE, COMP_CONTAINS, COMP_ENUM,
> - COMP_SELECT_TYPE, COMP_OMP_STRUCTURED_BLOCK, COMP_CRITICAL, COMP_DO_CONCURRENT
> + COMP_SELECT_TYPE, COMP_OMP_STRUCTURED_BLOCK, COMP_CRITICAL, COMP_DO_CONCURRENT,
> + COMP_OACC_STRUCTURED_BLOCK
> }
> gfc_compile_state;
In Fortran, how is an OpenACC structured block different from an OpenMP
one? In C they aren't; see the third patch in
<http://news.gmane.org/find-root.php?message_id=%3C87r49kuass.fsf%40kepler.schwinge.homeip.net%3E>,
for the C front end/middle end, which is pending approval. Or is this
something else in the Fortran front end?
Grüße,
Thomas
[-- Attachment #2: Type: application/pgp-signature, Size: 489 bytes --]
^ permalink raw reply [flat|nested] 89+ messages in thread
* Re: [PATCH 2/6] [GOMP4] OpenACC 1.0+ support in fortran front-end
2014-01-23 18:03 ` [PATCH 2/6] " Ilmir Usmanov
2014-01-23 18:04 ` [PATCH 3/6] " Ilmir Usmanov
@ 2014-01-24 20:47 ` Thomas Schwinge
1 sibling, 0 replies; 89+ messages in thread
From: Thomas Schwinge @ 2014-01-24 20:47 UTC (permalink / raw)
To: Ilmir Usmanov
Cc: Evgeny Gavrin, GarbuzovViacheslav, Dmitri Botcharnikov,
gcc-patches, jakub
[-- Attachment #1: Type: text/plain, Size: 2395 bytes --]
Hi!
Regarding my comments, please keep in mind that I don't have a lot of
Fortran experience; neither as a user nor as an implementor ;-) in the
GCC front end, so don't hesitate to tell me if I'm misunderstanding
something. As I suggested, it may make sense to CC Fortran front end
maintainers for such patches.
On Thu, 23 Jan 2014 22:03:42 +0400, Ilmir Usmanov <i.usmanov@samsung.com> wrote:
> Subject: [PATCH 2/6] OpenACC fortran FE part 2
> --- a/gcc/fortran/openmp.c
> +++ b/gcc/fortran/openmp.c
> @@ -186,15 +292,51 @@ cleanup:
> #define OMP_CLAUSE_FINAL (1 << 14)
> #define OMP_CLAUSE_MERGEABLE (1 << 15)
>
> +/* OpenACC 2.0 clauses. */
> +#define OACC_CLAUSE_IF OMP_CLAUSE_IF
> +#define OACC_CLAUSE_ASYNC (1 << 16)
> +#define OACC_CLAUSE_NUM_GANGS (1 << 17)
> +#define OACC_CLAUSE_NUM_WORKERS (1 << 18)
> +#define OACC_CLAUSE_VECTOR_LENGTH (1 << 19)
> +#define OACC_CLAUSE_REDUCTION OMP_CLAUSE_REDUCTION
> +#define OACC_CLAUSE_COPY (1 << 20)
> +#define OACC_CLAUSE_COPYIN OMP_CLAUSE_COPYIN
> +#define OACC_CLAUSE_COPYOUT (1 << 21)
> +#define OACC_CLAUSE_[...]
As asked/suggested in »[PATCH 4/6] OpenACC GENERIC nodes«, can we again
avoid the duplicate names, and use the existing OpenMP memory mapping
stuff for expressing the OpenACC data clauses?
> /* Match OpenMP directive clauses. MASK is a bitmask of
> clauses that are allowed for a particular directive. */
>
> static match
> -gfc_match_omp_clauses (gfc_omp_clauses **cp, int mask)
> +gfc_match_omp_clauses (gfc_omp_clauses **cp, long long mask, bool is_acc)
Here, in turn, in the C front end,
<http://news.gmane.org/find-root.php?message_id=%3C1389712208-416-4-git-send-email-thomas%40codesourcery.com%3E>
(and following), I went with a separate function for OpenACC vs. OpenMP
clauses parsing, specifically to avoid the is_acc disambiguation
variable.
That is, I parse the OACC_CLAUSE_* in context of either an OpenACC or
OpenMP directive, and as such it's implicitly clear whether this is an
OpenACC or OpenMP one.
That's the reason why I can have PRAGMA_OMP_CLAUSE_COPYIN mean different
things for OpenACC vs. OpenMP in the C front end. Maybe such an approach
would work well in the Fortran front end, too?
Grüße,
Thomas
[-- Attachment #2: Type: application/pgp-signature, Size: 489 bytes --]
^ permalink raw reply [flat|nested] 89+ messages in thread
* Re: [PATCH] [GOMP4] OpenACC 1.0+ support in fortran front-end
2014-01-24 18:04 ` [PATCH] " Thomas Schwinge
@ 2014-01-27 13:12 ` Ilmir Usmanov
2014-01-27 15:49 ` Thomas Schwinge
0 siblings, 1 reply; 89+ messages in thread
From: Ilmir Usmanov @ 2014-01-27 13:12 UTC (permalink / raw)
To: Thomas Schwinge
Cc: Evgeny Gavrin, GarbuzovViacheslav, Dmitri Botcharnikov,
gcc-patches, jakub
Hi, Thomas!
Thank you for your review.
I agree with all your notes. I'm going to reuse your implementation of
data clauses, add minimal GIMPLE infrastructure, and then resend patches.
--
Ilmir.
^ permalink raw reply [flat|nested] 89+ messages in thread
* Re: [PATCH] [GOMP4] OpenACC 1.0+ support in fortran front-end
2014-01-27 13:12 ` Ilmir Usmanov
@ 2014-01-27 15:49 ` Thomas Schwinge
2014-01-27 16:35 ` Ilmir Usmanov
2014-01-31 11:14 ` Ilmir Usmanov
0 siblings, 2 replies; 89+ messages in thread
From: Thomas Schwinge @ 2014-01-27 15:49 UTC (permalink / raw)
To: Ilmir Usmanov
Cc: Evgeny Gavrin, GarbuzovViacheslav, Dmitri Botcharnikov,
gcc-patches, jakub
[-- Attachment #1: Type: text/plain, Size: 893 bytes --]
Hi!
On Mon, 27 Jan 2014 17:12:04 +0400, Ilmir Usmanov <i.usmanov@samsung.com> wrote:
> Thank you for your review.
You're welcome.
Hopefully the merge from trunk into gomp-4_0-branch that I just committed
doesn't cause you additional work -- but as I told in my other email,
there were no conflicts visible, so I hope that'll be an easy update.
Otherwise, I'm happy to assist.
> I agree with all your notes. I'm going to reuse your implementation of
> data clauses, add minimal GIMPLE infrastructure, and then resend patches.
Likewise, if you have any comments on my patch series for »initial
support for OpenACC data clauses«, I'd like to hear them. And otherwise,
as you state that you'd base your work on this, it probably makes sense
if I commit my patches soon? (I now also have to rebase my patches onto
the updated gomp-4_0-branch.)
Grüße,
Thomas
[-- Attachment #2: Type: application/pgp-signature, Size: 489 bytes --]
^ permalink raw reply [flat|nested] 89+ messages in thread
* Re: [PATCH] [GOMP4] OpenACC 1.0+ support in fortran front-end
2014-01-27 15:49 ` Thomas Schwinge
@ 2014-01-27 16:35 ` Ilmir Usmanov
2014-01-31 11:14 ` Ilmir Usmanov
1 sibling, 0 replies; 89+ messages in thread
From: Ilmir Usmanov @ 2014-01-27 16:35 UTC (permalink / raw)
To: Thomas Schwinge
Cc: Evgeny Gavrin, GarbuzovViacheslav, Dmitri Botcharnikov,
gcc-patches, jakub
Hi, Thomas!
> Likewise, if you have any comments on my patch series for »initial
> support for OpenACC data clauses«, I'd like to hear them.
Sure:
> + else if (!strcmp ("present_or_copy", p))
> + result = PRAGMA_OMP_CLAUSE_PRESENT_OR_COPY;
> + else if (!strcmp ("present_or_copyin", p))
> + result = PRAGMA_OMP_CLAUSE_PRESENT_OR_COPYIN;
> + else if (!strcmp ("present_or_copyout", p))
> + result = PRAGMA_OMP_CLAUSE_PRESENT_OR_COPYOUT;
> + else if (!strcmp ("present_or_create", p))
> + result = PRAGMA_OMP_CLAUSE_PRESENT_OR_CREATE;
For these "combined" clauses the specification specifies short names:
pcopy, pcopyin, pcopyout and pcreate (see 2.6.5.9 - 2.6.5.12 of OpenACC
2.0).
> And otherwise, as you state that you'd base your work on this, it
> probably makes sense if I commit my patches soon? (I now also have to
> rebase my patches onto the updated gomp-4_0-branch.)
Yes, it would be great!
--
Ilmir.
^ permalink raw reply [flat|nested] 89+ messages in thread
* Re: [PATCH 1/6] [GOMP4] OpenACC 1.0+ support in fortran front-end
2014-01-24 20:31 ` [PATCH 1/6] " Thomas Schwinge
@ 2014-01-27 19:37 ` Tobias Burnus
0 siblings, 0 replies; 89+ messages in thread
From: Tobias Burnus @ 2014-01-27 19:37 UTC (permalink / raw)
To: Thomas Schwinge, Ilmir Usmanov
Cc: Evgeny Gavrin, GarbuzovViacheslav, Dmitri Botcharnikov, gcc-patches
Hi,
Thomas Schwinge wrote:
> Regarding my comments, please keep in mind that I don't have a lot of
> Fortran experience; neither as a user nor as an implementor
How about CC-ing fortran@gcc for Fortran patches - it increases the
chance that some Fortran maintainer will give some comment on them.
(When doing so, please add a line or so stating that it is for the
branch and what is OpenACC - it makes it easier for those who haven't
followed gcc-patches.)
Tobias
PS: I might look at the patches myself; however, I have a huge backlog
of emails and didn't manage to do anything for GCC in the past month.
Thus, don't hold your breath and count rather one some other Fortran
maintainer.
^ permalink raw reply [flat|nested] 89+ messages in thread
* Re: [PATCH] [GOMP4] OpenACC 1.0+ support in fortran front-end
2014-01-27 15:49 ` Thomas Schwinge
2014-01-27 16:35 ` Ilmir Usmanov
@ 2014-01-31 11:14 ` Ilmir Usmanov
2014-01-31 11:16 ` [PATCH 1/6] " Ilmir Usmanov
1 sibling, 1 reply; 89+ messages in thread
From: Ilmir Usmanov @ 2014-01-31 11:14 UTC (permalink / raw)
To: Thomas Schwinge
Cc: Evgeny Gavrin, GarbuzovViacheslav, Dmitri Botcharnikov,
gcc-patches, jakub, fortran
Hi Thomas!
I fixed these patches:
http://gcc.gnu.org/ml/gcc-patches/2014-01/msg01520.html .
Instead of adding new OACC_* data structures and macros for OpenACC
clauses these patches reuse existing OMP_* functionality and extends it.
But OpenACC-specific constructs and directives still named as OACC_*.
Thomas, as I noticed you privately, I can't use OpenMP 4.0 map clause to
represent OpenACC data clauses in front-end, so old form of them still
there.
Successfully bootstrapped with no new regressions on
x86_64-unknown-linux-gnu.
OK for gomp-4_0-branch?
--
Ilmir.
^ permalink raw reply [flat|nested] 89+ messages in thread
* Re: [PATCH 1/6] [GOMP4] OpenACC 1.0+ support in fortran front-end
2014-01-31 11:14 ` Ilmir Usmanov
@ 2014-01-31 11:16 ` Ilmir Usmanov
2014-01-31 11:17 ` [PATCH 2/6] " Ilmir Usmanov
` (2 more replies)
0 siblings, 3 replies; 89+ messages in thread
From: Ilmir Usmanov @ 2014-01-31 11:16 UTC (permalink / raw)
To: Thomas Schwinge
Cc: Evgeny Gavrin, GarbuzovViacheslav, Dmitri Botcharnikov,
gcc-patches, jakub, fortran
[-- Attachment #1: Type: text/plain, Size: 3727 bytes --]
OpenACC 1.0 support to fortran FE -- core.
gcc/fortran/
* dump-parse-tree.c
(show_omp_node): Dump also OpenACC executable statements.
(show_code_node): Call it.
* gfortran.h
(ST_OACC_PARALLEL_LOOP, ST_OACC_END_PARALLEL_LOOP, ST_OACC_PARALLEL,
ST_OACC_END_PARALLEL, ST_OACC_KERNELS, ST_OACC_END_KERNELS,
ST_OACC_DATA, ST_OACC_END_DATA, ST_OACC_HOST_DATA,
ST_OACC_END_HOST_DATA, ST_OACC_LOOP, ST_OACC_DECLARE, ST_OACC_UPDATE,
ST_OACC_WAIT, ST_OACC_CACHE, ST_OACC_KERNELS_LOOP,
ST_OACC_END_KERNELS_LOOP, ST_OACC_ENTER_DATA,
ST_OACC_EXIT_DATA): New statements.
(gfc_exprlist): New structure to hold list of expressions.
(OMP_LIST_COPY, OMP_LIST_DATA_CLAUSE_FIRST,
OMP_LIST_OACC_COPYIN, OMP_LIST_COPYOUT, OMP_LIST_CREATE,
OMP_LIST_DELETE,
OMP_LIST_PRESENT, OMP_LIST_PRESENT_OR_COPY,
OMP_LIST_PRESENT_OR_COPYIN, OMP_LIST_PRESENT_OR_COPYOUT,
OMP_LIST_PRESENT_OR_CREATE, OMP_LIST_DEVICEPTR,
OMP_LIST_DATA_CLAUSE_LAST, OMP_LIST_USE_DEVICE,
OMP_LIST_DEVICE_RESIDENT, OMP_LIST_HOST, OMP_LIST_DEVICE,
OMP_LIST_CACHE): New types of list, allowed in clauses.
(gfc_omp_clauses): Add OpenACC clauses.
(gfc_namespace): Add OpenACC declare directive clauses.
(EXEC_OACC_KERNELS_LOOP, EXEC_OACC_PARALLEL_LOOP, 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): New executable statements.
(gfc_free_exprlist): New function declaration.
(gfc_resolve_oacc_directive): Likewise.
(gfc_resolve_oacc_parallel_loop_blocks): Likewise.
(gfc_resolve_oacc_blocks): Likewise.
* match.c (match_exit_cycle): Add support of OpenACC regions and loops.
* match.h (gfc_match_oacc_cache): New function declaration.
(gfc_match_oacc_wait, gfc_match_oacc_update): Likewise.
(gfc_match_oacc_declare, gfc_match_oacc_loop): Likewise.
(gfc_match_oacc_host_data, gfc_match_oacc_data): Likewise.
(gfc_match_oacc_kernels, gfc_match_oacc_kernels_loop): Likewise.
(gfc_match_oacc_parallel, gfc_match_oacc_parallel_loop): Likewise.
(gfc_match_oacc_enter_data, gfc_match_oacc_exit_data): Likewise.
* parse.c (decode_oacc_directive): New function.
(verify_token_free, verify_token_fixed): New helper functions.
(next_free, next_fixed): Decode !$ACC sentinel.
(case_executable): Add ST_OACC_UPDATE, ST_OACC_WAIT, ST_OACC_CACHE,
ST_OACC_ENTER_DATA and ST_OACC_EXIT_DATA directives.
(case_exec_markers): Add ST_OACC_PARALLEL_LOOP, ST_OACC_PARALLEL,
ST_OACC_KERNELS, ST_OACC_DATA, ST_OACC_HOST_DATA, ST_OACC_LOOP and
ST_OACC_KERNELS_LOOP directives.
(push_state): Initialize OpenACC declare clauses.
(gfc_ascii_statement): Dump names of OpenACC directives.
(verify_st_order): Verify OpenACC declare directive as declarative.
(parse_spec): Push clauses to state stack when declare directive is
parsed.
(parse_oacc_structured_block, parse_oacc_loop): New functions.
(parse_executable): Call them.
(parse_progunit): Move declare clauses from state stack to namespace.
* parse.h (gfc_state_data): Add declare directive's clauses.
* resolve.c (gfc_resolve_blocks): Resolve OpenACC directives.
(resolve_code): Likewise.
* scanner.c (openacc_flag, openacc_locus): New static variables.
(skip_oacc_attribute, skip_omp_attribute): New helper functions.
(skip_free_comments, skip_fixed_comments): Don't skip !$ACC sentinel.
(gfc_next_char_literal): Support OpenACC directives.
* st.c (gfc_free_statement): Free also OpenACC directives.
[-- Attachment #2: 0001-OpenACC-fortran-front-end-part-1.patch --]
[-- Type: text/x-diff, Size: 47990 bytes --]
From f8f10537d2555e596bdd1655990150d45ef08f9b Mon Sep 17 00:00:00 2001
From: Ilmir Usmanov <i.usmanov@samsung.com>
Date: Fri, 31 Jan 2014 13:25:42 +0400
Subject: [PATCH 1/6] OpenACC fortran front-end -- part 1
---
gcc/fortran/dump-parse-tree.c | 135 +++++++++++++-
gcc/fortran/gfortran.h | 59 ++++++
gcc/fortran/match.c | 27 +++
gcc/fortran/match.h | 15 ++
gcc/fortran/parse.c | 425 ++++++++++++++++++++++++++++++++++++++----
gcc/fortran/parse.h | 1 +
gcc/fortran/resolve.c | 36 ++++
gcc/fortran/scanner.c | 376 ++++++++++++++++++++++++++++++-------
gcc/fortran/st.c | 12 ++
9 files changed, 980 insertions(+), 106 deletions(-)
diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c
index b1343bc..9ef9db4 100644
--- a/gcc/fortran/dump-parse-tree.c
+++ b/gcc/fortran/dump-parse-tree.c
@@ -1031,9 +1031,22 @@ show_omp_node (int level, gfc_code *c)
{
gfc_omp_clauses *omp_clauses = NULL;
const char *name = NULL;
+ bool is_oacc = false;
switch (c->op)
{
+ case EXEC_OACC_PARALLEL_LOOP: name = "PARALLEL LOOP"; is_oacc = true; break;
+ case EXEC_OACC_PARALLEL: name = "PARALLEL"; is_oacc = true; break;
+ case EXEC_OACC_KERNELS_LOOP: name = "KERNELS LOOP"; is_oacc = true; break;
+ case EXEC_OACC_KERNELS: name = "KERNELS"; is_oacc = true; break;
+ case EXEC_OACC_DATA: name = "DATA"; is_oacc = true; break;
+ case EXEC_OACC_HOST_DATA: name = "HOST_DATA"; is_oacc = true; break;
+ case EXEC_OACC_LOOP: name = "LOOP"; is_oacc = true; break;
+ case EXEC_OACC_UPDATE: name = "UPDATE"; is_oacc = true; break;
+ case EXEC_OACC_WAIT: name = "WAIT"; is_oacc = true; break;
+ case EXEC_OACC_CACHE: name = "CACHE"; is_oacc = true; break;
+ case EXEC_OACC_ENTER_DATA: name = "ENTER DATA"; is_oacc = true; break;
+ case EXEC_OACC_EXIT_DATA: name = "EXIT DATA"; is_oacc = true; break;
case EXEC_OMP_ATOMIC: name = "ATOMIC"; break;
case EXEC_OMP_BARRIER: name = "BARRIER"; break;
case EXEC_OMP_CRITICAL: name = "CRITICAL"; break;
@@ -1054,9 +1067,21 @@ show_omp_node (int level, gfc_code *c)
default:
gcc_unreachable ();
}
- fprintf (dumpfile, "!$OMP %s", name);
+ fprintf (dumpfile, "!$%s %s", is_oacc?"ACC":"OMP", name);
switch (c->op)
{
+ case EXEC_OACC_PARALLEL_LOOP:
+ case EXEC_OACC_PARALLEL:
+ case EXEC_OACC_KERNELS_LOOP:
+ case EXEC_OACC_KERNELS:
+ case EXEC_OACC_DATA:
+ case EXEC_OACC_HOST_DATA:
+ case EXEC_OACC_LOOP:
+ case EXEC_OACC_UPDATE:
+ case EXEC_OACC_WAIT:
+ case EXEC_OACC_CACHE:
+ case EXEC_OACC_ENTER_DATA:
+ case EXEC_OACC_EXIT_DATA:
case EXEC_OMP_DO:
case EXEC_OMP_PARALLEL:
case EXEC_OMP_PARALLEL_DO:
@@ -1109,6 +1134,76 @@ show_omp_node (int level, gfc_code *c)
show_expr (omp_clauses->num_threads);
fputc (')', dumpfile);
}
+ if (omp_clauses->async)
+ {
+ fputs (" ASYNC", dumpfile);
+ if (omp_clauses->async_expr)
+ {
+ fputc ('(', dumpfile);
+ show_expr (omp_clauses->async_expr);
+ fputc (')', dumpfile);
+ }
+ }
+ if (omp_clauses->num_gangs_expr)
+ {
+ fputs (" NUM_GANGS(", dumpfile);
+ show_expr (omp_clauses->num_gangs_expr);
+ fputc (')', dumpfile);
+ }
+ if (omp_clauses->num_workers_expr)
+ {
+ fputs (" NUM_WORKERS(", dumpfile);
+ show_expr (omp_clauses->num_workers_expr);
+ fputc (')', dumpfile);
+ }
+ if (omp_clauses->vector_length_expr)
+ {
+ fputs (" VECTOR_LENGTH(", dumpfile);
+ show_expr (omp_clauses->vector_length_expr);
+ fputc (')', dumpfile);
+ }
+ if (omp_clauses->collapse)
+ {
+ fputs (" COLLAPSE(", dumpfile);
+ fprintf (dumpfile, "%d", omp_clauses->collapse);
+ fputc (')', dumpfile);
+ }
+ if (omp_clauses->gang)
+ {
+ fputs (" GANG", dumpfile);
+ if (omp_clauses->gang_expr)
+ {
+ fputc ('(', dumpfile);
+ show_expr (omp_clauses->gang_expr);
+ fputc (')', dumpfile);
+ }
+ }
+ if (omp_clauses->worker)
+ {
+ fputs (" WORKER", dumpfile);
+ if (omp_clauses->worker_expr)
+ {
+ fputc ('(', dumpfile);
+ show_expr (omp_clauses->worker_expr);
+ fputc (')', dumpfile);
+ }
+ }
+ if (omp_clauses->vector)
+ {
+ fputs (" VECTOR", dumpfile);
+ if (omp_clauses->vector_expr)
+ {
+ fputc ('(', dumpfile);
+ show_expr (omp_clauses->vector_expr);
+ fputc (')', dumpfile);
+ }
+ }
+ if (omp_clauses->non_clause_wait_expr)
+ {
+ fputc ('(', dumpfile);
+ show_expr (omp_clauses->non_clause_wait_expr);
+ fputc (')', dumpfile);
+ }
if (omp_clauses->sched_kind != OMP_SCHED_NONE)
{
const char *type;
@@ -1144,6 +1239,10 @@ show_omp_node (int level, gfc_code *c)
}
fprintf (dumpfile, " DEFAULT(%s)", type);
}
+ if (omp_clauses->seq)
+ fputs (" SEQ", dumpfile);
+ if (omp_clauses->independent)
+ fputs (" INDEPENDENT", dumpfile);
if (omp_clauses->ordered)
fputs (" ORDERED", dumpfile);
if (omp_clauses->untied)
@@ -1182,6 +1281,26 @@ show_omp_node (int level, gfc_code *c)
{
switch (list_type)
{
+ case OMP_LIST_COPY: type = "COPY"; break;
+ case OMP_LIST_OACC_COPYIN: type = "COPYIN"; break;
+ case OMP_LIST_COPYOUT: type = "COPYOUT"; break;
+ case OMP_LIST_CREATE: type = "CREATE"; break;
+ case OMP_LIST_DELETE: type = "DELETE"; break;
+ case OMP_LIST_PRESENT: type = "PRESENT"; break;
+ case OMP_LIST_PRESENT_OR_COPY:
+ type = "PRESENT_OR_COPY"; break;
+ case OMP_LIST_PRESENT_OR_COPYIN:
+ type = "PRESENT_OR_COPYIN"; break;
+ case OMP_LIST_PRESENT_OR_COPYOUT:
+ type = "PRESENT_OR_COPYOUT"; break;
+ case OMP_LIST_PRESENT_OR_CREATE:
+ type = "PRESENT_OR_CREATE"; break;
+ case OMP_LIST_DEVICEPTR: type = "DEVICEPTR"; break;
+ case OMP_LIST_USE_DEVICE: type = "USE_DEVICE"; break;
+ case OMP_LIST_DEVICE_RESIDENT: type = "USE_DEVICE"; break;
+ case OMP_LIST_HOST: type = "HOST"; break;
+ case OMP_LIST_DEVICE: type = "DEVICE"; break;
+ case OMP_LIST_CACHE: type = ""; break;
case OMP_LIST_PRIVATE: type = "PRIVATE"; break;
case OMP_LIST_FIRSTPRIVATE: type = "FIRSTPRIVATE"; break;
case OMP_LIST_LASTPRIVATE: type = "LASTPRIVATE"; break;
@@ -1215,7 +1334,7 @@ show_omp_node (int level, gfc_code *c)
if (c->op == EXEC_OMP_ATOMIC)
return;
code_indent (level, 0);
- fprintf (dumpfile, "!$OMP END %s", name);
+ fprintf (dumpfile, "!$%s END %s", is_oacc?"ACC":"OMP", name);
if (omp_clauses != NULL)
{
if (omp_clauses->lists[OMP_LIST_COPYPRIVATE])
@@ -2194,6 +2313,18 @@ show_code_node (int level, gfc_code *c)
fprintf (dumpfile, " EOR=%d", dt->eor->value);
break;
+ case EXEC_OACC_PARALLEL_LOOP:
+ case EXEC_OACC_PARALLEL:
+ case EXEC_OACC_KERNELS_LOOP:
+ case EXEC_OACC_KERNELS:
+ case EXEC_OACC_DATA:
+ case EXEC_OACC_HOST_DATA:
+ case EXEC_OACC_LOOP:
+ case EXEC_OACC_UPDATE:
+ case EXEC_OACC_WAIT:
+ case EXEC_OACC_CACHE:
+ case EXEC_OACC_ENTER_DATA:
+ case EXEC_OACC_EXIT_DATA:
case EXEC_OMP_ATOMIC:
case EXEC_OMP_BARRIER:
case EXEC_OMP_CRITICAL:
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index bce53a4..d45b8ed 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -203,6 +203,12 @@ typedef enum
ST_WRITE, ST_ASSIGNMENT, ST_POINTER_ASSIGNMENT, ST_SELECT_CASE, ST_SEQUENCE,
ST_SIMPLE_IF, ST_STATEMENT_FUNCTION, ST_DERIVED_DECL, ST_LABEL_ASSIGNMENT,
ST_ENUM, ST_ENUMERATOR, ST_END_ENUM, ST_SELECT_TYPE, ST_TYPE_IS, ST_CLASS_IS,
+ ST_OACC_PARALLEL_LOOP, ST_OACC_END_PARALLEL_LOOP, ST_OACC_PARALLEL,
+ ST_OACC_END_PARALLEL, ST_OACC_KERNELS, ST_OACC_END_KERNELS, ST_OACC_DATA,
+ ST_OACC_END_DATA, ST_OACC_HOST_DATA, ST_OACC_END_HOST_DATA, ST_OACC_LOOP,
+ ST_OACC_DECLARE, ST_OACC_UPDATE, ST_OACC_WAIT, ST_OACC_CACHE,
+ ST_OACC_KERNELS_LOOP, ST_OACC_END_KERNELS_LOOP,
+ ST_OACC_ENTER_DATA, ST_OACC_EXIT_DATA,
ST_OMP_ATOMIC, ST_OMP_BARRIER, ST_OMP_CRITICAL, ST_OMP_END_ATOMIC,
ST_OMP_END_CRITICAL, ST_OMP_END_DO, ST_OMP_END_MASTER, ST_OMP_END_ORDERED,
ST_OMP_END_PARALLEL, ST_OMP_END_PARALLEL_DO, ST_OMP_END_PARALLEL_SECTIONS,
@@ -1025,6 +1031,16 @@ gfc_namelist;
#define gfc_get_namelist() XCNEW (gfc_namelist)
+/* Likewise to gfc_namelist, but contains expressions. */
+typedef struct gfc_exprlist
+{
+ struct gfc_expr *expr;
+ struct gfc_exprlist *next;
+}
+gfc_exprlist;
+
+#define gfc_get_exprlist() XCNEW (gfc_exprlist)
+
enum
{
OMP_LIST_PRIVATE,
@@ -1033,6 +1049,24 @@ enum
OMP_LIST_COPYPRIVATE,
OMP_LIST_SHARED,
OMP_LIST_COPYIN,
+ OMP_LIST_COPY,
+ OMP_LIST_DATA_CLAUSE_FIRST = OMP_LIST_COPY,
+ OMP_LIST_OACC_COPYIN,
+ OMP_LIST_COPYOUT,
+ OMP_LIST_CREATE,
+ OMP_LIST_DELETE,
+ OMP_LIST_PRESENT,
+ OMP_LIST_PRESENT_OR_COPY,
+ OMP_LIST_PRESENT_OR_COPYIN,
+ OMP_LIST_PRESENT_OR_COPYOUT,
+ OMP_LIST_PRESENT_OR_CREATE,
+ OMP_LIST_DEVICEPTR,
+ OMP_LIST_DATA_CLAUSE_LAST = OMP_LIST_DEVICEPTR,
+ OMP_LIST_USE_DEVICE,
+ OMP_LIST_DEVICE_RESIDENT,
+ OMP_LIST_HOST,
+ OMP_LIST_DEVICE,
+ OMP_LIST_CACHE,
OMP_LIST_PLUS,
OMP_LIST_REDUCTION_FIRST = OMP_LIST_PLUS,
OMP_LIST_MULT,
@@ -1083,6 +1117,20 @@ typedef struct gfc_omp_clauses
enum gfc_omp_default_sharing default_sharing;
int collapse;
bool nowait, ordered, untied, mergeable;
+
+ /* OpenACC. */
+ struct gfc_expr *async_expr;
+ struct gfc_expr *gang_expr;
+ struct gfc_expr *worker_expr;
+ struct gfc_expr *vector_expr;
+ struct gfc_expr *num_gangs_expr;
+ struct gfc_expr *num_workers_expr;
+ struct gfc_expr *vector_length_expr;
+ struct gfc_expr *non_clause_wait_expr;
+ gfc_exprlist *waitlist;
+ gfc_exprlist *tilelist;
+ bool async, gang, worker, vector, seq, independent;
+ bool wait, par_auto, gang_static;
}
gfc_omp_clauses;
@@ -1444,6 +1492,9 @@ typedef struct gfc_namespace
this namespace. */
struct gfc_data *data;
+ /* !$ACC DECLARE clauses */
+ gfc_omp_clauses *declare_clauses;
+
gfc_charlen *cl_list, *old_cl_list;
gfc_dt_list *derived_types;
@@ -2102,6 +2153,10 @@ typedef enum
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_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_OMP_CRITICAL, EXEC_OMP_DO, EXEC_OMP_FLUSH, EXEC_OMP_MASTER,
EXEC_OMP_ORDERED, EXEC_OMP_PARALLEL, EXEC_OMP_PARALLEL_DO,
EXEC_OMP_PARALLEL_SECTIONS, EXEC_OMP_PARALLEL_WORKSHARE,
@@ -2743,6 +2798,10 @@ void gfc_resolve_omp_parallel_blocks (gfc_code *, gfc_namespace *);
void gfc_resolve_omp_do_blocks (gfc_code *, gfc_namespace *);
void gfc_omp_save_and_clear_state (struct gfc_omp_saved_state *);
void gfc_omp_restore_state (struct gfc_omp_saved_state *);
+void gfc_free_exprlist (gfc_exprlist *);
+void gfc_resolve_oacc_directive (gfc_code *, gfc_namespace *);
+void gfc_resolve_oacc_parallel_loop_blocks (gfc_code *, gfc_namespace *);
+void gfc_resolve_oacc_blocks (gfc_code *, gfc_namespace *);
/* expr.c */
void gfc_free_actual_arglist (gfc_actual_arglist *);
diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c
index eda1bf3..34d1d56 100644
--- a/gcc/fortran/match.c
+++ b/gcc/fortran/match.c
@@ -2595,6 +2595,33 @@ match_exit_cycle (gfc_statement st, gfc_exec_op op)
if (cnt > 0
&& o != NULL
&& o->state == COMP_OMP_STRUCTURED_BLOCK
+ && (o->head->op == EXEC_OACC_LOOP
+ || o->head->op == EXEC_OACC_PARALLEL_LOOP))
+ {
+ int collapse = 1;
+ gcc_assert (o->head->next != NULL
+ && (o->head->next->op == EXEC_DO
+ || o->head->next->op == EXEC_DO_WHILE)
+ && o->previous != NULL
+ && o->previous->tail->op == o->head->op);
+ if (o->previous->tail->ext.omp_clauses != NULL
+ && o->previous->tail->ext.omp_clauses->collapse > 1)
+ collapse = o->previous->tail->ext.omp_clauses->collapse;
+ if (st == ST_EXIT && cnt <= collapse)
+ {
+ gfc_error ("EXIT statement at %C terminating !$ACC LOOP loop");
+ return MATCH_ERROR;
+ }
+ if (st == ST_CYCLE && cnt < collapse)
+ {
+ gfc_error ("CYCLE statement at %C to non-innermost collapsed"
+ " !$ACC LOOP loop");
+ return MATCH_ERROR;
+ }
+ }
+ if (cnt > 0
+ && o != NULL
+ && (o->state == COMP_OMP_STRUCTURED_BLOCK)
&& (o->head->op == EXEC_OMP_DO
|| o->head->op == EXEC_OMP_PARALLEL_DO))
{
diff --git a/gcc/fortran/match.h b/gcc/fortran/match.h
index 385e840..80ba44f 100644
--- a/gcc/fortran/match.h
+++ b/gcc/fortran/match.h
@@ -122,6 +122,21 @@ gfc_common_head *gfc_get_common (const char *, int);
/* openmp.c. */
+/* OpenACC directive matchers. */
+match gfc_match_oacc_cache (void);
+match gfc_match_oacc_wait (void);
+match gfc_match_oacc_update (void);
+match gfc_match_oacc_declare (void);
+match gfc_match_oacc_loop (void);
+match gfc_match_oacc_host_data (void);
+match gfc_match_oacc_data (void);
+match gfc_match_oacc_kernels (void);
+match gfc_match_oacc_kernels_loop (void);
+match gfc_match_oacc_parallel (void);
+match gfc_match_oacc_parallel_loop (void);
+match gfc_match_oacc_enter_data (void);
+match gfc_match_oacc_exit_data (void);
+
/* OpenMP directive matchers. */
match gfc_match_omp_eos (void);
match gfc_match_omp_atomic (void);
diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index d9af60e..934cfe8 100644
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -532,6 +532,90 @@ decode_statement (void)
}
static gfc_statement
+decode_oacc_directive (void)
+{
+ locus old_locus;
+ char c;
+
+ gfc_enforce_clean_symbol_state ();
+
+ gfc_clear_error (); /* Clear any pending errors. */
+ gfc_clear_warning (); /* Clear any pending warnings. */
+
+ if (gfc_pure (NULL))
+ {
+ gfc_error_now ("OpenACC directives at %C may not appear in PURE "
+ "or ELEMENTAL procedures");
+ gfc_error_recovery ();
+ return ST_NONE;
+ }
+
+ if (gfc_implicit_pure (NULL))
+ gfc_current_ns->proc_name->attr.implicit_pure = 0;
+
+ old_locus = gfc_current_locus;
+
+ /* General OpenACC directive matching: Instead of testing every possible
+ statement, we eliminate most possibilities by peeking at the
+ first character. */
+
+ c = gfc_peek_ascii_char ();
+
+ switch (c)
+ {
+ case 'c':
+ match ("cache", gfc_match_oacc_cache, ST_OACC_CACHE);
+ break;
+ case 'd':
+ match ("data", gfc_match_oacc_data, ST_OACC_DATA);
+ match ("declare", gfc_match_oacc_declare, ST_OACC_DECLARE);
+ break;
+ case 'e':
+ match ("end data", gfc_match_omp_eos, ST_OACC_END_DATA);
+ match ("end host_data", gfc_match_omp_eos, ST_OACC_END_HOST_DATA);
+ match ("end kernels loop", gfc_match_omp_eos, ST_OACC_END_KERNELS_LOOP);
+ match ("end kernels", gfc_match_omp_eos, ST_OACC_END_KERNELS);
+ match ("end parallel loop", gfc_match_omp_eos, ST_OACC_END_PARALLEL_LOOP);
+ match ("end parallel", gfc_match_omp_eos, ST_OACC_END_PARALLEL);
+ match ("enter data", gfc_match_oacc_enter_data, ST_OACC_ENTER_DATA);
+ match ("exit data", gfc_match_oacc_exit_data, ST_OACC_EXIT_DATA);
+ break;
+ case 'h':
+ match ("host_data", gfc_match_oacc_host_data, ST_OACC_HOST_DATA);
+ break;
+ case 'p':
+ match ("parallel loop", gfc_match_oacc_parallel_loop, ST_OACC_PARALLEL_LOOP);
+ match ("parallel", gfc_match_oacc_parallel, ST_OACC_PARALLEL);
+ break;
+ case 'k':
+ match ("kernels loop", gfc_match_oacc_kernels_loop, ST_OACC_KERNELS_LOOP);
+ match ("kernels", gfc_match_oacc_kernels, ST_OACC_KERNELS);
+ break;
+ case 'l':
+ match ("loop", gfc_match_oacc_loop, ST_OACC_LOOP);
+ break;
+ case 'u':
+ match ("update", gfc_match_oacc_update, ST_OACC_UPDATE);
+ break;
+ case 'w':
+ match ("wait", gfc_match_oacc_wait, ST_OACC_WAIT);
+ break;
+ }
+
+ /* All else has failed, so give up. See if any of the matchers has
+ stored an error message of some sort. */
+
+ if (gfc_error_check () == 0)
+ gfc_error_now ("Unclassifiable OpenACC directive at %C");
+
+ reject_statement ();
+
+ gfc_error_recovery ();
+
+ return ST_NONE;
+}
+
+static gfc_statement
decode_omp_directive (void)
{
locus old_locus;
@@ -668,6 +752,21 @@ decode_gcc_attribute (void)
#undef match
+static void
+verify_token_free (const char* token, int length, bool last_was_use_stmt)
+{
+ int i;
+ char c;
+
+ c = gfc_next_ascii_char ();
+ for (i = 0; i < length; i++, c = gfc_next_ascii_char ())
+ gcc_assert (c == token[i]);
+
+ gcc_assert (gfc_is_whitespace(c));
+ gfc_gobble_whitespace ();
+ if (last_was_use_stmt)
+ use_modules ();
+}
/* Get the next statement in free form source. */
@@ -737,7 +836,7 @@ next_free (void)
else if (c == '!')
{
/* Comments have already been skipped by the time we get here,
- except for GCC attributes and OpenMP directives. */
+ except for GCC attributes and OpenMP/OpenACC directives. */
gfc_next_ascii_char (); /* Eat up the exclamation sign. */
c = gfc_peek_ascii_char ();
@@ -754,21 +853,38 @@ next_free (void)
return decode_gcc_attribute ();
}
- else if (c == '$' && gfc_option.gfc_flag_openmp)
- {
- int i;
-
- c = gfc_next_ascii_char ();
- for (i = 0; i < 4; i++, c = gfc_next_ascii_char ())
- gcc_assert (c == "$omp"[i]);
-
- gcc_assert (c == ' ' || c == '\t');
- gfc_gobble_whitespace ();
- if (last_was_use_stmt)
- use_modules ();
- return decode_omp_directive ();
- }
-
+
+ else if (c == '$')
+ {
+ /* Since both OpenMP and OpenACC directives starts with
+ !$ character sequence, we must check all flags combinations */
+ if (gfc_option.gfc_flag_openmp && !gfc_option.gfc_flag_openacc)
+ {
+ verify_token_free ("$omp", 4, last_was_use_stmt);
+ return decode_omp_directive ();
+ }
+ else if (gfc_option.gfc_flag_openmp && gfc_option.gfc_flag_openacc)
+ {
+ gfc_next_ascii_char (); /* Eat up dollar character */
+ c = gfc_peek_ascii_char ();
+
+ if (c == 'o')
+ {
+ verify_token_free ("omp", 3, last_was_use_stmt);
+ return decode_omp_directive ();
+ }
+ else if (c == 'a')
+ {
+ verify_token_free ("acc", 3, last_was_use_stmt);
+ return decode_oacc_directive ();
+ }
+ }
+ else if (gfc_option.gfc_flag_openacc)
+ {
+ verify_token_free ("$acc", 4, last_was_use_stmt);
+ return decode_oacc_directive ();
+ }
+ }
gcc_unreachable ();
}
@@ -784,6 +900,26 @@ next_free (void)
return decode_statement ();
}
+static bool
+verify_token_fixed (const char *token, int length, bool last_was_use_stmt)
+{
+ int i;
+ char c = gfc_next_char_literal (NONSTRING);
+
+ for (i = 0; i < length; i++, c = gfc_next_char_literal (NONSTRING))
+ gcc_assert ((char) gfc_wide_tolower (c) == token[i]);
+
+ if (c != ' ' && c != '0')
+ {
+ gfc_buffer_error (0);
+ gfc_error ("Bad continuation line at %C");
+ return false;
+ }
+ if (last_was_use_stmt)
+ use_modules ();
+
+ return true;
+}
/* Get the next statement in fixed-form source. */
@@ -843,21 +979,38 @@ next_fixed (void)
return decode_gcc_attribute ();
}
- else if (c == '$' && gfc_option.gfc_flag_openmp)
- {
- for (i = 0; i < 4; i++, c = gfc_next_char_literal (NONSTRING))
- gcc_assert ((char) gfc_wide_tolower (c) == "$omp"[i]);
-
- if (c != ' ' && c != '0')
- {
- gfc_buffer_error (0);
- gfc_error ("Bad continuation line at %C");
- return ST_NONE;
- }
- if (last_was_use_stmt)
- use_modules ();
- return decode_omp_directive ();
- }
+ else if (c == '$')
+ {
+ if (gfc_option.gfc_flag_openmp && !gfc_option.gfc_flag_openacc)
+ {
+ if (!verify_token_fixed ("omp", 3, last_was_use_stmt))
+ return ST_NONE;
+ return decode_omp_directive ();
+ }
+ else if (gfc_option.gfc_flag_openmp
+ && gfc_option.gfc_flag_openacc)
+ {
+ c = gfc_next_char_literal(NONSTRING);
+ if (c == 'o' || c == 'O')
+ {
+ if (!verify_token_fixed ("mp", 2, last_was_use_stmt))
+ return ST_NONE;
+ return decode_omp_directive ();
+ }
+ else if (c == 'a' || c == 'A')
+ {
+ if (!verify_token_fixed ("cc", 2, last_was_use_stmt))
+ return ST_NONE;
+ return decode_oacc_directive ();
+ }
+ }
+ else if (gfc_option.gfc_flag_openacc)
+ {
+ if (!verify_token_fixed ("acc", 3, last_was_use_stmt))
+ return ST_NONE;
+ return decode_oacc_directive ();
+ }
+ }
/* FALLTHROUGH */
/* Comments have already been skipped by the time we get
@@ -1015,7 +1168,9 @@ next_statement (void)
case ST_LABEL_ASSIGNMENT: case ST_FLUSH: case ST_OMP_FLUSH: \
case ST_OMP_BARRIER: case ST_OMP_TASKWAIT: case ST_OMP_TASKYIELD: \
case ST_ERROR_STOP: case ST_SYNC_ALL: case ST_SYNC_IMAGES: \
- case ST_SYNC_MEMORY: case ST_LOCK: case ST_UNLOCK
+ case ST_SYNC_MEMORY: case ST_LOCK: case ST_UNLOCK: case ST_OACC_UPDATE: \
+ case ST_OACC_WAIT: case ST_OACC_CACHE: case ST_OACC_ENTER_DATA: \
+ case ST_OACC_EXIT_DATA
/* Statements that mark other executable statements. */
@@ -1027,7 +1182,9 @@ next_statement (void)
case ST_OMP_CRITICAL: case ST_OMP_MASTER: case ST_OMP_SINGLE: \
case ST_OMP_DO: case ST_OMP_PARALLEL_DO: case ST_OMP_ATOMIC: \
case ST_OMP_WORKSHARE: case ST_OMP_PARALLEL_WORKSHARE: \
- case ST_OMP_TASK: case ST_CRITICAL
+ case ST_OMP_TASK: case ST_CRITICAL: \
+ case ST_OACC_PARALLEL_LOOP: case ST_OACC_PARALLEL: case ST_OACC_KERNELS: \
+ case ST_OACC_DATA: case ST_OACC_HOST_DATA: case ST_OACC_LOOP: case ST_OACC_KERNELS_LOOP
/* Declaration statements */
@@ -1054,6 +1211,8 @@ push_state (gfc_state_data *p, gfc_compile_state new_state, gfc_symbol *sym)
p->sym = sym;
p->head = p->tail = NULL;
p->do_variable = NULL;
+ if (p->state != COMP_DO && p->state != COMP_DO_CONCURRENT)
+ p->ext.declare_clauses = NULL;
/* If this the state of a construct like BLOCK, DO or IF, the corresponding
construct statement was accepted right before pushing the state. Thus,
@@ -1519,6 +1678,63 @@ gfc_ascii_statement (gfc_statement st)
case ST_END_ENUM:
p = "END ENUM";
break;
+ case ST_OACC_PARALLEL_LOOP:
+ p = "!$ACC PARALLEL LOOP";
+ break;
+ case ST_OACC_END_PARALLEL_LOOP:
+ p = "!$ACC END PARALLEL LOOP";
+ break;
+ case ST_OACC_PARALLEL:
+ p = "!$ACC PARALLEL";
+ break;
+ case ST_OACC_END_PARALLEL:
+ p = "!$ACC END PARALLEL";
+ break;
+ case ST_OACC_KERNELS:
+ p = "!$ACC KERNELS";
+ break;
+ case ST_OACC_END_KERNELS:
+ p = "!$ACC END KERNELS";
+ break;
+ case ST_OACC_KERNELS_LOOP:
+ p = "!$ACC KERNELS LOOP";
+ break;
+ case ST_OACC_END_KERNELS_LOOP:
+ p = "!$ACC END KERNELS LOOP";
+ break;
+ case ST_OACC_DATA:
+ p = "!$ACC DATA";
+ break;
+ case ST_OACC_END_DATA:
+ p = "!$ACC END DATA";
+ break;
+ case ST_OACC_HOST_DATA:
+ p = "!$ACC HOST_DATA";
+ break;
+ case ST_OACC_END_HOST_DATA:
+ p = "!$ACC END HOST_DATA";
+ break;
+ case ST_OACC_LOOP:
+ p = "!$ACC LOOP";
+ break;
+ case ST_OACC_DECLARE:
+ p = "!$ACC DECLARE";
+ break;
+ case ST_OACC_UPDATE:
+ p = "!$ACC UPDATE";
+ break;
+ case ST_OACC_WAIT:
+ p = "!$ACC WAIT";
+ break;
+ case ST_OACC_CACHE:
+ p = "!$ACC CACHE";
+ break;
+ case ST_OACC_ENTER_DATA:
+ p = "!$ACC ENTER DATA";
+ break;
+ case ST_OACC_EXIT_DATA:
+ p = "!$ACC EXIT DATA";
+ break;
case ST_OMP_ATOMIC:
p = "!$OMP ATOMIC";
break;
@@ -1883,6 +2099,7 @@ verify_st_order (st_state *p, gfc_statement st, bool silent)
case ST_PUBLIC:
case ST_PRIVATE:
case ST_DERIVED_DECL:
+ case ST_OACC_DECLARE:
case_decl:
if (p->state >= ORDER_EXEC)
goto order;
@@ -2784,6 +3001,21 @@ declSt:
st = next_statement ();
goto loop;
+ case ST_OACC_DECLARE:
+ if (!verify_st_order(&ss, st, false))
+ {
+ reject_statement ();
+ st = next_statement ();
+ goto loop;
+ }
+ if (gfc_state_stack->ext.declare_clauses == NULL)
+ {
+ gfc_state_stack->ext.declare_clauses = new_st.ext.omp_clauses;
+ }
+ accept_statement (st);
+ st = next_statement ();
+ goto loop;
+
default:
break;
}
@@ -3643,6 +3875,113 @@ parse_omp_atomic (void)
}
+/* Parse the statements of an OpenACC structured block. */
+
+static void
+parse_oacc_structured_block (gfc_statement acc_st)
+{
+ gfc_statement st, acc_end_st;
+ gfc_code *cp, *np;
+ gfc_state_data s;
+
+ accept_statement (acc_st);
+
+ cp = gfc_state_stack->tail;
+ push_state (&s, COMP_OMP_STRUCTURED_BLOCK, NULL);
+ np = new_level (cp);
+ np->op = cp->op;
+ np->block = NULL;
+ switch (acc_st)
+ {
+ case ST_OACC_PARALLEL:
+ acc_end_st = ST_OACC_END_PARALLEL;
+ break;
+ case ST_OACC_KERNELS:
+ acc_end_st = ST_OACC_END_KERNELS;
+ break;
+ case ST_OACC_DATA:
+ acc_end_st = ST_OACC_END_DATA;
+ break;
+ case ST_OACC_HOST_DATA:
+ acc_end_st = ST_OACC_END_HOST_DATA;
+ break;
+ default:
+ gcc_unreachable ();
+ }
+
+ do
+ {
+ st = parse_executable (ST_NONE);
+ if (st == ST_NONE)
+ unexpected_eof ();
+ else if (st != acc_end_st)
+ unexpected_statement (st);
+ }
+ while (st != acc_end_st);
+
+ gcc_assert (new_st.op == EXEC_NOP);
+
+ gfc_clear_new_st ();
+ gfc_commit_symbols ();
+ gfc_warning_check ();
+ pop_state ();
+}
+
+/* Parse the statements of OpenACC loop/parallel loop/kernels loop. */
+
+static gfc_statement
+parse_oacc_loop (gfc_statement acc_st)
+{
+ gfc_statement st;
+ gfc_code *cp, *np;
+ gfc_state_data s;
+
+ accept_statement (acc_st);
+
+ cp = gfc_state_stack->tail;
+ push_state (&s, COMP_OMP_STRUCTURED_BLOCK, NULL);
+ np = new_level (cp);
+ np->op = cp->op;
+ np->block = NULL;
+
+ for (;;)
+ {
+ st = next_statement ();
+ if (st == ST_NONE)
+ unexpected_eof ();
+ else if (st == ST_DO)
+ break;
+ else
+ unexpected_statement (st);
+ }
+
+ parse_do_block ();
+ if (gfc_statement_label != NULL
+ && gfc_state_stack->previous != NULL
+ && gfc_state_stack->previous->state == COMP_DO
+ && gfc_state_stack->previous->ext.end_do_label == gfc_statement_label)
+ {
+ pop_state ();
+ return ST_IMPLIED_ENDDO;
+ }
+
+ check_do_closure ();
+ pop_state ();
+
+ st = next_statement ();
+ if ((acc_st == ST_OACC_PARALLEL_LOOP && st == ST_OACC_END_PARALLEL_LOOP) ||
+ (acc_st == ST_OACC_KERNELS_LOOP && st == ST_OACC_END_KERNELS_LOOP))
+ {
+ gcc_assert (new_st.op == EXEC_NOP);
+ gfc_clear_new_st ();
+ gfc_commit_symbols ();
+ gfc_warning_check ();
+ st = next_statement ();
+ }
+ return st;
+}
+
+
/* Parse the statements of an OpenMP structured block. */
static void
@@ -3910,6 +4249,21 @@ parse_executable (gfc_statement st)
parse_forall_block ();
break;
+ case ST_OACC_PARALLEL_LOOP:
+ case ST_OACC_KERNELS_LOOP:
+ case ST_OACC_LOOP:
+ st = parse_oacc_loop (st);
+ if (st == ST_IMPLIED_ENDDO)
+ return st;
+ continue;
+
+ case ST_OACC_PARALLEL:
+ case ST_OACC_KERNELS:
+ case ST_OACC_DATA:
+ case ST_OACC_HOST_DATA:
+ parse_oacc_structured_block (st);
+ break;
+
case ST_OMP_PARALLEL:
case ST_OMP_PARALLEL_SECTIONS:
case ST_OMP_SECTIONS:
@@ -4220,6 +4574,11 @@ contains:
done:
gfc_current_ns->code = gfc_state_stack->head;
+ if (gfc_state_stack->state == COMP_PROGRAM
+ || gfc_state_stack->state == COMP_MODULE
+ || gfc_state_stack->state == COMP_SUBROUTINE
+ || gfc_state_stack->state == COMP_FUNCTION)
+ gfc_current_ns->declare_clauses = gfc_state_stack->ext.declare_clauses;
}
diff --git a/gcc/fortran/parse.h b/gcc/fortran/parse.h
index 44b8f8b..8f87dd4 100644
--- a/gcc/fortran/parse.h
+++ b/gcc/fortran/parse.h
@@ -49,6 +49,7 @@ typedef struct gfc_state_data
union
{
gfc_st_label *end_do_label;
+ gfc_omp_clauses *declare_clauses;
}
ext;
}
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index ad088bb..80aa4ee 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -8980,6 +8980,18 @@ gfc_resolve_blocks (gfc_code *b, gfc_namespace *ns)
case EXEC_WAIT:
break;
+ case EXEC_OACC_PARALLEL_LOOP:
+ case EXEC_OACC_PARALLEL:
+ case EXEC_OACC_KERNELS_LOOP:
+ case EXEC_OACC_KERNELS:
+ case EXEC_OACC_DATA:
+ case EXEC_OACC_HOST_DATA:
+ case EXEC_OACC_LOOP:
+ case EXEC_OACC_UPDATE:
+ case EXEC_OACC_WAIT:
+ case EXEC_OACC_CACHE:
+ case EXEC_OACC_ENTER_DATA:
+ case EXEC_OACC_EXIT_DATA:
case EXEC_OMP_ATOMIC:
case EXEC_OMP_CRITICAL:
case EXEC_OMP_DO:
@@ -9729,6 +9741,15 @@ resolve_code (gfc_code *code, gfc_namespace *ns)
omp_workshare_save = -1;
switch (code->op)
{
+ case EXEC_OACC_PARALLEL_LOOP:
+ case EXEC_OACC_PARALLEL:
+ case EXEC_OACC_KERNELS_LOOP:
+ case EXEC_OACC_KERNELS:
+ case EXEC_OACC_DATA:
+ case EXEC_OACC_HOST_DATA:
+ case EXEC_OACC_LOOP:
+ gfc_resolve_oacc_blocks (code, ns);
+ break;
case EXEC_OMP_PARALLEL_WORKSHARE:
omp_workshare_save = omp_workshare_flag;
omp_workshare_flag = 1;
@@ -10055,6 +10076,21 @@ resolve_code (gfc_code *code, gfc_namespace *ns)
"expression", &code->expr1->where);
break;
+ case EXEC_OACC_PARALLEL_LOOP:
+ case EXEC_OACC_PARALLEL:
+ case EXEC_OACC_KERNELS_LOOP:
+ case EXEC_OACC_KERNELS:
+ case EXEC_OACC_DATA:
+ case EXEC_OACC_HOST_DATA:
+ case EXEC_OACC_LOOP:
+ case EXEC_OACC_UPDATE:
+ case EXEC_OACC_WAIT:
+ case EXEC_OACC_CACHE:
+ case EXEC_OACC_ENTER_DATA:
+ case EXEC_OACC_EXIT_DATA:
+ gfc_resolve_oacc_directive (code, ns);
+ break;
+
case EXEC_OMP_ATOMIC:
case EXEC_OMP_BARRIER:
case EXEC_OMP_CRITICAL:
diff --git a/gcc/fortran/scanner.c b/gcc/fortran/scanner.c
index 8f51734..1f99662 100644
--- a/gcc/fortran/scanner.c
+++ b/gcc/fortran/scanner.c
@@ -55,9 +55,11 @@ gfc_directorylist *include_dirs, *intrinsic_modules_dirs;
static gfc_file *file_head, *current_file;
-static int continue_flag, end_flag, openmp_flag, gcc_attribute_flag;
+static int continue_flag, end_flag, gcc_attribute_flag;
+static int openmp_flag, openacc_flag; /* If !$omp/!&acc occurred in current comment line */
static int continue_count, continue_line;
static locus openmp_locus;
+static locus openacc_locus;
static locus gcc_attribute_locus;
gfc_source_form gfc_current_form;
@@ -710,11 +712,89 @@ skip_gcc_attribute (locus start)
return r;
}
+/* Return true if CC was matched. */
+static bool
+skip_oacc_attribute (locus start, locus old_loc, bool continue_flag)
+{
+ bool r = false;
+ char c;
+ if ((c = next_char ()) == 'c' || c == 'C')
+ if ((c = next_char ()) == 'c' || c == 'C')
+ r = true;
+
+ if (r)
+ {
+ if ((c = next_char ()) == ' ' || c == '\t'
+ || continue_flag)
+ {
+ while (gfc_is_whitespace (c))
+ c = next_char ();
+ if (c != '\n' && c != '!')
+ {
+ openacc_flag = 1;
+ openacc_locus = old_loc;
+ gfc_current_locus = start;
+ }
+ else
+ r = false;
+ }
+ else
+ {
+ gfc_warning_now ("!$ACC at %C starts a commented "
+ "line as it neither is followed "
+ "by a space nor is a "
+ "continuation line");
+ r = false;
+ }
+ }
+
+ return r;
+}
+
+/* Return true if MP was matched. */
+static bool
+skip_omp_attribute (locus start, locus old_loc, bool continue_flag)
+{
+ bool r = false;
+ char c;
+
+ if ((c = next_char ()) == 'm' || c == 'M')
+ if ((c = next_char ()) == 'p' || c == 'P')
+ r = true;
+
+ if (r)
+ {
+ if ((c = next_char ()) == ' ' || c == '\t'
+ || continue_flag)
+ {
+ while (gfc_is_whitespace (c))
+ c = next_char ();
+ if (c != '\n' && c != '!')
+ {
+ openmp_flag = 1;
+ openmp_locus = old_loc;
+ gfc_current_locus = start;
+ }
+ else
+ r = false;
+ }
+ else
+ {
+ gfc_warning_now ("!$OMP at %C starts a commented "
+ "line as it neither is followed "
+ "by a space nor is a "
+ "continuation line");
+ r = false;
+ }
+ }
+
+ return r;
+}
/* Comment lines are null lines, lines containing only blanks or lines
on which the first nonblank line is a '!'.
- Return true if !$ openmp conditional compilation sentinel was
+ Return true if !$ openmp or openacc conditional compilation sentinel was
seen. */
static bool
@@ -747,55 +827,95 @@ skip_free_comments (void)
if (at_bol && skip_gcc_attribute (start))
return false;
- /* If -fopenmp, we need to handle here 2 things:
- 1) don't treat !$omp as comments, but directives
- 2) handle OpenMP conditional compilation, where
+ /* If -fopenmp/-fopenacc, we need to handle here 2 things:
+ 1) don't treat !$omp/!$acc as comments, but directives
+ 2) handle OpenMP/OpenACC conditional compilation, where
!$ should be treated as 2 spaces (for initial lines
only if followed by space). */
- if (gfc_option.gfc_flag_openmp && at_bol)
- {
- locus old_loc = gfc_current_locus;
- if (next_char () == '$')
- {
- c = next_char ();
- if (c == 'o' || c == 'O')
- {
- if (((c = next_char ()) == 'm' || c == 'M')
- && ((c = next_char ()) == 'p' || c == 'P'))
- {
- if ((c = next_char ()) == ' ' || c == '\t'
- || continue_flag)
- {
- while (gfc_is_whitespace (c))
- c = next_char ();
- if (c != '\n' && c != '!')
- {
- openmp_flag = 1;
- openmp_locus = old_loc;
- gfc_current_locus = start;
- return false;
- }
- }
- else
- gfc_warning_now ("!$OMP at %C starts a commented "
- "line as it neither is followed "
- "by a space nor is a "
- "continuation line");
- }
- gfc_current_locus = old_loc;
- next_char ();
- c = next_char ();
- }
- if (continue_flag || c == ' ' || c == '\t')
- {
- gfc_current_locus = old_loc;
- next_char ();
- openmp_flag = 0;
- return true;
- }
- }
- gfc_current_locus = old_loc;
- }
+ if (at_bol)
+ {
+ if (gfc_option.gfc_flag_openmp && gfc_option.gfc_flag_openacc)
+ {
+ locus old_loc = gfc_current_locus;
+ if (next_char () == '$')
+ {
+ c = next_char ();
+ if (c == 'o' || c == 'O')
+ {
+ if (skip_omp_attribute (start, old_loc, continue_flag))
+ return false;
+ gfc_current_locus = old_loc;
+ next_char ();
+ c = next_char ();
+ }
+ else if (c == 'a' || c == 'A')
+ {
+ if (skip_oacc_attribute (start, old_loc, continue_flag))
+ return false;
+ gfc_current_locus = old_loc;
+ next_char ();
+ c = next_char ();
+ }
+ if (continue_flag || c == ' ' || c == '\t')
+ {
+ gfc_current_locus = old_loc;
+ next_char ();
+ openmp_flag = openacc_flag = 0;
+ return true;
+ }
+ }
+ gfc_current_locus = old_loc;
+ }
+ else if (gfc_option.gfc_flag_openmp&& !gfc_option.gfc_flag_openacc)
+ {
+ locus old_loc = gfc_current_locus;
+ if (next_char () == '$')
+ {
+ c = next_char ();
+ if (c == 'o' || c == 'O')
+ {
+ if (skip_omp_attribute (start, old_loc, continue_flag))
+ return false;
+ gfc_current_locus = old_loc;
+ next_char ();
+ c = next_char ();
+ }
+ if (continue_flag || c == ' ' || c == '\t')
+ {
+ gfc_current_locus = old_loc;
+ next_char ();
+ openmp_flag = 0;
+ return true;
+ }
+ }
+ gfc_current_locus = old_loc;
+ }
+ else if (gfc_option.gfc_flag_openacc && !gfc_option.gfc_flag_openmp)
+ {
+ locus old_loc = gfc_current_locus;
+ if (next_char() == '$')
+ {
+ c = next_char();
+ if (c == 'a' || c == 'A')
+ {
+ if (skip_oacc_attribute (start, old_loc,
+ continue_flag))
+ return false;
+ gfc_current_locus = old_loc;
+ next_char();
+ c = next_char();
+ }
+ if (continue_flag || c == ' ' || c == '\t')
+ {
+ gfc_current_locus = old_loc;
+ next_char();
+ openacc_flag = 0;
+ return true;
+ }
+ }
+ gfc_current_locus = old_loc;
+ }
+ }
skip_comment_line ();
continue;
}
@@ -806,6 +926,9 @@ skip_free_comments (void)
if (openmp_flag && at_bol)
openmp_flag = 0;
+ if (openacc_flag && at_bol)
+ openacc_flag = 0;
+
gcc_attribute_flag = 0;
gfc_current_locus = start;
return false;
@@ -868,9 +991,10 @@ skip_fixed_comments (void)
return;
}
- /* If -fopenmp, we need to handle here 2 things:
- 1) don't treat !$omp|c$omp|*$omp as comments, but directives
- 2) handle OpenMP conditional compilation, where
+ /* If -fopenmp/-fopenacc, we need to handle here 2 things:
+ 1) don't treat !$omp/!$acc|c$omp/c$acc|*$omp / *$acc as comments,
+ but directives
+ 2) handle OpenMP/OpenACC conditional compilation, where
!$|c$|*$ should be treated as 2 spaces if the characters
in columns 3 to 6 are valid fixed form label columns
characters. */
@@ -937,6 +1061,67 @@ skip_fixed_comments (void)
}
gfc_current_locus = start;
}
+
+ if (gfc_option.gfc_flag_openacc)
+ {
+ if (next_char () == '$')
+ {
+ c = next_char ();
+ if (c == 'a' || c == 'A')
+ {
+ if (((c = next_char ()) == 'c' || c == 'C')
+ && ((c = next_char ()) == 'c' || c == 'C'))
+ {
+ c = next_char ();
+ if (c != '\n'
+ && ((openacc_flag && continue_flag)
+ || c == ' ' || c == '\t' || c == '0'))
+ {
+ do
+ c = next_char ();
+ while (gfc_is_whitespace (c));
+ if (c != '\n' && c != '!')
+ {
+ /* Canonicalize to *$acc. */
+ *start.nextc = '*';
+ openacc_flag = 1;
+ gfc_current_locus = start;
+ return;
+ }
+ }
+ }
+ }
+ else
+ {
+ int digit_seen = 0;
+
+ for (col = 3; col < 6; col++, c = next_char ())
+ if (c == ' ')
+ continue;
+ else if (c == '\t')
+ {
+ col = 6;
+ break;
+ }
+ else if (c < '0' || c > '9')
+ break;
+ else
+ digit_seen = 1;
+
+ if (col == 6 && c != '\n'
+ && ((continue_flag && !digit_seen)
+ || c == ' ' || c == '\t' || c == '0'))
+ {
+ gfc_current_locus = start;
+ start.nextc[0] = ' ';
+ start.nextc[1] = ' ';
+ continue;
+ }
+ }
+ }
+ gfc_current_locus = start;
+ }
+
skip_comment_line ();
continue;
}
@@ -1007,10 +1192,11 @@ gfc_char_t
gfc_next_char_literal (gfc_instring in_string)
{
locus old_loc;
- int i, prev_openmp_flag;
+ int i, prev_openmp_flag, prev_openacc_flag;
gfc_char_t c;
continue_flag = 0;
+ prev_openacc_flag = prev_openmp_flag = 0;
restart:
c = next_char ();
@@ -1036,6 +1222,11 @@ restart:
sizeof (gfc_current_locus)) == 0)
goto done;
+ if (openacc_flag
+ && memcmp (&gfc_current_locus, &openacc_locus,
+ sizeof (gfc_current_locus)) == 0)
+ goto done;
+
/* This line can't be continued */
do
{
@@ -1090,7 +1281,11 @@ restart:
goto done;
}
- prev_openmp_flag = openmp_flag;
+ if (gfc_option.gfc_flag_openmp)
+ prev_openmp_flag = openmp_flag;
+ if (gfc_option.gfc_flag_openacc)
+ prev_openacc_flag = openacc_flag;
+
continue_flag = 1;
if (c == '!')
skip_comment_line ();
@@ -1120,13 +1315,23 @@ restart:
&& continue_line < gfc_linebuf_linenum (gfc_current_locus.lb))
continue_line = gfc_linebuf_linenum (gfc_current_locus.lb);
- if (prev_openmp_flag != openmp_flag)
- {
- gfc_current_locus = old_loc;
- openmp_flag = prev_openmp_flag;
- c = '&';
- goto done;
- }
+ if (gfc_option.gfc_flag_openmp)
+ if (prev_openmp_flag != openmp_flag)
+ {
+ gfc_current_locus = old_loc;
+ openmp_flag = prev_openmp_flag;
+ c = '&';
+ goto done;
+ }
+
+ if (gfc_option.gfc_flag_openacc)
+ if (prev_openacc_flag != openacc_flag)
+ {
+ gfc_current_locus = old_loc;
+ openacc_flag = prev_openacc_flag;
+ c = '&';
+ goto done;
+ }
/* Now that we have a non-comment line, probe ahead for the
first non-whitespace character. If it is another '&', then
@@ -1150,6 +1355,17 @@ restart:
while (gfc_is_whitespace (c))
c = next_char ();
}
+ if (openacc_flag)
+ {
+ for (i = 0; i < 5; i++, c = next_char ())
+ {
+ gcc_assert(gfc_wide_tolower (c) == (unsigned char ) "!$acc"[i]);
+ if (i == 4)
+ old_loc = gfc_current_locus;
+ }
+ while (gfc_is_whitespace (c))
+ c = next_char ();
+ }
if (c != '&')
{
@@ -1162,7 +1378,7 @@ restart:
}
/* Both !$omp and !$ -fopenmp continuation lines have & on the
continuation line only optionally. */
- else if (openmp_flag || openmp_cond_flag)
+ else if (openmp_flag || openacc_flag || openmp_cond_flag)
gfc_current_locus.nextc--;
else
{
@@ -1199,7 +1415,11 @@ restart:
gfc_warning_now ("Line truncated at %L", &gfc_current_locus);
}
- prev_openmp_flag = openmp_flag;
+ if (gfc_option.gfc_flag_openmp)
+ prev_openmp_flag = openmp_flag;
+ if (gfc_option.gfc_flag_openacc)
+ prev_openacc_flag = openacc_flag;
+
continue_flag = 1;
old_loc = gfc_current_locus;
@@ -1207,26 +1427,40 @@ restart:
skip_fixed_comments ();
/* See if this line is a continuation line. */
- if (openmp_flag != prev_openmp_flag)
- {
- openmp_flag = prev_openmp_flag;
- goto not_continuation;
- }
-
- if (!openmp_flag)
+ if (gfc_option.gfc_flag_openmp)
+ if (openmp_flag != prev_openmp_flag)
+ {
+ openmp_flag = prev_openmp_flag;
+ goto not_continuation;
+ }
+ if (gfc_option.gfc_flag_openacc)
+ if (openacc_flag != prev_openacc_flag)
+ {
+ openacc_flag = prev_openacc_flag;
+ goto not_continuation;
+ }
+
+ if (!openmp_flag && !openacc_flag)
for (i = 0; i < 5; i++)
{
c = next_char ();
if (c != ' ')
goto not_continuation;
}
- else
+ else if (openmp_flag)
for (i = 0; i < 5; i++)
{
c = next_char ();
if (gfc_wide_tolower (c) != (unsigned char) "*$omp"[i])
goto not_continuation;
}
+ else if (openacc_flag)
+ for (i = 0; i > 5; i++)
+ {
+ c = next_char ();
+ if (gfc_wide_tolower (c) != (unsigned char) "*$omp"[i])
+ goto not_continuation;
+ }
c = next_char ();
if (c == '0' || c == ' ' || c == '\n')
diff --git a/gcc/fortran/st.c b/gcc/fortran/st.c
index 0e1cc70..b582efe 100644
--- a/gcc/fortran/st.c
+++ b/gcc/fortran/st.c
@@ -185,6 +185,18 @@ gfc_free_statement (gfc_code *p)
gfc_free_forall_iterator (p->ext.forall_iterator);
break;
+ case EXEC_OACC_PARALLEL_LOOP:
+ case EXEC_OACC_PARALLEL:
+ case EXEC_OACC_KERNELS_LOOP:
+ case EXEC_OACC_KERNELS:
+ case EXEC_OACC_DATA:
+ case EXEC_OACC_HOST_DATA:
+ case EXEC_OACC_LOOP:
+ case EXEC_OACC_UPDATE:
+ case EXEC_OACC_WAIT:
+ case EXEC_OACC_CACHE:
+ case EXEC_OACC_ENTER_DATA:
+ case EXEC_OACC_EXIT_DATA:
case EXEC_OMP_DO:
case EXEC_OMP_END_SINGLE:
case EXEC_OMP_PARALLEL:
--
1.8.3.2
^ permalink raw reply [flat|nested] 89+ messages in thread
* Re: [PATCH 2/6] [GOMP4] OpenACC 1.0+ support in fortran front-end
2014-01-31 11:16 ` [PATCH 1/6] " Ilmir Usmanov
@ 2014-01-31 11:17 ` Ilmir Usmanov
2014-01-31 11:18 ` [PATCH 3/6] " Ilmir Usmanov
2014-02-09 23:10 ` [PATCH 2/6] " Tobias Burnus
2014-01-31 12:00 ` [PATCH 1/6] " Jakub Jelinek
2014-02-09 22:22 ` Tobias Burnus
2 siblings, 2 replies; 89+ messages in thread
From: Ilmir Usmanov @ 2014-01-31 11:17 UTC (permalink / raw)
To: Thomas Schwinge
Cc: Evgeny Gavrin, GarbuzovViacheslav, Dmitri Botcharnikov,
gcc-patches, jakub, fortran
[-- Attachment #1: Type: text/plain, Size: 1313 bytes --]
OpenACC 1.0 fortran FE support -- matching and resolving.
* openmp.c (gfc_free_omp_clauses): Remove also OpenACC clauses.
(gfc_free_exprlist): New function to clear expression list.
(match_oacc_exprlist): New function to match expression list.
(match_oacc_clause_gang): New function to match OpenACC 2.0 gang
clauses.
(OMP_CLAUSE_ASYNC, OMP_CLAUSE_NUM_GANGS,
OMP_CLAUSE_NUM_WORKERS, OMP_CLAUSE_VECTOR_LENGTH,
OMP_CLAUSE_COPY, OMP_CLAUSE_OACC_COPYIN,
OMP_CLAUSE_COPYOUT, OMP_CLAUSE_CREATE, OMP_CLAUSE_PRESENT,
OMP_CLAUSE_PRESENT_OR_COPY, OMP_CLAUSE_PRESENT_OR_COPYIN,
OMP_CLAUSE_PRESENT_OR_COPYOUT, OMP_CLAUSE_PRESENT_OR_CREATE,
OMP_CLAUSE_DEVICEPTR, OMP_CLAUSE_GANG, OMP_CLAUSE_WORKER,
OMP_CLAUSE_VECTOR, OMP_CLAUSE_SEQ, OMP_CLAUSE_INDEPENDENT,
OMP_CLAUSE_USE_DEVICE, OMP_CLAUSE_HOST, OMP_CLAUSE_DEVICE_RESIDENT,
OMP_CLAUSE_DEVICE, OMP_CLAUSE_DEFAULT, OMP_CLAUSE_WAIT,
OMP_CLAUSE_DELETE, OMP_CLAUSE_AUTO, OMP_CLAUSE_TILE): New clauses.
(OACC_PARALLEL_CLAUSES, OACC_KERNELS_CLAUSES, OACC_DATA_CLAUSES,
OACC_LOOP_CLAUSES, OACC_PARALLEL_LOOP_CLAUSES,
OACC_KERNELS_LOOP_CLAUSES, OACC_HOST_DATA_CLAUSES,
OACC_DECLARE_CLAUSES,
OACC_UPDATE_CLAUSES, OACC_ENTER_DATA_CLAUSES,
OACC_EXIT_DATA_CLAUSES): New defines.
[-- Attachment #2: 0002-OpenACC-fortran-front-end-part-2.patch --]
[-- Type: text/x-diff, Size: 34536 bytes --]
From 64b05eeeadf25fca4f92f083cc11aaad1a7a692a Mon Sep 17 00:00:00 2001
From: Ilmir Usmanov <i.usmanov@samsung.com>
Date: Fri, 31 Jan 2014 13:26:13 +0400
Subject: [PATCH 2/6] OpenACC fortran front-end -- part 2
---
gcc/fortran/openmp.c | 942 ++++++++++++++++++++++++++++++++++++++++++++++++++-
1 file changed, 940 insertions(+), 2 deletions(-)
diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index dff3ab1..d4e3ebd 100644
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -69,11 +69,36 @@ gfc_free_omp_clauses (gfc_omp_clauses *c)
gfc_free_expr (c->final_expr);
gfc_free_expr (c->num_threads);
gfc_free_expr (c->chunk_size);
+ gfc_free_expr (c->async_expr);
+ gfc_free_expr (c->gang_expr);
+ gfc_free_expr (c->worker_expr);
+ gfc_free_expr (c->vector_expr);
+ gfc_free_expr (c->num_gangs_expr);
+ gfc_free_expr (c->num_workers_expr);
+ gfc_free_expr (c->vector_length_expr);
+ gfc_free_expr (c->non_clause_wait_expr);
+
for (i = 0; i < OMP_LIST_NUM; i++)
gfc_free_namelist (c->lists[i]);
+
+ gfc_free_exprlist (c->waitlist);
+
free (c);
}
+/* Free expression list. */
+void
+gfc_free_exprlist (gfc_exprlist *list)
+{
+ gfc_exprlist *n;
+
+ for (; list; list = n)
+ {
+ n = list->next;
+ free (list);
+ }
+}
+
/* Match a variable/common block list and construct a namelist from it. */
static match
@@ -169,6 +194,87 @@ cleanup:
return MATCH_ERROR;
}
+static match
+match_oacc_exprlist (const char *str, gfc_exprlist **list, bool allow_asterisk)
+{
+ gfc_exprlist *head, *tail, *p;
+ locus old_loc;
+ gfc_expr *expr;
+ match m;
+
+ head = tail = NULL;
+
+ old_loc = gfc_current_locus;
+
+ m = gfc_match (str);
+ if (m != MATCH_YES)
+ return m;
+
+ for (;;)
+ {
+ m = gfc_match_expr (&expr);
+ if (m == MATCH_YES || allow_asterisk)
+ {
+ p = gfc_get_exprlist ();
+ if (head == NULL)
+ head = tail = p;
+ else
+ {
+ tail->next = p;
+ tail = tail->next;
+ }
+ if (m == MATCH_YES)
+ tail->expr = expr;
+ else if (gfc_match (" *") != MATCH_YES)
+ goto syntax;
+ goto next_item;
+ }
+ if (m == MATCH_ERROR)
+ goto cleanup;
+ goto syntax;
+
+ next_item:
+ if (gfc_match_char (')') == MATCH_YES)
+ break;
+ if (gfc_match_char (',') != MATCH_YES)
+ goto syntax;
+ }
+
+ while (*list)
+ list = &(*list)->next;
+
+ *list = head;
+ return MATCH_YES;
+
+syntax:
+ gfc_error ("Syntax error in OpenACC expression list at %C");
+
+cleanup:
+ gfc_free_exprlist (head);
+ gfc_current_locus = old_loc;
+ return MATCH_ERROR;
+}
+
+static match
+match_oacc_clause_gang (gfc_omp_clauses *cp)
+{
+ if (gfc_match_char ('(') != 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)
+ {
+ cp->gang_static = true;
+ if (gfc_match (" * )") != MATCH_YES)
+ return gfc_match (" %e )", &cp->gang_expr);
+ return MATCH_YES;
+ }
+ return gfc_match (" %e )", &cp->gang_expr);
+}
+
#define OMP_CLAUSE_PRIVATE (1 << 0)
#define OMP_CLAUSE_FIRSTPRIVATE (1 << 1)
#define OMP_CLAUSE_LASTPRIVATE (1 << 2)
@@ -186,11 +292,40 @@ cleanup:
#define OMP_CLAUSE_FINAL (1 << 14)
#define OMP_CLAUSE_MERGEABLE (1 << 15)
+/* OpenACC 2.0 clauses. */
+#define OMP_CLAUSE_ASYNC (1 << 16)
+#define OMP_CLAUSE_NUM_GANGS (1 << 17)
+#define OMP_CLAUSE_NUM_WORKERS (1 << 18)
+#define OMP_CLAUSE_VECTOR_LENGTH (1 << 19)
+#define OMP_CLAUSE_COPY (1 << 20)
+#define OMP_CLAUSE_COPYOUT (1 << 21)
+#define OMP_CLAUSE_CREATE (1 << 22)
+#define OMP_CLAUSE_PRESENT (1 << 23)
+#define OMP_CLAUSE_PRESENT_OR_COPY (1 << 24)
+#define OMP_CLAUSE_PRESENT_OR_COPYIN (1 << 25)
+#define OMP_CLAUSE_PRESENT_OR_COPYOUT (1 << 26)
+#define OMP_CLAUSE_PRESENT_OR_CREATE (1 << 27)
+#define OMP_CLAUSE_DEVICEPTR (1 << 28)
+#define OMP_CLAUSE_GANG (1 << 29)
+#define OMP_CLAUSE_WORKER (1 << 30)
+#define OMP_CLAUSE_VECTOR (1 << 31)
+#define OMP_CLAUSE_SEQ (1ll << 32)
+#define OMP_CLAUSE_INDEPENDENT (1ll << 33)
+#define OMP_CLAUSE_USE_DEVICE (1ll << 34)
+#define OMP_CLAUSE_DEVICE_RESIDENT (1ll << 35)
+#define OMP_CLAUSE_HOST (1ll << 36)
+#define OMP_CLAUSE_DEVICE (1ll << 37)
+#define OMP_CLAUSE_OACC_COPYIN (1ll << 38)
+#define OMP_CLAUSE_WAIT (1ll << 39)
+#define OMP_CLAUSE_DELETE (1ll << 40)
+#define OMP_CLAUSE_AUTO (1ll << 41)
+#define OMP_CLAUSE_TILE (1ll << 42)
+
/* Match OpenMP directive clauses. MASK is a bitmask of
clauses that are allowed for a particular directive. */
static match
-gfc_match_omp_clauses (gfc_omp_clauses **cp, int mask)
+gfc_match_omp_clauses (gfc_omp_clauses **cp, long long mask)
{
gfc_omp_clauses *c = gfc_get_omp_clauses ();
locus old_loc;
@@ -205,6 +340,52 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, int mask)
needs_space = false;
first = false;
gfc_gobble_whitespace ();
+ if ((mask & OMP_CLAUSE_ASYNC) && !c->async)
+ if (gfc_match ("async") == MATCH_YES)
+ {
+ c->async = true;
+ if (gfc_match (" ( %e )", &c->async_expr) == MATCH_YES)
+ needs_space = false;
+ else
+ needs_space = true;
+ continue;
+ }
+ if ((mask & OMP_CLAUSE_GANG) && !c->gang)
+ if (gfc_match ("gang") == MATCH_YES)
+ {
+ c->gang = true;
+ if (match_oacc_clause_gang(c) == MATCH_YES)
+ needs_space = false;
+ else
+ needs_space = true;
+ continue;
+ }
+ if ((mask & OMP_CLAUSE_WORKER) && !c->worker)
+ if (gfc_match ("worker") == MATCH_YES)
+ {
+ c->worker = true;
+ if (gfc_match (" ( num : %e )", &c->worker_expr) == MATCH_YES
+ || gfc_match (" ( %e )", &c->worker_expr) == MATCH_YES)
+ needs_space = false;
+ else
+ needs_space = true;
+ continue;
+ }
+ if ((mask & OMP_CLAUSE_VECTOR_LENGTH) && c->vector_length_expr == NULL
+ && gfc_match ("vector_length ( %e )", &c->vector_length_expr)
+ == MATCH_YES)
+ continue;
+ if ((mask & OMP_CLAUSE_VECTOR) && !c->vector)
+ if (gfc_match ("vector") == MATCH_YES)
+ {
+ c->vector = true;
+ if (gfc_match (" ( length : %e )", &c->vector_expr) == MATCH_YES
+ || gfc_match (" ( %e )", &c->vector_expr) == MATCH_YES)
+ needs_space = false;
+ else
+ needs_space = true;
+ continue;
+ }
if ((mask & OMP_CLAUSE_IF) && c->if_expr == NULL
&& gfc_match ("if ( %e )", &c->if_expr) == MATCH_YES)
continue;
@@ -247,6 +428,145 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, int mask)
&c->lists[OMP_LIST_COPYIN], true)
== MATCH_YES)
continue;
+ if ((mask & OMP_CLAUSE_NUM_GANGS) && c->num_gangs_expr == NULL
+ && gfc_match ("num_gangs ( %e )", &c->num_gangs_expr) == MATCH_YES)
+ continue;
+ if ((mask & OMP_CLAUSE_NUM_WORKERS) && c->num_workers_expr == NULL
+ && gfc_match ("num_workers ( %e )", &c->num_workers_expr)
+ == MATCH_YES)
+ continue;
+ if ((mask & OMP_CLAUSE_COPY)
+ && gfc_match_omp_variable_list ("copy (",
+ &c->lists[OMP_LIST_COPY], true)
+ == MATCH_YES)
+ continue;
+ if ((mask & OMP_CLAUSE_OACC_COPYIN)
+ && gfc_match_omp_variable_list ("copyin (",
+ &c->lists[OMP_LIST_OACC_COPYIN], true)
+ == MATCH_YES)
+ continue;
+ if ((mask & OMP_CLAUSE_COPYOUT)
+ && gfc_match_omp_variable_list ("copyout (",
+ &c->lists[OMP_LIST_COPYOUT], true)
+ == MATCH_YES)
+ continue;
+ if ((mask & OMP_CLAUSE_CREATE)
+ && gfc_match_omp_variable_list ("create (",
+ &c->lists[OMP_LIST_CREATE], true)
+ == MATCH_YES)
+ continue;
+ if ((mask & OMP_CLAUSE_DELETE)
+ && gfc_match_omp_variable_list ("delete (",
+ &c->lists[OMP_LIST_DELETE], true)
+ == MATCH_YES)
+ continue;
+ if ((mask & OMP_CLAUSE_PRESENT)
+ && gfc_match_omp_variable_list ("present (",
+ &c->lists[OMP_LIST_PRESENT], true)
+ == MATCH_YES)
+ continue;
+ if ((mask & OMP_CLAUSE_PRESENT_OR_COPY)
+ && gfc_match_omp_variable_list ("present_or_copy (",
+ &c->lists[OMP_LIST_PRESENT_OR_COPY], true)
+ == MATCH_YES)
+ continue;
+ if ((mask & OMP_CLAUSE_PRESENT_OR_COPY)
+ && gfc_match_omp_variable_list ("pcopy (",
+ &c->lists[OMP_LIST_PRESENT_OR_COPY], true)
+ == MATCH_YES)
+ continue;
+ if ((mask & OMP_CLAUSE_PRESENT_OR_COPYIN)
+ && gfc_match_omp_variable_list ("present_or_copyin (",
+ &c->lists[OMP_LIST_PRESENT_OR_COPYIN],
+ true)
+ == MATCH_YES)
+ continue;
+ if ((mask & OMP_CLAUSE_PRESENT_OR_COPYIN)
+ && gfc_match_omp_variable_list ("pcopyin (",
+ &c->lists[OMP_LIST_PRESENT_OR_COPYIN],
+ true)
+ == MATCH_YES)
+ continue;
+ if ((mask & OMP_CLAUSE_PRESENT_OR_COPYOUT)
+ && gfc_match_omp_variable_list ("present_or_copyout (",
+ &c->lists[OMP_LIST_PRESENT_OR_COPYOUT],
+ true)
+ == MATCH_YES)
+ continue;
+ if ((mask & OMP_CLAUSE_PRESENT_OR_COPYOUT)
+ && gfc_match_omp_variable_list ("pcopyout (",
+ &c->lists[OMP_LIST_PRESENT_OR_COPYOUT],
+ true)
+ == MATCH_YES)
+ continue;
+ if ((mask & OMP_CLAUSE_PRESENT_OR_CREATE)
+ && gfc_match_omp_variable_list ("present_or_create (",
+ &c->lists[OMP_LIST_PRESENT_OR_CREATE],
+ true)
+ == MATCH_YES)
+ continue;
+ if ((mask & OMP_CLAUSE_PRESENT_OR_CREATE)
+ && gfc_match_omp_variable_list ("pcreate (",
+ &c->lists[OMP_LIST_PRESENT_OR_CREATE],
+ true)
+ == MATCH_YES)
+ continue;
+ if ((mask & OMP_CLAUSE_DEVICEPTR)
+ && gfc_match_omp_variable_list ("deviceptr (",
+ &c->lists[OMP_LIST_DEVICEPTR], true)
+ == MATCH_YES)
+ continue;
+ if ((mask & OMP_CLAUSE_USE_DEVICE)
+ && gfc_match_omp_variable_list ("use_device (",
+ &c->lists[OMP_LIST_USE_DEVICE], true)
+ == MATCH_YES)
+ continue;
+ if ((mask & OMP_CLAUSE_DEVICE_RESIDENT)
+ && gfc_match_omp_variable_list ("device_resident (",
+ &c->lists[OMP_LIST_DEVICE_RESIDENT], true)
+ == MATCH_YES)
+ continue;
+ if ((mask & OMP_CLAUSE_HOST)
+ && gfc_match_omp_variable_list ("host (",
+ &c->lists[OMP_LIST_HOST], true)
+ == MATCH_YES)
+ continue;
+ if ((mask & OMP_CLAUSE_DEVICE)
+ && gfc_match_omp_variable_list ("device (",
+ &c->lists[OMP_LIST_DEVICE], true)
+ == MATCH_YES)
+ continue;
+ if ((mask & OMP_CLAUSE_TILE)
+ && match_oacc_exprlist ("tile (", &c->tilelist, true) == MATCH_YES)
+ continue;
+ if ((mask & OMP_CLAUSE_SEQ) && !c->seq
+ && gfc_match ("seq") == MATCH_YES)
+ {
+ c->seq = true;
+ needs_space = true;
+ continue;
+ }
+ if ((mask & OMP_CLAUSE_INDEPENDENT) && !c->independent
+ && gfc_match ("independent") == MATCH_YES)
+ {
+ c->independent = true;
+ needs_space = true;
+ continue;
+ }
+ if ((mask & OMP_CLAUSE_AUTO) && !c->par_auto
+ && gfc_match ("auto") == MATCH_YES)
+ {
+ c->par_auto = true;
+ needs_space = true;
+ continue;
+ }
+ if ((mask & OMP_CLAUSE_WAIT) && !c->wait
+ && gfc_match ("wait") == MATCH_YES)
+ {
+ c->wait = true;
+ match_oacc_exprlist (" (", &c->waitlist, false);
+ continue;
+ }
old_loc = gfc_current_locus;
if ((mask & OMP_CLAUSE_REDUCTION)
&& gfc_match ("reduction ( ") == MATCH_YES)
@@ -433,6 +753,52 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, int mask)
return MATCH_YES;
}
+#define OACC_PARALLEL_CLAUSES \
+ (OMP_CLAUSE_IF | OMP_CLAUSE_ASYNC | OMP_CLAUSE_NUM_GANGS \
+ | OMP_CLAUSE_NUM_WORKERS | OMP_CLAUSE_VECTOR_LENGTH | OMP_CLAUSE_REDUCTION \
+ | OMP_CLAUSE_COPY | OMP_CLAUSE_OACC_COPYIN | OMP_CLAUSE_COPYOUT \
+ | OMP_CLAUSE_CREATE | OMP_CLAUSE_PRESENT | OMP_CLAUSE_PRESENT_OR_COPY \
+ | OMP_CLAUSE_PRESENT_OR_COPYIN | OMP_CLAUSE_PRESENT_OR_COPYOUT \
+ | OMP_CLAUSE_PRESENT_OR_CREATE | OMP_CLAUSE_DEVICEPTR | OMP_CLAUSE_PRIVATE \
+ | OMP_CLAUSE_FIRSTPRIVATE | OMP_CLAUSE_DEFAULT | OMP_CLAUSE_WAIT)
+#define OACC_KERNELS_CLAUSES \
+ (OMP_CLAUSE_IF | OMP_CLAUSE_ASYNC | OMP_CLAUSE_DEVICEPTR \
+ | OMP_CLAUSE_COPY | OMP_CLAUSE_OACC_COPYIN | OMP_CLAUSE_COPYOUT \
+ | OMP_CLAUSE_CREATE | OMP_CLAUSE_PRESENT | OMP_CLAUSE_PRESENT_OR_COPY \
+ | OMP_CLAUSE_PRESENT_OR_COPYIN | OMP_CLAUSE_PRESENT_OR_COPYOUT \
+ | OMP_CLAUSE_PRESENT_OR_CREATE | OMP_CLAUSE_DEFAULT | OMP_CLAUSE_WAIT)
+#define OACC_DATA_CLAUSES \
+ (OMP_CLAUSE_IF | OMP_CLAUSE_DEVICEPTR | OMP_CLAUSE_COPY \
+ | OMP_CLAUSE_OACC_COPYIN | OMP_CLAUSE_COPYOUT | OMP_CLAUSE_CREATE \
+ | OMP_CLAUSE_PRESENT | OMP_CLAUSE_PRESENT_OR_COPY \
+ | OMP_CLAUSE_PRESENT_OR_COPYIN | OMP_CLAUSE_PRESENT_OR_COPYOUT \
+ | OMP_CLAUSE_PRESENT_OR_CREATE)
+#define OACC_LOOP_CLAUSES \
+ (OMP_CLAUSE_COLLAPSE | OMP_CLAUSE_GANG | OMP_CLAUSE_WORKER \
+ | OMP_CLAUSE_VECTOR | OMP_CLAUSE_SEQ | OMP_CLAUSE_INDEPENDENT \
+ | OMP_CLAUSE_PRIVATE | OMP_CLAUSE_REDUCTION | OMP_CLAUSE_AUTO \
+ | OMP_CLAUSE_TILE)
+#define OACC_PARALLEL_LOOP_CLAUSES \
+ (OACC_LOOP_CLAUSES | OACC_PARALLEL_CLAUSES)
+#define OACC_KERNELS_LOOP_CLAUSES \
+ (OACC_LOOP_CLAUSES | OACC_KERNELS_CLAUSES)
+#define OACC_HOST_DATA_CLAUSES OMP_CLAUSE_USE_DEVICE
+#define OACC_DECLARE_CLAUSES \
+ (OMP_CLAUSE_COPY | OMP_CLAUSE_OACC_COPYIN | OMP_CLAUSE_COPYOUT \
+ | OMP_CLAUSE_CREATE | OMP_CLAUSE_DEVICEPTR | OMP_CLAUSE_DEVICE_RESIDENT \
+ | OMP_CLAUSE_PRESENT | OMP_CLAUSE_PRESENT_OR_COPY \
+ | OMP_CLAUSE_PRESENT_OR_COPYIN | OMP_CLAUSE_PRESENT_OR_COPYOUT \
+ | OMP_CLAUSE_PRESENT_OR_CREATE)
+#define OACC_UPDATE_CLAUSES \
+ (OMP_CLAUSE_IF | OMP_CLAUSE_ASYNC | OMP_CLAUSE_HOST | OMP_CLAUSE_DEVICE)
+#define OACC_ENTER_DATA_CLAUSES \
+ (OMP_CLAUSE_IF | OMP_CLAUSE_ASYNC | OMP_CLAUSE_WAIT | OMP_CLAUSE_OACC_COPYIN \
+ | OMP_CLAUSE_CREATE | OMP_CLAUSE_PRESENT_OR_COPYIN \
+ | OMP_CLAUSE_PRESENT_OR_CREATE)
+#define OACC_EXIT_DATA_CLAUSES \
+ (OMP_CLAUSE_IF | OMP_CLAUSE_ASYNC | OMP_CLAUSE_WAIT | OMP_CLAUSE_COPYOUT \
+ | OMP_CLAUSE_DELETE)
+
#define OMP_PARALLEL_CLAUSES \
(OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE | OMP_CLAUSE_SHARED \
| OMP_CLAUSE_COPYIN | OMP_CLAUSE_REDUCTION | OMP_CLAUSE_IF \
@@ -449,6 +815,185 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, int mask)
| OMP_CLAUSE_IF | OMP_CLAUSE_DEFAULT | OMP_CLAUSE_UNTIED \
| OMP_CLAUSE_FINAL | OMP_CLAUSE_MERGEABLE)
+
+match
+gfc_match_oacc_parallel_loop (void)
+{
+ gfc_omp_clauses *c;
+ if (gfc_match_omp_clauses (&c, OACC_PARALLEL_LOOP_CLAUSES) != MATCH_YES)
+ return MATCH_ERROR;
+
+ new_st.op = EXEC_OACC_PARALLEL_LOOP;
+ new_st.ext.omp_clauses = c;
+ return MATCH_YES;
+}
+
+
+match
+gfc_match_oacc_parallel (void)
+{
+ gfc_omp_clauses *c;
+ if (gfc_match_omp_clauses (&c, OACC_PARALLEL_CLAUSES) != MATCH_YES)
+ return MATCH_ERROR;
+
+ new_st.op = EXEC_OACC_PARALLEL;
+ new_st.ext.omp_clauses = c;
+ return MATCH_YES;
+}
+
+
+match
+gfc_match_oacc_kernels_loop (void)
+{
+ gfc_omp_clauses *c;
+ if (gfc_match_omp_clauses (&c, OACC_KERNELS_LOOP_CLAUSES) != MATCH_YES)
+ return MATCH_ERROR;
+
+ new_st.op = EXEC_OACC_KERNELS_LOOP;
+ new_st.ext.omp_clauses = c;
+ return MATCH_YES;
+}
+
+
+match
+gfc_match_oacc_kernels (void)
+{
+ gfc_omp_clauses *c;
+ if (gfc_match_omp_clauses (&c, OACC_KERNELS_CLAUSES) != MATCH_YES)
+ return MATCH_ERROR;
+
+ new_st.op = EXEC_OACC_KERNELS;
+ new_st.ext.omp_clauses = c;
+ return MATCH_YES;
+}
+
+
+match
+gfc_match_oacc_data (void)
+{
+ gfc_omp_clauses *c;
+ if (gfc_match_omp_clauses (&c, OACC_DATA_CLAUSES) != MATCH_YES)
+ return MATCH_ERROR;
+
+ new_st.op = EXEC_OACC_DATA;
+ new_st.ext.omp_clauses = c;
+ return MATCH_YES;
+}
+
+
+match
+gfc_match_oacc_host_data (void)
+{
+ gfc_omp_clauses *c;
+ if (gfc_match_omp_clauses (&c, OACC_HOST_DATA_CLAUSES) != MATCH_YES)
+ return MATCH_ERROR;
+
+ new_st.op = EXEC_OACC_HOST_DATA;
+ new_st.ext.omp_clauses = c;
+ return MATCH_YES;
+}
+
+
+match
+gfc_match_oacc_loop (void)
+{
+ gfc_omp_clauses *c;
+ if (gfc_match_omp_clauses (&c, OACC_LOOP_CLAUSES) != MATCH_YES)
+ return MATCH_ERROR;
+
+ new_st.op = EXEC_OACC_LOOP;
+ new_st.ext.omp_clauses = c;
+ return MATCH_YES;
+}
+
+
+match
+gfc_match_oacc_declare (void)
+{
+ gfc_omp_clauses *c;
+ if (gfc_match_omp_clauses (&c, OACC_DECLARE_CLAUSES) != MATCH_YES)
+ return MATCH_ERROR;
+
+ new_st.ext.omp_clauses = c;
+ return MATCH_YES;
+}
+
+
+match
+gfc_match_oacc_update (void)
+{
+ gfc_omp_clauses *c;
+ if (gfc_match_omp_clauses (&c, OACC_UPDATE_CLAUSES) != MATCH_YES)
+ return MATCH_ERROR;
+
+ new_st.op = EXEC_OACC_UPDATE;
+ new_st.ext.omp_clauses = c;
+ return MATCH_YES;
+}
+
+
+match
+gfc_match_oacc_enter_data (void)
+{
+ gfc_omp_clauses *c;
+ if (gfc_match_omp_clauses (&c, OACC_ENTER_DATA_CLAUSES) != MATCH_YES)
+ return MATCH_ERROR;
+
+ new_st.op = EXEC_OACC_ENTER_DATA;
+ new_st.ext.omp_clauses = c;
+ return MATCH_YES;
+}
+
+
+match
+gfc_match_oacc_exit_data (void)
+{
+ gfc_omp_clauses *c;
+ if (gfc_match_omp_clauses (&c, OACC_EXIT_DATA_CLAUSES) != MATCH_YES)
+ return MATCH_ERROR;
+
+ new_st.op = EXEC_OACC_EXIT_DATA;
+ new_st.ext.omp_clauses = c;
+ return MATCH_YES;
+}
+
+
+match
+gfc_match_oacc_wait (void)
+{
+ gfc_omp_clauses *c = gfc_get_omp_clauses ();
+ gfc_match (" ( %e )", &c->non_clause_wait_expr);
+
+ new_st.op = EXEC_OACC_WAIT;
+ new_st.ext.omp_clauses = c;
+ return MATCH_YES;
+}
+
+
+match
+gfc_match_oacc_cache (void)
+{
+ gfc_omp_clauses *c = gfc_get_omp_clauses ();
+ match m = gfc_match_omp_variable_list (" (",&c->lists[OMP_LIST_CACHE], true);
+ if (m != MATCH_YES)
+ {
+ gfc_free_omp_clauses(c);
+ return m;
+ }
+
+ if (gfc_current_state() != COMP_DO)
+ {
+ gfc_error ("ACC CACHE directive must be inside of loop %C");
+ gfc_free_omp_clauses(c);
+ return MATCH_ERROR;
+ }
+
+ new_st.op = EXEC_OACC_CACHE;
+ new_st.ext.omp_clauses = c;
+ return MATCH_YES;
+}
+
+
match
gfc_match_omp_parallel (void)
{
@@ -793,6 +1338,27 @@ gfc_match_omp_end_single (void)
}
+static void
+resolve_oacc_scalar_int_expr (gfc_expr *expr, const char *clause)
+{
+ if (!gfc_resolve_expr (expr)
+ || expr->ts.type != BT_INTEGER || expr->rank != 0)
+ gfc_error ("%s clause at %L requires a scalar INTEGER expression",
+ clause, &expr->where);
+}
+
+
+static void
+resolve_oacc_positive_int_expr (gfc_expr *expr, const char *clause)
+{
+ resolve_oacc_scalar_int_expr (expr, clause);
+ if (expr->expr_type == EXPR_CONSTANT && expr->ts.type == BT_INTEGER
+ && expr->value.integer->_mp_size <= 0)
+ gfc_warning ("INTEGER expression of %s clause at %L must be positive",
+ clause, &expr->where);
+}
+
+
/* OpenMP directive resolving routines. */
static void
@@ -800,10 +1366,14 @@ resolve_omp_clauses (gfc_code *code)
{
gfc_omp_clauses *omp_clauses = code->ext.omp_clauses;
gfc_namelist *n;
+ gfc_exprlist *el;
int list;
static const char *clause_names[]
= { "PRIVATE", "FIRSTPRIVATE", "LASTPRIVATE", "COPYPRIVATE", "SHARED",
- "COPYIN", "REDUCTION" };
+ "COPYIN", "COPY", "COPYIN", "COPYOUT", "CREATE", "DELETE",
+ "PRESENT", "PRESENT_OR_COPY", "PRESENT_OR_COPYIN", "PRESENT_OR_COPYOUT",
+ "PRESENT_OR_CREATE", "DEVICEPTR", "USE_DEVICE", "DEVICE_RESIDENT",
+ "HOST", "DEVICE", "CACHE", "REDUCTION"};
if (omp_clauses == NULL)
return;
@@ -933,8 +1503,43 @@ resolve_omp_clauses (gfc_code *code)
else
gcc_unreachable ();
+ if (list >= OMP_LIST_DATA_CLAUSE_FIRST
+ && list <= OMP_LIST_DATA_CLAUSE_LAST)
+ {
+ if (n->sym->ts.type == BT_DERIVED
+ && n->sym->attr.allocatable)
+ gfc_error ("ALLOCATABLE object '%s' of DERIVED type in %s clause at %L",
+ n->sym->name, name, &code->loc);
+ if (n->sym->ts.type == BT_DERIVED
+ && n->sym->attr.pointer)
+ gfc_error ("POINTER object '%s' of DERIVED type in %s clause at %L",
+ n->sym->name, name, &code->loc);
+ }
+
+ if (list > OMP_LIST_DATA_CLAUSE_LAST
+ && list < OMP_LIST_REDUCTION_FIRST)
+ {
+ if (n->sym->attr.pointer)
+ gfc_error ("POINTER object '%s' in %s clause at %L",
+ n->sym->name, name, &code->loc);
+ if (n->sym->as && n->sym->as->type == AS_ASSUMED_SIZE)
+ gfc_error ("Assumed size array '%s' in %s clause at %L",
+ n->sym->name, name, &code->loc);
+ }
+
switch (list)
{
+ case OMP_LIST_DEVICEPTR:
+ if (n->sym->attr.pointer)
+ gfc_error ("POINTER object '%s' in %s clause at %L",
+ n->sym->name, name, &code->loc);
+ if (n->sym->attr.allocatable)
+ gfc_error ("ALLOCATABLE object '%s' in %s clause at %L",
+ n->sym->name, name, &code->loc);
+ if (n->sym->attr.value)
+ gfc_error ("VALUE object '%s' in %s clause at %L",
+ n->sym->name, name, &code->loc);
+ break;
case OMP_LIST_COPYIN:
for (; n != NULL; n = n->next)
{
@@ -1059,6 +1664,25 @@ resolve_omp_clauses (gfc_code *code)
break;
}
}
+ if (omp_clauses->async)
+ if (omp_clauses->async_expr)
+ resolve_oacc_scalar_int_expr (omp_clauses->async_expr, "ASYNC");
+ 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");
+ 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");
+ if (omp_clauses->worker_expr)
+ resolve_oacc_positive_int_expr (omp_clauses->worker_expr, "WORKER");
+ if (omp_clauses->vector_expr)
+ resolve_oacc_positive_int_expr (omp_clauses->vector_expr, "VECTOR");
+ if (omp_clauses->wait)
+ if (omp_clauses->waitlist)
+ for (el = omp_clauses->waitlist; el; el = el->next)
+ resolve_oacc_positive_int_expr (el->expr, "WAIT");
}
@@ -1727,6 +2351,320 @@ resolve_omp_do (gfc_code *code)
}
}
+typedef struct omp_context oacc_context;
+oacc_context *oacc_current_ctx;
+
+static bool
+oacc_is_parallel (gfc_code *code)
+{
+ return code->op == EXEC_OACC_PARALLEL || code->op == EXEC_OACC_PARALLEL_LOOP;
+}
+
+static bool
+oacc_is_kernels (gfc_code *code)
+{
+ return code->op == EXEC_OACC_KERNELS || code->op == EXEC_OACC_KERNELS_LOOP;
+}
+
+static bool
+oacc_is_loop (gfc_code *code)
+{
+ return code->op == EXEC_OACC_PARALLEL_LOOP
+ || code->op == EXEC_OACC_KERNELS_LOOP
+ || code->op == EXEC_OACC_LOOP;
+}
+
+
+static void
+resolve_oacc_nested_loops (gfc_code *code, gfc_code* do_code, int collapse,
+ const char *clause)
+{
+ gfc_symbol *dovar;
+ gfc_code *c;
+ int i;
+
+ for (i = 1; i <= collapse; i++)
+ {
+ if (do_code->op == EXEC_DO_WHILE)
+ {
+ gfc_error ("!$ACC LOOP cannot be a DO WHILE or DO without loop control "
+ "at %L", &do_code->loc);
+ break;
+ }
+ gcc_assert (do_code->op == EXEC_DO);
+ if (do_code->ext.iterator->var->ts.type != BT_INTEGER)
+ gfc_error ("!$ACC LOOP iteration variable must be of type integer at %L",
+ &do_code->loc);
+ dovar = do_code->ext.iterator->var->symtree->n.sym;
+ if (i > 1)
+ {
+ gfc_code *do_code2 = code->block->next;
+ int j;
+
+ for (j = 1; j < i; j++)
+ {
+ gfc_symbol *ivar = do_code2->ext.iterator->var->symtree->n.sym;
+ if (dovar == ivar
+ || gfc_find_sym_in_expr (ivar, do_code->ext.iterator->start)
+ || gfc_find_sym_in_expr (ivar, do_code->ext.iterator->end)
+ || gfc_find_sym_in_expr (ivar, do_code->ext.iterator->step))
+ {
+ gfc_error ("!$ACC LOOP %s loops don't form rectangular iteration space at %L",
+ clause, &do_code->loc);
+ break;
+ }
+ if (j < i)
+ break;
+ do_code2 = do_code2->block->next;
+ }
+ }
+ if (i == collapse)
+ break;
+ for (c = do_code->next; c; c = c->next)
+ if (c->op != EXEC_NOP && c->op != EXEC_CONTINUE)
+ {
+ gfc_error ("%s !$ACC LOOP loops not perfectly nested at %L",
+ clause, &c->loc);
+ break;
+ }
+ if (c)
+ break;
+ do_code = do_code->block;
+ if (do_code->op != EXEC_DO && do_code->op != EXEC_DO_WHILE)
+ {
+ gfc_error ("not enough DO loops for %s !$ACC LOOP at %L",
+ clause, &code->loc);
+ break;
+ }
+ do_code = do_code->next;
+ if (do_code == NULL
+ || (do_code->op != EXEC_DO && do_code->op != EXEC_DO_WHILE))
+ {
+ gfc_error ("not enough DO loops for %s !$ACC LOOP at %L",
+ clause, &code->loc);
+ break;
+ }
+ }
+}
+
+static void
+resolve_oacc_params_in_parallel (gfc_code *code, const char *clause)
+{
+ oacc_context *c;
+
+ if (oacc_is_parallel (code))
+ gfc_error ("LOOP %s in PARALLEL section allows no argument or static at %L",
+ clause, &code->loc);
+ for (c = oacc_current_ctx; c; c = c->previous)
+ {
+ if (oacc_is_loop (c->code))
+ break;
+ if (oacc_is_parallel (c->code))
+ gfc_error ("LOOP %s in PARALLEL section allows no argument or static at %L",
+ clause, &code->loc);
+ }
+}
+
+
+static void
+resolve_oacc_loop_blocks (gfc_code *code)
+{
+ oacc_context *c;
+
+ if (!oacc_is_loop (code))
+ return;
+
+ if (code->op == EXEC_OACC_LOOP)
+ for (c = oacc_current_ctx; c; c = c->previous)
+ {
+ if (oacc_is_loop (c->code))
+ {
+ if (code->ext.omp_clauses->gang)
+ {
+ if (c->code->ext.omp_clauses->gang)
+ gfc_error ("Loop parallelized across gangs is not allowed "
+ "inside another loop parallelized across gangs at %L",
+ &code->loc);
+ 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",
+ &code->loc);
+ }
+ if (code->ext.omp_clauses->worker)
+ {
+ if (c->code->ext.omp_clauses->worker)
+ gfc_error ("Loop parallelized across workers is not allowed "
+ "inside another loop parallelized across workers at %L",
+ &code->loc);
+ if (c->code->ext.omp_clauses->vector)
+ gfc_error ("Loop parallelized across workers is not allowed "
+ "inside another loop parallelized across vectors at %L",
+ &code->loc);
+ }
+ if (code->ext.omp_clauses->vector)
+ if (c->code->ext.omp_clauses->vector)
+ gfc_error ("Loop parallelized across vectors is not allowed "
+ "inside another loop parallelized across vectors at %L",
+ &code->loc);
+ }
+
+ if (oacc_is_parallel (c->code) || oacc_is_kernels (c->code))
+ break;
+ }
+
+ if (code->ext.omp_clauses->seq)
+ {
+ if (code->ext.omp_clauses->independent)
+ gfc_error ("Both SEQ and INDEPENDENT are not allowed in %L", &code->loc);
+ if (code->ext.omp_clauses->gang)
+ gfc_error ("Both SEQ and GANG are not allowed in %L", &code->loc);
+ if (code->ext.omp_clauses->worker)
+ gfc_error ("Both SEQ and WORKER are not allowed in %L", &code->loc);
+ if (code->ext.omp_clauses->vector)
+ gfc_error ("Both SEQ and VECTOR are not allowed in %L", &code->loc);
+ if (code->ext.omp_clauses->par_auto)
+ gfc_error ("Both SEQ and AUTO are not allowed in %L", &code->loc);
+ }
+ if (code->ext.omp_clauses->par_auto)
+ {
+ if (code->ext.omp_clauses->gang)
+ gfc_error ("Both AUTO and GANG are not allowed in %L", &code->loc);
+ if (code->ext.omp_clauses->worker)
+ gfc_error ("Both AUTO and WORKER are not allowed in %L", &code->loc);
+ if (code->ext.omp_clauses->vector)
+ gfc_error ("Both AUTO and VECTOR are not allowed in %L", &code->loc);
+ }
+ if (!code->ext.omp_clauses->tilelist)
+ {
+ if (code->ext.omp_clauses->gang)
+ {
+ if (code->ext.omp_clauses->worker)
+ gfc_error ("Both GANG and WORKER are not allowed in %L", &code->loc);
+ if (code->ext.omp_clauses->vector)
+ gfc_error ("Both GANG and VECTOR are not allowed in %L", &code->loc);
+ }
+ if (code->ext.omp_clauses->worker)
+ if (code->ext.omp_clauses->vector)
+ gfc_error ("Both WORKER and VECTOR are not allowed in %L", &code->loc);
+ }
+ else if (code->ext.omp_clauses->gang
+ && code->ext.omp_clauses->worker
+ && code->ext.omp_clauses->vector)
+ gfc_error ("All GANG, WORKER and VECTOR are not allowed in %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");
+
+ if (code->ext.omp_clauses->worker
+ && code->ext.omp_clauses->worker_expr)
+ resolve_oacc_params_in_parallel (code, "WORKER");
+
+ if (code->ext.omp_clauses->tilelist)
+ {
+ gfc_exprlist *el;
+ int num = 0;
+ for (el = code->ext.omp_clauses->tilelist; el; el = el->next)
+ {
+ num++;
+ if (el->expr == NULL)
+ continue;
+ resolve_oacc_positive_int_expr (el->expr, "TILE");
+ if (el->expr->expr_type != EXPR_CONSTANT)
+ gfc_error ("TILE requires constant expression at %L", &code->loc);
+ }
+ resolve_oacc_nested_loops (code, code->block->next, num, "tiled");
+ }
+}
+
+
+void
+gfc_resolve_oacc_blocks (gfc_code *code, gfc_namespace *ns)
+{
+ oacc_context ctx;
+
+ resolve_oacc_loop_blocks (code);
+
+ ctx.code = code;
+ ctx.previous = oacc_current_ctx;
+ oacc_current_ctx = &ctx;
+
+ gfc_resolve_blocks (code->block, ns);
+
+ oacc_current_ctx = ctx.previous;
+}
+
+
+static void
+resolve_oacc_loop(gfc_code *code)
+{
+ gfc_code *do_code;
+ int collapse;
+
+ if (code->ext.omp_clauses)
+ resolve_omp_clauses (code);
+
+ do_code = code->block->next;
+ collapse = code->ext.omp_clauses->collapse;
+
+ if (collapse <= 0)
+ collapse = 1;
+ resolve_oacc_nested_loops (code, do_code, collapse, "collapsed");
+}
+
+
+static void
+resolve_oacc_cache (gfc_code *)
+{
+ //TODO: resolve subarrays
+}
+
+
+static void
+resolve_oacc_wait (gfc_code *code)
+{
+ gfc_exprlist* el;
+
+ for (el = code->ext.omp_clauses->waitlist; el; el = el->next)
+ resolve_oacc_positive_int_expr (el->expr, "WAIT");
+}
+
+
+void
+gfc_resolve_oacc_directive (gfc_code *code, gfc_namespace *ns ATTRIBUTE_UNUSED)
+{
+ switch (code->op)
+ {
+ case EXEC_OACC_PARALLEL:
+ case EXEC_OACC_KERNELS:
+ case EXEC_OACC_DATA:
+ case EXEC_OACC_HOST_DATA:
+ case EXEC_OACC_UPDATE:
+ case EXEC_OACC_ENTER_DATA:
+ case EXEC_OACC_EXIT_DATA:
+ resolve_omp_clauses (code);
+ break;
+ case EXEC_OACC_PARALLEL_LOOP:
+ case EXEC_OACC_KERNELS_LOOP:
+ case EXEC_OACC_LOOP:
+ resolve_oacc_loop (code);
+ break;
+ case EXEC_OACC_CACHE:
+ resolve_oacc_cache (code);
+ break;
+ case EXEC_OACC_WAIT:
+ resolve_oacc_wait (code);
+ break;
+ default:
+ break;
+ }
+}
+
/* Resolve OpenMP directive clauses and check various requirements
of each directive. */
--
1.8.3.2
^ permalink raw reply [flat|nested] 89+ messages in thread
* Re: [PATCH 3/6] [GOMP4] OpenACC 1.0+ support in fortran front-end
2014-01-31 11:17 ` [PATCH 2/6] " Ilmir Usmanov
@ 2014-01-31 11:18 ` Ilmir Usmanov
2014-01-31 11:22 ` [PATCH 4/6] " Ilmir Usmanov
2014-02-09 23:24 ` [PATCH 3/6] [GOMP4] OpenACC 1.0+ support in fortran front-end Tobias Burnus
2014-02-09 23:10 ` [PATCH 2/6] " Tobias Burnus
1 sibling, 2 replies; 89+ messages in thread
From: Ilmir Usmanov @ 2014-01-31 11:18 UTC (permalink / raw)
To: Thomas Schwinge
Cc: Evgeny Gavrin, GarbuzovViacheslav, Dmitri Botcharnikov,
gcc-patches, jakub, fortran
[-- Attachment #1: Type: text/plain, Size: 891 bytes --]
OpenACC 1.0 fortran FE support -- translation to GENERIC.
* trans-decl.c
(gfc_generate_function_code): Insert OACC_DECLARE GENERIC node.
* trans-openmp.c (gfc_convert_expr_to_tree): New helper function.
(gfc_trans_omp_array_reduction): Support also OpenACC. Add parameter.
(gfc_trans_omp_reduction_list): Update.
(gfc_trans_oacc_construct): New transform function.
(gfc_trans_omp_map_clause_list): Likewise.
(gfc_trans_oacc_executable_directive): Likewise.
(gfc_trans_oacc_combined_directive, gfc_trans_oacc_declare): Likewise.
(gfc_trans_oacc_directive): Use them.
(gfc_trans_oacc_loop): Stub.
(gfc_trans_omp_clauses): Transform OpenACC clauses.
* trans-stmt.h (gfc_trans_oacc_directive): New function prototype.
(gfc_trans_oacc_declare): Likewise.
* trans.c (trans_code): Transform also OpenACC directives.
[-- Attachment #2: 0003-OpenACC-fortran-front-end-part-3.patch --]
[-- Type: text/x-diff, Size: 15768 bytes --]
From c7fcfb4e2aaeb1833dad4d5e370da330bb1a3760 Mon Sep 17 00:00:00 2001
From: Ilmir Usmanov <i.usmanov@samsung.com>
Date: Fri, 31 Jan 2014 13:27:24 +0400
Subject: [PATCH 3/6] OpenACC fortran front-end -- part 3
---
gcc/fortran/trans-decl.c | 7 +
gcc/fortran/trans-openmp.c | 367 +++++++++++++++++++++++++++++++++++++++++++++
gcc/fortran/trans-stmt.h | 4 +
gcc/fortran/trans.c | 15 ++
4 files changed, 393 insertions(+)
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index bb02f43..69f33dd 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -5602,6 +5602,13 @@ gfc_generate_function_code (gfc_namespace * ns)
if ((gfc_option.rtcheck & GFC_RTCHECK_BOUNDS) && !sym->attr.is_bind_c)
add_argument_checking (&body, sym);
+ /* Generate !$ACC DECLARE directive. */
+ if (ns->declare_clauses)
+ {
+ tmp = gfc_trans_oacc_declare(&body, ns);
+ gfc_add_expr_to_block(&body, tmp);
+ }
+
tmp = gfc_trans_code (ns->code);
gfc_add_expr_to_block (&body, tmp);
diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
index 41020a8..a9d1bbc 100644
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -767,6 +767,40 @@ gfc_trans_omp_reduction_list (gfc_namelist *namelist, tree list,
}
static tree
+gfc_trans_omp_map_clause_list (enum omp_clause_map_kind kind,
+ gfc_namelist *namelist, tree list)
+{
+ for (; namelist != NULL; namelist = namelist->next)
+ if (namelist->sym->attr.referenced)
+ {
+ tree t = gfc_trans_omp_variable (namelist->sym);
+ if (t != error_mark_node)
+ {
+ tree node = build_omp_clause (input_location, OMP_CLAUSE_MAP);
+ OMP_CLAUSE_DECL (node) = t;
+ OMP_CLAUSE_MAP_KIND (node) = kind;
+ list = gfc_trans_add_clause (node, list);
+ }
+ }
+ return list;
+}
+
+static inline tree
+gfc_convert_expr_to_tree (stmtblock_t *block, gfc_expr *expr)
+{
+ gfc_se se;
+ tree result;
+
+ gfc_init_se (&se, NULL );
+ gfc_conv_expr (&se, expr);
+ gfc_add_block_to_block (block, &se.pre);
+ result = gfc_evaluate_now (se.expr, block);
+ gfc_add_block_to_block (block, &se.post);
+
+ return result;
+}
+
+static tree
gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
locus where)
{
@@ -834,6 +868,51 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
where);
continue;
}
+ if (list >= OMP_LIST_DATA_CLAUSE_FIRST
+ && list <= OMP_LIST_DATA_CLAUSE_LAST)
+ {
+ enum omp_clause_map_kind kind;
+ switch (list)
+ {
+ case OMP_LIST_COPY:
+ kind = OMP_CLAUSE_MAP_FORCE_TOFROM;
+ break;
+ case OMP_LIST_OACC_COPYIN:
+ kind = OMP_CLAUSE_MAP_FORCE_TO;
+ break;
+ case OMP_LIST_COPYOUT:
+ kind = OMP_CLAUSE_MAP_FORCE_FROM;
+ break;
+ case OMP_LIST_CREATE:
+ kind = OMP_CLAUSE_MAP_FORCE_ALLOC;
+ break;
+ case OMP_LIST_DELETE:
+ kind = OMP_CLAUSE_MAP_FORCE_DEALLOC;
+ break;
+ case OMP_LIST_PRESENT:
+ kind = OMP_CLAUSE_MAP_FORCE_PRESENT;
+ break;
+ case OMP_LIST_PRESENT_OR_COPY:
+ kind = OMP_CLAUSE_MAP_TOFROM;
+ break;
+ case OMP_LIST_PRESENT_OR_COPYIN:
+ kind = OMP_CLAUSE_MAP_TO;
+ break;
+ case OMP_LIST_PRESENT_OR_COPYOUT:
+ kind = OMP_CLAUSE_MAP_FROM;
+ break;
+ case OMP_LIST_PRESENT_OR_CREATE:
+ kind = OMP_CLAUSE_MAP_ALLOC;
+ break;
+ case OMP_LIST_DEVICEPTR:
+ kind = OMP_CLAUSE_MAP_FORCE_DEVICEPTR;
+ break;
+ default:
+ gcc_unreachable ();
+ }
+ omp_clauses = gfc_trans_omp_map_clause_list (kind, n, omp_clauses);
+ continue;
+ }
switch (list)
{
case OMP_LIST_PRIVATE:
@@ -853,6 +932,21 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
goto add_clause;
case OMP_LIST_COPYPRIVATE:
clause_code = OMP_CLAUSE_COPYPRIVATE;
+ goto add_clause;
+ case OMP_LIST_USE_DEVICE:
+ clause_code = OMP_CLAUSE_USE_DEVICE;
+ goto add_clause;
+ case OMP_LIST_DEVICE_RESIDENT:
+ clause_code = OMP_CLAUSE_DEVICE_RESIDENT;
+ goto add_clause;
+ case OMP_LIST_HOST:
+ clause_code = OMP_CLAUSE_HOST;
+ goto add_clause;
+ case OMP_LIST_DEVICE:
+ clause_code = OMP_CLAUSE_OACC_DEVICE;
+ goto add_clause;
+ case OMP_LIST_CACHE:
+ clause_code = OMP_NO_CLAUSE_CACHE;
/* FALLTHROUGH */
add_clause:
omp_clauses
@@ -1000,6 +1094,107 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
omp_clauses = gfc_trans_add_clause (c, omp_clauses);
}
+ if (clauses->async)
+ {
+ c = build_omp_clause (where.lb->location, OMP_CLAUSE_ASYNC);
+ if (clauses->async_expr)
+ OMP_CLAUSE_ASYNC_EXPR (c) =
+ gfc_convert_expr_to_tree (block, clauses->async_expr);
+ else
+ OMP_CLAUSE_ASYNC_EXPR (c) = NULL;
+ omp_clauses = gfc_trans_add_clause (c, omp_clauses);
+ }
+ if (clauses->seq)
+ {
+ c = build_omp_clause (where.lb->location, OMP_CLAUSE_ORDERED);
+ omp_clauses = gfc_trans_add_clause (c, omp_clauses);
+ }
+ if (clauses->independent)
+ {
+ c = build_omp_clause (where.lb->location, OMP_CLAUSE_INDEPENDENT);
+ omp_clauses = gfc_trans_add_clause (c, omp_clauses);
+ }
+ if (clauses->num_gangs_expr)
+ {
+ tree num_gangs_var =
+ gfc_convert_expr_to_tree (block, clauses->num_gangs_expr);
+ c = build_omp_clause (where.lb->location, OMP_CLAUSE_NUM_GANGS);
+ OMP_CLAUSE_NUM_GANGS_EXPR (c) = num_gangs_var;
+ omp_clauses = gfc_trans_add_clause (c, omp_clauses);
+ }
+ if (clauses->num_workers_expr)
+ {
+ tree num_workers_var =
+ gfc_convert_expr_to_tree (block, clauses->num_workers_expr);
+ c = build_omp_clause (where.lb->location, OMP_CLAUSE_NUM_WORKERS);
+ OMP_CLAUSE_NUM_WORKERS_EXPR (c)= num_workers_var;
+ omp_clauses = gfc_trans_add_clause (c, omp_clauses);
+ }
+ if (clauses->vector_length_expr)
+ {
+ tree vector_length_var =
+ gfc_convert_expr_to_tree (block, clauses->vector_length_expr);
+ c = build_omp_clause (where.lb->location, OMP_CLAUSE_VECTOR_LENGTH);
+ OMP_CLAUSE_VECTOR_LENGTH_EXPR (c)= vector_length_var;
+ omp_clauses = gfc_trans_add_clause (c, omp_clauses);
+ }
+ if (clauses->vector)
+ {
+ if (clauses->vector_expr)
+ {
+ tree vector_var =
+ gfc_convert_expr_to_tree (block, clauses->vector_expr);
+ c = build_omp_clause (where.lb->location, OMP_CLAUSE_VECTOR);
+ OMP_CLAUSE_VECTOR_EXPR (c)= vector_var;
+ omp_clauses = gfc_trans_add_clause (c, omp_clauses);
+ }
+ else
+ {
+ c = build_omp_clause (where.lb->location, OMP_CLAUSE_VECTOR);
+ omp_clauses = gfc_trans_add_clause (c, omp_clauses);
+ }
+ }
+ if (clauses->worker)
+ {
+ if (clauses->worker_expr)
+ {
+ tree worker_var =
+ gfc_convert_expr_to_tree (block, clauses->worker_expr);
+ c = build_omp_clause (where.lb->location, OMP_CLAUSE_WORKER);
+ OMP_CLAUSE_WORKER_EXPR (c)= worker_var;
+ omp_clauses = gfc_trans_add_clause (c, omp_clauses);
+ }
+ else
+ {
+ c = build_omp_clause (where.lb->location, OMP_CLAUSE_WORKER);
+ omp_clauses = gfc_trans_add_clause (c, omp_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);
+ OMP_CLAUSE_GANG_EXPR (c)= gang_var;
+ omp_clauses = gfc_trans_add_clause (c, omp_clauses);
+ }
+ else
+ {
+ c = build_omp_clause (where.lb->location, OMP_CLAUSE_GANG);
+ omp_clauses = gfc_trans_add_clause (c, omp_clauses);
+ }
+ }
+ if (clauses->non_clause_wait_expr)
+ {
+ tree wait_var =
+ gfc_convert_expr_to_tree (block, clauses->non_clause_wait_expr);
+ c = build_omp_clause (where.lb->location, OMP_CLAUSE_WAIT);
+ OMP_WAIT_EXPR (c)= wait_var;
+ omp_clauses = gfc_trans_add_clause (c, omp_clauses);
+ }
+
return omp_clauses;
}
@@ -1027,6 +1222,80 @@ gfc_trans_omp_code (gfc_code *code, bool force_empty)
return stmt;
}
+/* Trans OpenACC directives. */
+/* parallel, kernels, data and host_data. */
+static tree
+gfc_trans_oacc_construct (gfc_code *code)
+{
+ stmtblock_t block;
+ tree stmt, oacc_clauses;
+ enum tree_code construct_code;
+
+ switch (code->op)
+ {
+ case EXEC_OACC_PARALLEL:
+ construct_code = OACC_PARALLEL;
+ break;
+ case EXEC_OACC_KERNELS:
+ construct_code = OACC_KERNELS;
+ break;
+ case EXEC_OACC_DATA:
+ construct_code = OACC_DATA;
+ break;
+ case EXEC_OACC_HOST_DATA:
+ construct_code = OACC_HOST_DATA;
+ break;
+ default:
+ gcc_unreachable ();
+ }
+
+ gfc_start_block (&block);
+ oacc_clauses = gfc_trans_omp_clauses (&block, code->ext.omp_clauses,
+ code->loc);
+ stmt = gfc_trans_omp_code (code->block->next, true);
+ stmt = build2_loc (input_location, construct_code, void_type_node, stmt,
+ oacc_clauses);
+ gfc_add_expr_to_block (&block, stmt);
+ return gfc_finish_block (&block);
+}
+
+/* update, enter_data, exit_data, wait, cache. */
+static tree
+gfc_trans_oacc_executable_directive (gfc_code *code)
+{
+ stmtblock_t block;
+ tree stmt, oacc_clauses;
+ enum tree_code construct_code;
+
+ switch (code->op)
+ {
+ case EXEC_OACC_UPDATE:
+ construct_code = OACC_UPDATE;
+ break;
+ case EXEC_OACC_ENTER_DATA:
+ construct_code = OACC_ENTER_DATA;
+ break;
+ case EXEC_OACC_EXIT_DATA:
+ construct_code = OACC_EXIT_DATA;
+ break;
+ case EXEC_OACC_WAIT:
+ construct_code = OACC_WAIT;
+ break;
+ case EXEC_OACC_CACHE:
+ construct_code = OACC_CACHE;
+ break;
+ default:
+ gcc_unreachable ();
+ }
+
+ gfc_start_block (&block);
+ oacc_clauses = gfc_trans_omp_clauses (&block, code->ext.omp_clauses,
+ code->loc);
+ stmt = build1_loc (input_location, construct_code, void_type_node,
+ oacc_clauses);
+ gfc_add_expr_to_block (&block, stmt);
+ return gfc_finish_block (&block);
+}
static tree gfc_trans_omp_sections (gfc_code *, gfc_omp_clauses *);
static tree gfc_trans_omp_workshare (gfc_code *, gfc_omp_clauses *);
@@ -1302,6 +1571,68 @@ typedef struct dovar_init_d {
tree init;
} dovar_init;
+static tree
+gfc_trans_oacc_loop (gfc_code *, gfc_omp_clauses *)
+{
+ gfc_error ("Unimplemented");
+ return NULL_TREE;
+}
+
+/* parallel loop and kernels loop. */
+static tree
+gfc_trans_oacc_combined_directive (gfc_code *code)
+{
+ stmtblock_t block;
+ gfc_omp_clauses construct_clauses, loop_clauses;
+ tree stmt, oacc_clauses = NULL_TREE;
+ enum tree_code construct_code;
+
+ switch (code->op)
+ {
+ case EXEC_OACC_PARALLEL_LOOP:
+ construct_code = OACC_PARALLEL;
+ break;
+ case EXEC_OACC_KERNELS_LOOP:
+ construct_code = OACC_KERNELS;
+ break;
+ default:
+ gcc_unreachable ();
+ }
+
+ gfc_start_block (&block);
+
+ memset (&loop_clauses, 0, sizeof (loop_clauses));
+ if (code->ext.omp_clauses != NULL)
+ {
+ memcpy (&construct_clauses, code->ext.omp_clauses,
+ sizeof (construct_clauses));
+ loop_clauses.collapse = construct_clauses.collapse;
+ loop_clauses.gang = construct_clauses.gang;
+ loop_clauses.vector = construct_clauses.vector;
+ loop_clauses.worker = construct_clauses.worker;
+ loop_clauses.seq = construct_clauses.seq;
+ loop_clauses.independent = construct_clauses.independent;
+ construct_clauses.collapse = 0;
+ construct_clauses.gang = false;
+ construct_clauses.vector = false;
+ construct_clauses.worker = false;
+ construct_clauses.seq = false;
+ construct_clauses.independent = false;
+ oacc_clauses = gfc_trans_omp_clauses (&block, &construct_clauses,
+ code->loc);
+ }
+ if (loop_clauses.seq)
+ pushlevel ();
+ stmt = gfc_trans_oacc_loop (code, &loop_clauses);
+ if (TREE_CODE (stmt) != BIND_EXPR)
+ stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0));
+ else
+ poplevel (0, 0);
+ stmt = build2_loc (input_location, construct_code, void_type_node, stmt,
+ oacc_clauses);
+ gfc_add_expr_to_block (&block, stmt);
+ return gfc_finish_block (&block);
+}
static tree
gfc_trans_omp_do (gfc_code *code, stmtblock_t *pblock,
@@ -1915,6 +2246,42 @@ gfc_trans_omp_workshare (gfc_code *code, gfc_omp_clauses *clauses)
}
tree
+gfc_trans_oacc_declare (stmtblock_t *block, gfc_namespace *ns)
+{
+ tree oacc_clauses;
+ oacc_clauses = gfc_trans_omp_clauses (block, ns->declare_clauses,
+ ns->code->loc);
+ return build1_loc (input_location, OACC_DECLARE, void_type_node,
+ oacc_clauses);
+}
+
+tree
+gfc_trans_oacc_directive (gfc_code *code)
+{
+ switch (code->op)
+ {
+ case EXEC_OACC_PARALLEL_LOOP:
+ case EXEC_OACC_KERNELS_LOOP:
+ return gfc_trans_oacc_combined_directive (code);
+ case EXEC_OACC_PARALLEL:
+ case EXEC_OACC_KERNELS:
+ case EXEC_OACC_DATA:
+ case EXEC_OACC_HOST_DATA:
+ return gfc_trans_oacc_construct (code);
+ case EXEC_OACC_LOOP:
+ return gfc_trans_oacc_loop (code, code->ext.omp_clauses);
+ case EXEC_OACC_UPDATE:
+ case EXEC_OACC_WAIT:
+ case EXEC_OACC_CACHE:
+ case EXEC_OACC_ENTER_DATA:
+ case EXEC_OACC_EXIT_DATA:
+ return gfc_trans_oacc_executable_directive (code);
+ default:
+ gcc_unreachable ();
+ }
+}
+
+tree
gfc_trans_omp_directive (gfc_code *code)
{
switch (code->op)
diff --git a/gcc/fortran/trans-stmt.h b/gcc/fortran/trans-stmt.h
index 8a57be4..ad3a5e6 100644
--- a/gcc/fortran/trans-stmt.h
+++ b/gcc/fortran/trans-stmt.h
@@ -64,6 +64,10 @@ tree gfc_trans_deallocate_array (tree);
/* trans-openmp.c */
tree gfc_trans_omp_directive (gfc_code *);
+/* trans-openacc.c */
+tree gfc_trans_oacc_directive (gfc_code *);
+tree gfc_trans_oacc_declare (stmtblock_t *block, gfc_namespace *);
+
/* trans-io.c */
tree gfc_trans_open (gfc_code *);
tree gfc_trans_close (gfc_code *);
diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c
index c5b3b9e..54686f5 100644
--- a/gcc/fortran/trans.c
+++ b/gcc/fortran/trans.c
@@ -1850,6 +1850,21 @@ trans_code (gfc_code * code, tree cond)
res = gfc_trans_omp_directive (code);
break;
+ case EXEC_OACC_CACHE:
+ case EXEC_OACC_WAIT:
+ case EXEC_OACC_UPDATE:
+ case EXEC_OACC_LOOP:
+ case EXEC_OACC_HOST_DATA:
+ case EXEC_OACC_DATA:
+ case EXEC_OACC_KERNELS:
+ case EXEC_OACC_KERNELS_LOOP:
+ case EXEC_OACC_PARALLEL:
+ case EXEC_OACC_PARALLEL_LOOP:
+ case EXEC_OACC_ENTER_DATA:
+ case EXEC_OACC_EXIT_DATA:
+ res = gfc_trans_oacc_directive (code);
+ break;
+
default:
internal_error ("gfc_trans_code(): Bad statement code");
}
--
1.8.3.2
^ permalink raw reply [flat|nested] 89+ messages in thread
* Re: [PATCH 4/6] [GOMP4] OpenACC 1.0+ support in fortran front-end
2014-01-31 11:18 ` [PATCH 3/6] " Ilmir Usmanov
@ 2014-01-31 11:22 ` Ilmir Usmanov
2014-01-31 11:34 ` [PATCH 5/6] " Ilmir Usmanov
2014-02-11 16:51 ` [PATCH 4/6] " Thomas Schwinge
2014-02-09 23:24 ` [PATCH 3/6] [GOMP4] OpenACC 1.0+ support in fortran front-end Tobias Burnus
1 sibling, 2 replies; 89+ messages in thread
From: Ilmir Usmanov @ 2014-01-31 11:22 UTC (permalink / raw)
To: Thomas Schwinge
Cc: Evgeny Gavrin, GarbuzovViacheslav, Dmitri Botcharnikov,
gcc-patches, jakub, fortran
[-- Attachment #1: Type: text/plain, Size: 1685 bytes --]
OpenACC 1.0 support -- GENERIC nodes and gimplify stubs.
gcc/
* gimplify.c (is_gimple_stmt): Stub OpenACC directives and clauses.
(gimplify_scan_omp_clauses, gimplify_adjust_omp_clauses): Likewise.
(gimplify_expr): Likewise.
* omp-low.c (scan_sharing_clauses): Likewise.
(gimple_code_is_oacc): New helper function.
(scan_sharing_clauses): Use it.
* tree-core.h
(OMP_CLAUSE_ASYNC, OMP_CLAUSE_NUM_GANGS, OMP_CLAUSE_NUM_WORKERS,
OMP_CLAUSE_VECTOR_LENGTH, OMP_CLAUSE_GANG, OMP_CLAUSE_WORKER,
OMP_CLAUSE_VECTOR, OMP_CLAUSE_INDEPENDENT,
OMP_CLAUSE_USE_DEVICE, OMP_CLAUSE_HOST, OMP_CLAUSE_DEVICE_RESIDENT,
OMP_CLAUSE_OACC_DEVICE, OMP_CLAUSE_DEFAULT, OMP_CLAUSE_WAIT): New
clauses.
* tree-pretty-print.c (dump_omp_clause): Print OpenACC clause.
(dump_generic_node): Print OpenACC directives and its clauses.
* tree.c (omp_clause_num_ops): Add OpenACC clauses.
(omp_clause_code_name): Likewise.
(walk_tree_1): Likewise.
* tree.def (OACC_KERNELS): New tree node.
(OACC_DATA, OACC_HOST_DATA, OACC_DECLARE, OACC_UPDATE): Likewise.
(OACC_ENTER_DATA, OACC_EXIT_DATA, OACC_WAIT, OACC_CACHE): Likewise.
* tree.h (OACC_BODY): New macros.
(OACC_KERNELS_BODY, OACC_KERNELS_CLAUSES, OACC_CLAUSE_NUM_GANGS_EXPR,
OMP_CLAUSE_NUM_WORKERS_EXPR, OMP_CLAUSE_VECTOR_LENGTH_EXPR,
OMP_CLAUSE_VECTOR_EXPR, OMP_CLAUSE_WORKER_EXPR, OMP_CLAUSE_GANG_EXPR,
OMP_CLAUSE_ASYNC_EXPR,
OMP_WAIT_EXPR, OACC_DATA_BODY, OACC_DATA_CLAUSES,
OACC_DECLARE_CLAUSES,
OACC_UPDATE_CLAUSES, OACC_WAIT_CLAUSES, OACC_CACHE_CLAUSES,
OACC_HOST_DATA_BODY, OACC_HOST_DATA_CLAUSES): Likewise.
[-- Attachment #2: 0004-OpenACC-GENERIC-nodes.patch --]
[-- Type: text/x-diff, Size: 24628 bytes --]
From 3383f24ea09611525311e3e2147672421c31f9cb Mon Sep 17 00:00:00 2001
From: Ilmir Usmanov <i.usmanov@samsung.com>
Date: Fri, 31 Jan 2014 13:28:47 +0400
Subject: [PATCH 4/6] OpenACC GENERIC nodes
---
gcc/gimplify.c | 53 +++++++++++++++++++++++++
gcc/omp-low.c | 96 +++++++++++++++++++++++++++++++++++++-------
gcc/tree-core.h | 61 +++++++++++++++++++++++++---
gcc/tree-pretty-print.c | 103 ++++++++++++++++++++++++++++++++++++++++++++++++
gcc/tree.c | 44 ++++++++++++++++++++-
gcc/tree.def | 50 +++++++++++++++++++++++
gcc/tree.h | 53 +++++++++++++++++++++++++
7 files changed, 438 insertions(+), 22 deletions(-)
diff --git a/gcc/gimplify.c b/gcc/gimplify.c
index d20f07f..34fd8ca 100644
--- a/gcc/gimplify.c
+++ b/gcc/gimplify.c
@@ -4333,6 +4333,15 @@ is_gimple_stmt (tree t)
case ASM_EXPR:
case STATEMENT_LIST:
case OACC_PARALLEL:
+ case OACC_KERNELS:
+ case OACC_DATA:
+ case OACC_CACHE:
+ case OACC_WAIT:
+ case OACC_HOST_DATA:
+ case OACC_DECLARE:
+ case OACC_UPDATE:
+ case OACC_ENTER_DATA:
+ case OACC_EXIT_DATA:
case OMP_PARALLEL:
case OMP_FOR:
case OMP_SIMD:
@@ -6157,6 +6166,20 @@ gimplify_scan_omp_clauses (tree *list_p, gimple_seq *pre_p,
remove = true;
break;
+ case OMP_CLAUSE_HOST:
+ case OMP_CLAUSE_OACC_DEVICE:
+ case OMP_CLAUSE_DEVICE_RESIDENT:
+ case OMP_CLAUSE_USE_DEVICE:
+ case OMP_CLAUSE_ASYNC:
+ case OMP_CLAUSE_GANG:
+ case OMP_CLAUSE_WAIT:
+ case OMP_NO_CLAUSE_CACHE:
+ case OMP_CLAUSE_INDEPENDENT:
+ case OMP_CLAUSE_WORKER:
+ case OMP_CLAUSE_VECTOR:
+ case OMP_CLAUSE_NUM_GANGS:
+ case OMP_CLAUSE_NUM_WORKERS:
+ case OMP_CLAUSE_VECTOR_LENGTH:
case OMP_CLAUSE_NOWAIT:
case OMP_CLAUSE_ORDERED:
case OMP_CLAUSE_UNTIED:
@@ -6476,6 +6499,23 @@ gimplify_adjust_omp_clauses (tree *list_p)
}
break;
+ case OMP_CLAUSE_HOST:
+ case OMP_CLAUSE_OACC_DEVICE:
+ case OMP_CLAUSE_DEVICE_RESIDENT:
+ case OMP_CLAUSE_USE_DEVICE:
+ case OMP_CLAUSE_ASYNC:
+ case OMP_CLAUSE_GANG:
+ case OMP_CLAUSE_WAIT:
+ case OMP_NO_CLAUSE_CACHE:
+ case OMP_CLAUSE_INDEPENDENT:
+ case OMP_CLAUSE_WORKER:
+ case OMP_CLAUSE_VECTOR:
+ case OMP_CLAUSE_NUM_GANGS:
+ case OMP_CLAUSE_NUM_WORKERS:
+ case OMP_CLAUSE_VECTOR_LENGTH:
+ sorry ("Clause not supported yet");
+ break;
+
case OMP_CLAUSE_REDUCTION:
case OMP_CLAUSE_COPYIN:
case OMP_CLAUSE_COPYPRIVATE:
@@ -7988,6 +8028,19 @@ gimplify_expr (tree *expr_p, gimple_seq *pre_p, gimple_seq *post_p,
ret = GS_ALL_DONE;
break;
+ case OACC_KERNELS:
+ case OACC_DATA:
+ case OACC_CACHE:
+ case OACC_WAIT:
+ case OACC_HOST_DATA:
+ case OACC_DECLARE:
+ case OACC_UPDATE:
+ case OACC_ENTER_DATA:
+ case OACC_EXIT_DATA:
+ sorry ("directive not yet implemented");
+ ret = GS_ALL_DONE;
+ break;
+
case OMP_PARALLEL:
gimplify_omp_parallel (expr_p, pre_p);
ret = GS_ALL_DONE;
diff --git a/gcc/omp-low.c b/gcc/omp-low.c
index 4bbe6d6..88de870 100644
--- a/gcc/omp-low.c
+++ b/gcc/omp-low.c
@@ -1491,6 +1491,18 @@ fixup_child_record_type (omp_context *ctx)
TREE_TYPE (ctx->receiver_decl) = build_pointer_type (type);
}
+static bool
+gimple_code_is_oacc (const_gimple g)
+{
+ switch (gimple_code (g))
+ {
+ case GIMPLE_OACC_PARALLEL:
+ return true;
+ default:
+ return false;
+ }
+}
+
/* Instantiate decls as necessary in CTX to satisfy the data sharing
specified by CLAUSES. */
@@ -1552,8 +1564,13 @@ scan_sharing_clauses (tree clauses, omp_context *ctx)
case OMP_CLAUSE_FIRSTPRIVATE:
case OMP_CLAUSE_REDUCTION:
+ if (gimple_code (ctx->stmt) == GIMPLE_OACC_PARALLEL)
+ {
+ sorry ("clause not supported yet");
+ break;
+ }
case OMP_CLAUSE_LINEAR:
- gcc_assert (gimple_code (ctx->stmt) != GIMPLE_OACC_PARALLEL);
+ gcc_assert (!gimple_code_is_oacc (ctx->stmt));
decl = OMP_CLAUSE_DECL (c);
do_private:
if (is_variable_sized (decl))
@@ -1591,7 +1608,7 @@ scan_sharing_clauses (tree clauses, omp_context *ctx)
case OMP_CLAUSE_COPYPRIVATE:
case OMP_CLAUSE_COPYIN:
- gcc_assert (gimple_code (ctx->stmt) != GIMPLE_OACC_PARALLEL);
+ gcc_assert (!gimple_code_is_oacc (ctx->stmt));
decl = OMP_CLAUSE_DECL (c);
by_ref = use_pointer_for_field (decl, NULL);
install_var_field (decl, by_ref, 3, ctx);
@@ -1602,8 +1619,13 @@ scan_sharing_clauses (tree clauses, omp_context *ctx)
ctx->default_kind = OMP_CLAUSE_DEFAULT_KIND (c);
break;
- case OMP_CLAUSE_FINAL:
case OMP_CLAUSE_IF:
+ if (gimple_code (ctx->stmt) == GIMPLE_OACC_PARALLEL)
+ {
+ sorry ("clause not supported yet");
+ break;
+ }
+ case OMP_CLAUSE_FINAL:
case OMP_CLAUSE_NUM_THREADS:
case OMP_CLAUSE_NUM_TEAMS:
case OMP_CLAUSE_THREAD_LIMIT:
@@ -1611,14 +1633,14 @@ scan_sharing_clauses (tree clauses, omp_context *ctx)
case OMP_CLAUSE_SCHEDULE:
case OMP_CLAUSE_DIST_SCHEDULE:
case OMP_CLAUSE_DEPEND:
- gcc_assert (gimple_code (ctx->stmt) != GIMPLE_OACC_PARALLEL);
+ gcc_assert (!gimple_code_is_oacc (ctx->stmt));
if (ctx->outer)
scan_omp_op (&OMP_CLAUSE_OPERAND (c, 0), ctx->outer);
break;
case OMP_CLAUSE_TO:
case OMP_CLAUSE_FROM:
- gcc_assert (gimple_code (ctx->stmt) != GIMPLE_OACC_PARALLEL);
+ gcc_assert (!gimple_code_is_oacc (ctx->stmt));
case OMP_CLAUSE_MAP:
if (ctx->outer)
scan_omp_op (&OMP_CLAUSE_SIZE (c), ctx->outer);
@@ -1641,7 +1663,7 @@ scan_sharing_clauses (tree clauses, omp_context *ctx)
/* Ignore OMP_CLAUSE_MAP_POINTER kind for arrays in
#pragma omp target data, there is nothing to map for
those. */
- if (gimple_code (ctx->stmt) != GIMPLE_OACC_PARALLEL
+ if (!gimple_code_is_oacc (ctx->stmt)
&& gimple_omp_target_kind (ctx->stmt) == GF_OMP_TARGET_KIND_DATA
&& !POINTER_TYPE_P (TREE_TYPE (decl)))
break;
@@ -1710,17 +1732,34 @@ scan_sharing_clauses (tree clauses, omp_context *ctx)
case OMP_CLAUSE_MERGEABLE:
case OMP_CLAUSE_PROC_BIND:
case OMP_CLAUSE_SAFELEN:
- gcc_assert (gimple_code (ctx->stmt) != GIMPLE_OACC_PARALLEL);
+ gcc_assert (!gimple_code_is_oacc (ctx->stmt));
break;
case OMP_CLAUSE_ALIGNED:
- gcc_assert (gimple_code (ctx->stmt) != GIMPLE_OACC_PARALLEL);
+ gcc_assert (!gimple_code_is_oacc (ctx->stmt));
decl = OMP_CLAUSE_DECL (c);
if (is_global_var (decl)
&& TREE_CODE (TREE_TYPE (decl)) == ARRAY_TYPE)
install_var_local (decl, ctx);
break;
+ case OMP_CLAUSE_HOST:
+ case OMP_CLAUSE_OACC_DEVICE:
+ case OMP_CLAUSE_DEVICE_RESIDENT:
+ case OMP_CLAUSE_USE_DEVICE:
+ case OMP_CLAUSE_ASYNC:
+ case OMP_CLAUSE_GANG:
+ case OMP_CLAUSE_WAIT:
+ case OMP_NO_CLAUSE_CACHE:
+ case OMP_CLAUSE_INDEPENDENT:
+ case OMP_CLAUSE_WORKER:
+ case OMP_CLAUSE_VECTOR:
+ case OMP_CLAUSE_NUM_GANGS:
+ case OMP_CLAUSE_NUM_WORKERS:
+ case OMP_CLAUSE_VECTOR_LENGTH:
+ sorry ("Clause not supported yet");
+ break;
+
default:
gcc_unreachable ();
}
@@ -1731,7 +1770,7 @@ scan_sharing_clauses (tree clauses, omp_context *ctx)
switch (OMP_CLAUSE_CODE (c))
{
case OMP_CLAUSE_LASTPRIVATE:
- gcc_assert (gimple_code (ctx->stmt) != GIMPLE_OACC_PARALLEL);
+ gcc_assert (!gimple_code_is_oacc (ctx->stmt));
/* Let the corresponding firstprivate clause create
the variable. */
if (OMP_CLAUSE_LASTPRIVATE_GIMPLE_SEQ (c))
@@ -1743,8 +1782,13 @@ scan_sharing_clauses (tree clauses, omp_context *ctx)
case OMP_CLAUSE_PRIVATE:
case OMP_CLAUSE_FIRSTPRIVATE:
case OMP_CLAUSE_REDUCTION:
+ if (gimple_code (ctx->stmt) == GIMPLE_OACC_PARALLEL)
+ {
+ sorry ("clause not supported yet");
+ break;
+ }
case OMP_CLAUSE_LINEAR:
- gcc_assert (gimple_code (ctx->stmt) != GIMPLE_OACC_PARALLEL);
+ gcc_assert (!gimple_code_is_oacc (ctx->stmt));
decl = OMP_CLAUSE_DECL (c);
if (is_variable_sized (decl))
install_var_local (decl, ctx);
@@ -1757,7 +1801,7 @@ scan_sharing_clauses (tree clauses, omp_context *ctx)
break;
case OMP_CLAUSE_SHARED:
- gcc_assert (gimple_code (ctx->stmt) != GIMPLE_OACC_PARALLEL);
+ gcc_assert (!gimple_code_is_oacc (ctx->stmt));
/* Ignore shared directives in teams construct. */
if (gimple_code (ctx->stmt) == GIMPLE_OMP_TEAMS)
break;
@@ -1767,7 +1811,7 @@ scan_sharing_clauses (tree clauses, omp_context *ctx)
break;
case OMP_CLAUSE_MAP:
- if (gimple_code (ctx->stmt) != GIMPLE_OACC_PARALLEL
+ if (!gimple_code_is_oacc (ctx->stmt)
&& gimple_omp_target_kind (ctx->stmt) == GF_OMP_TARGET_KIND_DATA)
break;
decl = OMP_CLAUSE_DECL (c);
@@ -1776,7 +1820,7 @@ scan_sharing_clauses (tree clauses, omp_context *ctx)
&& lookup_attribute ("omp declare target",
DECL_ATTRIBUTES (decl)))
{
- gcc_assert (gimple_code (ctx->stmt) != GIMPLE_OACC_PARALLEL);
+ gcc_assert (!gimple_code_is_oacc (ctx->stmt));
break;
}
if (DECL_P (decl))
@@ -1804,10 +1848,15 @@ scan_sharing_clauses (tree clauses, omp_context *ctx)
}
break;
+ case OMP_CLAUSE_IF:
+ if (gimple_code (ctx->stmt) == GIMPLE_OACC_PARALLEL)
+ {
+ sorry ("clause not supported yet");
+ break;
+ }
case OMP_CLAUSE_COPYPRIVATE:
case OMP_CLAUSE_COPYIN:
case OMP_CLAUSE_DEFAULT:
- case OMP_CLAUSE_IF:
case OMP_CLAUSE_NUM_THREADS:
case OMP_CLAUSE_NUM_TEAMS:
case OMP_CLAUSE_THREAD_LIMIT:
@@ -1827,9 +1876,26 @@ scan_sharing_clauses (tree clauses, omp_context *ctx)
case OMP_CLAUSE__LOOPTEMP_:
case OMP_CLAUSE_TO:
case OMP_CLAUSE_FROM:
- gcc_assert (gimple_code (ctx->stmt) != GIMPLE_OACC_PARALLEL);
+ gcc_assert (!gimple_code_is_oacc (ctx->stmt));
break;
+ case OMP_CLAUSE_HOST:
+ case OMP_CLAUSE_OACC_DEVICE:
+ case OMP_CLAUSE_DEVICE_RESIDENT:
+ case OMP_CLAUSE_USE_DEVICE:
+ case OMP_CLAUSE_ASYNC:
+ case OMP_CLAUSE_GANG:
+ case OMP_CLAUSE_WAIT:
+ case OMP_NO_CLAUSE_CACHE:
+ case OMP_CLAUSE_INDEPENDENT:
+ case OMP_CLAUSE_WORKER:
+ case OMP_CLAUSE_VECTOR:
+ case OMP_CLAUSE_NUM_GANGS:
+ case OMP_CLAUSE_NUM_WORKERS:
+ case OMP_CLAUSE_VECTOR_LENGTH:
+ sorry ("Clause not supported yet");
+ break;
+
default:
gcc_unreachable ();
}
diff --git a/gcc/tree-core.h b/gcc/tree-core.h
index 1b974f8..a5a95cd 100644
--- a/gcc/tree-core.h
+++ b/gcc/tree-core.h
@@ -213,19 +213,19 @@ enum omp_clause_code {
(c_parser_omp_variable_list). */
OMP_CLAUSE_ERROR = 0,
- /* OpenMP clause: private (variable_list). */
+ /* OpenMP/OpenACC clause: private (variable_list). */
OMP_CLAUSE_PRIVATE,
/* OpenMP clause: shared (variable_list). */
OMP_CLAUSE_SHARED,
- /* OpenMP clause: firstprivate (variable_list). */
+ /* OpenMP/OpenACC clause: firstprivate (variable_list). */
OMP_CLAUSE_FIRSTPRIVATE,
/* OpenMP clause: lastprivate (variable_list). */
OMP_CLAUSE_LASTPRIVATE,
- /* OpenMP clause: reduction (operator:variable_list).
+ /* OpenMP/OpenACC clause: reduction (operator:variable_list).
OMP_CLAUSE_REDUCTION_CODE: The tree_code of the operator.
Operand 1: OMP_CLAUSE_REDUCTION_INIT: Stmt-list to initialize the var.
Operand 2: OMP_CLAUSE_REDUCTION_MERGE: Stmt-list to merge private var
@@ -265,10 +265,40 @@ enum omp_clause_code {
OpenMP clause: map ({alloc:,to:,from:,tofrom:,}variable-list). */
OMP_CLAUSE_MAP,
+ /* OpenACC clause: host (variable_list). */
+ OMP_CLAUSE_HOST,
+
+ /* OpenACC clause: device (variable_list). */
+ OMP_CLAUSE_OACC_DEVICE,
+
+ /* OpenACC clause: device_resident (variable_list). */
+ OMP_CLAUSE_DEVICE_RESIDENT,
+
+ /* OpenACC clause: use_device (variable_list). */
+ OMP_CLAUSE_USE_DEVICE,
+
+ /* OpenACC clause: async [(integer-expression)]. */
+ OMP_CLAUSE_ASYNC,
+
+ /* OpenACC clause: gang [(gang-argument-list)].
+ Where
+ gang-argument-list: [gang-argument-list, ] gang-argument
+ gang-argument: [num:] integer-expression
+ | static: size-expression
+ size-expression: * | integer-expression. */
+ OMP_CLAUSE_GANG,
+
+ /* OpenACC clause/directive: wait [(integer-expression-list)]. */
+ OMP_CLAUSE_WAIT,
+
+ /* Internal structure to hold OpenACC cache directive's variable-list.
+ #pragma acc cache (variable-list). */
+ OMP_NO_CLAUSE_CACHE,
+
/* Internal clause: temporary for combined loops expansion. */
OMP_CLAUSE__LOOPTEMP_,
- /* OpenMP clause: if (scalar-expression). */
+ /* OpenMP/OpenACC clause: if (scalar-expression). */
OMP_CLAUSE_IF,
/* OpenMP clause: num_threads (integer-expression). */
@@ -281,12 +311,13 @@ enum omp_clause_code {
OMP_CLAUSE_NOWAIT,
/* OpenMP clause: ordered. */
+ /* OpenACC clause: seq. */
OMP_CLAUSE_ORDERED,
/* OpenMP clause: default. */
OMP_CLAUSE_DEFAULT,
- /* OpenMP clause: collapse (constant-integer-expression). */
+ /* OpenMP/OpenACC clause: collapse (constant-integer-expression). */
OMP_CLAUSE_COLLAPSE,
/* OpenMP clause: untied. */
@@ -338,7 +369,25 @@ enum omp_clause_code {
OMP_CLAUSE_TASKGROUP,
/* Internally used only clause, holding SIMD uid. */
- OMP_CLAUSE__SIMDUID_
+ OMP_CLAUSE__SIMDUID_,
+
+ /* OpenACC clause: independent. */
+ OMP_CLAUSE_INDEPENDENT,
+
+ /* OpenACC clause: worker [( [num:] integer-expression)]. */
+ OMP_CLAUSE_WORKER,
+
+ /* OpenACC clause: vector [( [length:] integer-expression)]. */
+ OMP_CLAUSE_VECTOR,
+
+ /* OpenACC clause: num_gangs (integer-expression). */
+ OMP_CLAUSE_NUM_GANGS,
+
+ /* OpenACC clause: num_workers (integer-expression). */
+ OMP_CLAUSE_NUM_WORKERS,
+
+ /* OpenACC clause: vector_length (integer-expression). */
+ OMP_CLAUSE_VECTOR_LENGTH
};
#undef DEFTREESTRUCT
diff --git a/gcc/tree-pretty-print.c b/gcc/tree-pretty-print.c
index 5a87728..a02c8b9 100644
--- a/gcc/tree-pretty-print.c
+++ b/gcc/tree-pretty-print.c
@@ -326,6 +326,21 @@ dump_omp_clause (pretty_printer *buffer, tree clause, int spc, int flags)
case OMP_CLAUSE__LOOPTEMP_:
name = "_looptemp_";
goto print_remap;
+ case OMP_CLAUSE_HOST:
+ name = "host";
+ goto print_remap;
+ case OMP_CLAUSE_OACC_DEVICE:
+ name = "device";
+ goto print_remap;
+ case OMP_NO_CLAUSE_CACHE:
+ name = "_cache_";
+ goto print_remap;
+ case OMP_CLAUSE_USE_DEVICE:
+ name = "use_device";
+ goto print_remap;
+ case OMP_CLAUSE_DEVICE_RESIDENT:
+ name = "device_resident";
+ goto print_remap;
print_remap:
pp_string (buffer, name);
pp_left_paren (buffer);
@@ -634,6 +649,56 @@ dump_omp_clause (pretty_printer *buffer, tree clause, int spc, int flags)
pp_right_paren (buffer);
break;
+ case OMP_CLAUSE_NUM_GANGS:
+ pp_string (buffer, "num_gangs(");
+ dump_generic_node (buffer, OMP_CLAUSE_NUM_GANGS_EXPR (clause),
+ spc, flags, false);
+ pp_character (buffer, ')');
+ break;
+
+ case OMP_CLAUSE_NUM_WORKERS:
+ pp_string (buffer, "num_workers(");
+ dump_generic_node (buffer, OMP_CLAUSE_NUM_WORKERS_EXPR (clause),
+ spc, flags, false);
+ pp_character (buffer, ')');
+ break;
+
+ case OMP_CLAUSE_VECTOR_LENGTH:
+ pp_string (buffer, "vector_length(");
+ dump_generic_node (buffer, OMP_CLAUSE_VECTOR_LENGTH_EXPR (clause),
+ spc, flags, false);
+ pp_character (buffer, ')');
+ break;
+
+ case OMP_CLAUSE_ASYNC:
+ pp_string (buffer, "async");
+ if (OMP_CLAUSE_DECL (clause))
+ {
+ pp_character(buffer, '(');
+ dump_generic_node (buffer, OMP_CLAUSE_DECL (clause),
+ spc, flags, false);
+ pp_character(buffer, ')');
+ }
+ break;
+
+ case OMP_CLAUSE_VECTOR:
+ pp_string (buffer, "vector(");
+ dump_generic_node (buffer, OMP_CLAUSE_DECL (clause), spc, flags, false);
+ pp_character(buffer, ')');
+ break;
+
+ case OMP_CLAUSE_GANG:
+ pp_string (buffer, "gang(");
+ dump_generic_node (buffer, OMP_CLAUSE_DECL (clause), spc, flags, false);
+ pp_character(buffer, ')');
+ break;
+
+ case OMP_CLAUSE_WORKER:
+ pp_string (buffer, "worker(");
+ dump_generic_node (buffer, OMP_CLAUSE_DECL (clause), spc, flags, false);
+ pp_character(buffer, ')');
+ break;
+
case OMP_CLAUSE_INBRANCH:
pp_string (buffer, "inbranch");
break;
@@ -652,6 +717,9 @@ dump_omp_clause (pretty_printer *buffer, tree clause, int spc, int flags)
case OMP_CLAUSE_TASKGROUP:
pp_string (buffer, "taskgroup");
break;
+ case OMP_CLAUSE_INDEPENDENT:
+ pp_string (buffer, "independent");
+ break;
default:
/* Should never happen. */
@@ -2384,6 +2452,41 @@ dump_generic_node (pretty_printer *buffer, tree node, int spc, int flags,
dump_omp_clauses (buffer, OACC_PARALLEL_CLAUSES (node), spc, flags);
goto dump_omp_body;
+ case OACC_KERNELS:
+ pp_string (buffer, "#pragma acc kernels");
+ dump_omp_clauses (buffer, OACC_KERNELS_CLAUSES (node), spc, flags);
+ goto dump_omp_body;
+
+ case OACC_HOST_DATA:
+ pp_string (buffer, "#pragma acc host_data");
+ dump_omp_clauses (buffer, OACC_HOST_DATA_CLAUSES (node), spc, flags);
+ goto dump_omp_body;
+
+ case OACC_DATA:
+ pp_string (buffer, "#pragma acc data");
+ dump_omp_clauses (buffer, OACC_DATA_CLAUSES (node), spc, flags);
+ goto dump_omp_body;
+
+ case OACC_WAIT:
+ pp_string (buffer, "#pragma acc wait");
+ dump_omp_clauses (buffer, OACC_WAIT_CLAUSES (node), spc, flags);
+ break;
+
+ case OACC_UPDATE:
+ pp_string (buffer, "#pragma acc update");
+ dump_omp_clauses (buffer, OACC_UPDATE_CLAUSES (node), spc, flags);
+ break;
+
+ case OACC_DECLARE:
+ pp_string (buffer, "#pragma acc declare");
+ dump_omp_clauses (buffer, OACC_DECLARE_CLAUSES (node), spc, flags);
+ break;
+
+ case OACC_CACHE:
+ pp_string (buffer, "#pragma acc cache");
+ dump_omp_clauses (buffer, OACC_CACHE_CLAUSES(node), spc, flags);
+ break;
+
case OMP_PARALLEL:
pp_string (buffer, "#pragma omp parallel");
dump_omp_clauses (buffer, OMP_PARALLEL_CLAUSES (node), spc, flags);
diff --git a/gcc/tree.c b/gcc/tree.c
index 76e3efb..3522304 100644
--- a/gcc/tree.c
+++ b/gcc/tree.c
@@ -259,6 +259,14 @@ unsigned const char omp_clause_num_ops[] =
2, /* OMP_CLAUSE_FROM */
2, /* OMP_CLAUSE_TO */
2, /* OMP_CLAUSE_MAP */
+ 1, /* OMP_CLAUSE_HOST */
+ 1, /* OMP_CLAUSE_OACC_DEVICE */
+ 1, /* OMP_CLAUSE_DEVICE_RESIDENT */
+ 1, /* OMP_CLAUSE_USE_DEVICE */
+ 1, /* OMP_CLAUSE_ASYNC */
+ 1, /* OMP_CLAUSE_GANG */
+ 1, /* OMP_CLAUSE_WAIT */
+ 1, /* OMP_NO_CLAUSE_CACHE */
1, /* OMP_CLAUSE__LOOPTEMP_ */
1, /* OMP_CLAUSE_IF */
1, /* OMP_CLAUSE_NUM_THREADS */
@@ -284,6 +292,12 @@ unsigned const char omp_clause_num_ops[] =
0, /* OMP_CLAUSE_SECTIONS */
0, /* OMP_CLAUSE_TASKGROUP */
1, /* OMP_CLAUSE__SIMDUID_ */
+ 0, /* OMP_CLAUSE_INDEPENDENT */
+ 1, /* OMP_CLAUSE_WORKER */
+ 1, /* OMP_CLAUSE_VECTOR */
+ 1, /* OMP_CLAUSE_NUM_GANGS */
+ 1, /* OMP_CLAUSE_NUM_WORKERS */
+ 1, /* OMP_CLAUSE_VECTOR_LENGTH */
};
const char * const omp_clause_code_name[] =
@@ -303,6 +317,15 @@ const char * const omp_clause_code_name[] =
"from",
"to",
"map",
+ "host",
+ "device",
+ "device_resident",
+ "use_device",
+ "delete",
+ "async",
+ "gang",
+ "wait",
+ "_cache_",
"_looptemp_",
"if",
"num_threads",
@@ -327,7 +350,13 @@ const char * const omp_clause_code_name[] =
"parallel",
"sections",
"taskgroup",
- "_simduid_"
+ "_simduid_",
+ "indepentend",
+ "worker",
+ "vector",
+ "num_gangs",
+ "num_workers",
+ "vector_length"
};
@@ -11034,6 +11063,18 @@ walk_tree_1 (tree *tp, walk_tree_fn func, void *data,
case OMP_CLAUSE:
switch (OMP_CLAUSE_CODE (*tp))
{
+ case OMP_CLAUSE_HOST:
+ case OMP_CLAUSE_OACC_DEVICE:
+ case OMP_CLAUSE_DEVICE_RESIDENT:
+ case OMP_CLAUSE_USE_DEVICE:
+ case OMP_NO_CLAUSE_CACHE:
+ case OMP_CLAUSE_ASYNC:
+ case OMP_CLAUSE_WORKER:
+ case OMP_CLAUSE_VECTOR:
+ case OMP_CLAUSE_NUM_GANGS:
+ case OMP_CLAUSE_NUM_WORKERS:
+ case OMP_CLAUSE_VECTOR_LENGTH:
+ case OMP_CLAUSE_WAIT:
case OMP_CLAUSE_PRIVATE:
case OMP_CLAUSE_SHARED:
case OMP_CLAUSE_FIRSTPRIVATE:
@@ -11056,6 +11097,7 @@ walk_tree_1 (tree *tp, walk_tree_fn func, void *data,
WALK_SUBTREE (OMP_CLAUSE_OPERAND (*tp, 0));
/* FALLTHRU */
+ case OMP_CLAUSE_INDEPENDENT:
case OMP_CLAUSE_NOWAIT:
case OMP_CLAUSE_ORDERED:
case OMP_CLAUSE_DEFAULT:
diff --git a/gcc/tree.def b/gcc/tree.def
index b921b12..08ed269 100644
--- a/gcc/tree.def
+++ b/gcc/tree.def
@@ -1017,6 +1017,56 @@ DEFTREECODE (MEM_REF, "mem_ref", tcc_reference, 2)
DEFTREECODE (OACC_PARALLEL, "oacc_parallel", tcc_statement, 2)
+/* #pragma acc kernels */
+/* Operand 0: BODY
+ Operand 1: CLAUSES
+*/
+DEFTREECODE (OACC_KERNELS, "oacc_kernels", tcc_statement, 2)
+
+/* #pragma acc data */
+/* Operand 0: BODY
+ Operand 1: CLAUSES
+*/
+DEFTREECODE (OACC_DATA, "oacc_data", tcc_statement, 2)
+
+/* #pragma acc host_data */
+/* Operand 0: BODY
+ Operand 1: CLAUSES
+*/
+DEFTREECODE (OACC_HOST_DATA, "oacc_host_data", tcc_statement, 2)
+
+/* #pragma acc declare */
+/* Operand 0: CLAUSES
+*/
+DEFTREECODE (OACC_DECLARE, "oacc_declare", tcc_statement, 1)
+
+/* #pragma acc update */
+/* Operand 0: CLAUSES
+*/
+DEFTREECODE (OACC_UPDATE, "oacc_update", tcc_statement, 1)
+
+/* #pragma acc enter data */
+/* Operand 0: CLAUSES
+*/
+
+DEFTREECODE (OACC_ENTER_DATA, "oacc_enter_data", tcc_statement, 1)
+
+/* #pragma acc exit data */
+/* Operand 0: CLAUSES
+*/
+
+DEFTREECODE (OACC_EXIT_DATA, "oacc_exit_data", tcc_statement, 1)
+
+/* #pragma acc wait */
+/* Operand 0: INT_EXPR
+*/
+DEFTREECODE (OACC_WAIT, "oacc_wait", tcc_statement, 1)
+
+/* #pragma acc cache */
+/* Operand 0: LIST
+*/
+DEFTREECODE (OACC_CACHE, "oacc_cache", tcc_statement, 1)
+
/* OpenMP - #pragma omp parallel [clause1 ... clauseN]
Operand 0: OMP_PARALLEL_BODY: Code to be executed by all threads.
Operand 1: OMP_PARALLEL_CLAUSES: List of clauses. */
diff --git a/gcc/tree.h b/gcc/tree.h
index 202ad9e..420fcd3 100644
--- a/gcc/tree.h
+++ b/gcc/tree.h
@@ -1367,6 +1367,59 @@ extern void protected_set_expr_location (tree, location_t);
#define OMP_CLAUSE_DEFAULT_KIND(NODE) \
(OMP_CLAUSE_SUBCODE_CHECK (NODE, OMP_CLAUSE_DEFAULT)->omp_clause.subcode.default_kind)
+/* OpenACC directives and clause accessors. */
+
+#define OACC_KERNELS_BODY(NODE) TREE_OPERAND (OACC_KERNELS_CHECK(NODE), 0)
+#define OACC_KERNELS_CLAUSES(NODE) TREE_OPERAND (OACC_KERNELS_CHECK(NODE), 1)
+
+#define OACC_DATA_BODY(NODE) \
+ TREE_OPERAND (OACC_DATA_CHECK (NODE), 0)
+
+#define OACC_DATA_CLAUSES(NODE) \
+ TREE_OPERAND (OACC_DATA_CHECK (NODE), 1)
+
+#define OACC_DECLARE_CLAUSES(NODE) \
+ TREE_OPERAND (OACC_DECLARE_CHECK (NODE), 0)
+
+#define OACC_UPDATE_CLAUSES(NODE) \
+ TREE_OPERAND (OACC_UPDATE_CHECK (NODE), 0)
+
+#define OACC_WAIT_CLAUSES(NODE) \
+ TREE_OPERAND (OACC_WAIT_CHECK (NODE), 0)
+
+#define OACC_CACHE_CLAUSES(NODE) \
+ TREE_OPERAND (OACC_CACHE_CHECK (NODE), 0)
+
+#define OACC_HOST_DATA_BODY(NODE) \
+ TREE_OPERAND (OACC_HOST_DATA_CHECK (NODE), 0)
+#define OACC_HOST_DATA_CLAUSES(NODE) \
+ TREE_OPERAND (OACC_HOST_DATA_CHECK (NODE), 1)
+
+/* OpenACC clauses */
+#define OMP_CLAUSE_NUM_GANGS_EXPR(NODE) \
+ OMP_CLAUSE_OPERAND (OMP_CLAUSE_SUBCODE_CHECK (NODE, OMP_CLAUSE_NUM_GANGS), 0)
+#define OMP_CLAUSE_NUM_WORKERS_EXPR(NODE) \
+ OMP_CLAUSE_OPERAND ( \
+ OMP_CLAUSE_SUBCODE_CHECK (NODE, OMP_CLAUSE_NUM_WORKERS), 0)
+#define OMP_CLAUSE_VECTOR_LENGTH_EXPR(NODE) \
+ OMP_CLAUSE_OPERAND ( \
+ OMP_CLAUSE_SUBCODE_CHECK (NODE, OMP_CLAUSE_VECTOR_LENGTH), 0)
+#define OMP_CLAUSE_VECTOR_EXPR(NODE) \
+ OMP_CLAUSE_OPERAND ( \
+ OMP_CLAUSE_SUBCODE_CHECK (NODE, OMP_CLAUSE_VECTOR_LENGTH), 0)
+#define OMP_CLAUSE_WORKER_EXPR(NODE) \
+ OMP_CLAUSE_OPERAND ( \
+ OMP_CLAUSE_SUBCODE_CHECK (NODE, OMP_CLAUSE_WORKER), 0)
+#define OMP_CLAUSE_GANG_EXPR(NODE) \
+ OMP_CLAUSE_OPERAND ( \
+ OMP_CLAUSE_SUBCODE_CHECK (NODE, OMP_CLAUSE_GANG), 0)
+#define OMP_CLAUSE_ASYNC_EXPR(NODE) \
+ OMP_CLAUSE_OPERAND ( \
+ OMP_CLAUSE_SUBCODE_CHECK (NODE, OMP_CLAUSE_ASYNC), 0)
+#define OMP_WAIT_EXPR(NODE) \
+ OMP_CLAUSE_OPERAND ( \
+ OMP_CLAUSE_SUBCODE_CHECK (NODE, OMP_CLAUSE_WAIT), 0)
+
/* SSA_NAME accessors. */
/* Returns the IDENTIFIER_NODE giving the SSA name a name or NULL_TREE
--
1.8.3.2
^ permalink raw reply [flat|nested] 89+ messages in thread
* Re: [PATCH 5/6] [GOMP4] OpenACC 1.0+ support in fortran front-end
2014-01-31 11:22 ` [PATCH 4/6] " Ilmir Usmanov
@ 2014-01-31 11:34 ` Ilmir Usmanov
2014-01-31 11:45 ` [PATCH 6/6] " Ilmir Usmanov
2014-02-09 23:43 ` [PATCH 5/6] " Tobias Burnus
2014-02-11 16:51 ` [PATCH 4/6] " Thomas Schwinge
1 sibling, 2 replies; 89+ messages in thread
From: Ilmir Usmanov @ 2014-01-31 11:34 UTC (permalink / raw)
To: Thomas Schwinge
Cc: Evgeny Gavrin, GarbuzovViacheslav, Dmitri Botcharnikov,
gcc-patches, jakub, fortran
[-- Attachment #1: Type: text/plain, Size: 844 bytes --]
OpenACC 1.0 fortran FE support -- tests.
gcc/testsuite/gfortran.dg/goacc/
* goacc.exp: New test directory.
* branch.f95: New test.
* continuation-free-form.f95: Likewise.
* data-clauses.f95: Likewise.
* data-tree.f95: Likewise.
* declare-1.f95: Likewise.
* declare.f95: Likewise.
* directive-names.f95: Likewise.
* enter-exit-data.f95: Likewise.
* host_data-tree.f95: Likewise.
* if.f95: Likewise.
* kernels-tree.f95: Likewise.
* list.f95: Likewise.
* parallel-kernels-clauses.f95: Likewise.
* parallel-kernels-regions.f95: Likewise.
* parallel-tree.f95: Likewise.
* pure-elemental-procedures.f95: Likewise.
* reduction.f95: Likewise.
* sentinel-free-form.f95: Likewise.
* several-directives.f95: Likewise.
* sie.f95: Likewise.
[-- Attachment #2: 0005-OpenACC-fortran-tests.patch --]
[-- Type: text/x-diff, Size: 51062 bytes --]
From 9850a2e343e506fa06edf1518414ac71eed60d48 Mon Sep 17 00:00:00 2001
From: Ilmir Usmanov <i.usmanov@samsung.com>
Date: Fri, 31 Jan 2014 13:29:44 +0400
Subject: [PATCH 5/6] OpenACC fortran tests
---
gcc/testsuite/gfortran.dg/goacc/branch.f95 | 55 +++++
.../gfortran.dg/goacc/continuation-free-form.f95 | 24 ++
gcc/testsuite/gfortran.dg/goacc/data-clauses.f95 | 261 +++++++++++++++++++++
gcc/testsuite/gfortran.dg/goacc/data-tree.f95 | 33 +++
gcc/testsuite/gfortran.dg/goacc/declare-1.f95 | 13 +
.../gfortran.dg/goacc/directive-names.f95 | 20 ++
.../gfortran.dg/goacc/enter-exit-data.f95 | 89 +++++++
gcc/testsuite/gfortran.dg/goacc/goacc.exp | 36 +++
gcc/testsuite/gfortran.dg/goacc/host_data-tree.f95 | 13 +
gcc/testsuite/gfortran.dg/goacc/if.f95 | 53 +++++
gcc/testsuite/gfortran.dg/goacc/kernels-tree.f95 | 34 +++
gcc/testsuite/gfortran.dg/goacc/list.f95 | 111 +++++++++
.../gfortran.dg/goacc/parallel-kernels-clauses.f95 | 96 ++++++++
.../gfortran.dg/goacc/parallel-kernels-regions.f95 | 57 +++++
gcc/testsuite/gfortran.dg/goacc/parallel-tree.f95 | 42 ++++
.../goacc/pure-elemental-procedures.f95 | 46 ++++
gcc/testsuite/gfortran.dg/goacc/reduction.f95 | 138 +++++++++++
.../gfortran.dg/goacc/sentinel-free-form.f95 | 22 ++
.../gfortran.dg/goacc/several-directives.f95 | 7 +
gcc/testsuite/gfortran.dg/goacc/sie.f95 | 252 ++++++++++++++++++++
20 files changed, 1402 insertions(+)
create mode 100644 gcc/testsuite/gfortran.dg/goacc/branch.f95
create mode 100644 gcc/testsuite/gfortran.dg/goacc/continuation-free-form.f95
create mode 100644 gcc/testsuite/gfortran.dg/goacc/data-clauses.f95
create mode 100644 gcc/testsuite/gfortran.dg/goacc/data-tree.f95
create mode 100644 gcc/testsuite/gfortran.dg/goacc/declare-1.f95
create mode 100644 gcc/testsuite/gfortran.dg/goacc/directive-names.f95
create mode 100644 gcc/testsuite/gfortran.dg/goacc/enter-exit-data.f95
create mode 100644 gcc/testsuite/gfortran.dg/goacc/goacc.exp
create mode 100644 gcc/testsuite/gfortran.dg/goacc/host_data-tree.f95
create mode 100644 gcc/testsuite/gfortran.dg/goacc/if.f95
create mode 100644 gcc/testsuite/gfortran.dg/goacc/kernels-tree.f95
create mode 100644 gcc/testsuite/gfortran.dg/goacc/list.f95
create mode 100644 gcc/testsuite/gfortran.dg/goacc/parallel-kernels-clauses.f95
create mode 100644 gcc/testsuite/gfortran.dg/goacc/parallel-kernels-regions.f95
create mode 100644 gcc/testsuite/gfortran.dg/goacc/parallel-tree.f95
create mode 100644 gcc/testsuite/gfortran.dg/goacc/pure-elemental-procedures.f95
create mode 100644 gcc/testsuite/gfortran.dg/goacc/reduction.f95
create mode 100644 gcc/testsuite/gfortran.dg/goacc/sentinel-free-form.f95
create mode 100644 gcc/testsuite/gfortran.dg/goacc/several-directives.f95
create mode 100644 gcc/testsuite/gfortran.dg/goacc/sie.f95
diff --git a/gcc/testsuite/gfortran.dg/goacc/branch.f95 b/gcc/testsuite/gfortran.dg/goacc/branch.f95
new file mode 100644
index 0000000..e470ce2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/branch.f95
@@ -0,0 +1,55 @@
+! { dg-do compile }
+! { dg-options "-fopenacc" }
+
+program test
+ implicit none
+
+ integer :: i
+
+ if (.true.) then
+ !$acc parallel
+ end if ! { dg-error "Unexpected" }
+ !$acc end parallel
+ end if
+
+ if (.true.) then
+ !$acc kernels
+ end if ! { dg-error "Unexpected" }
+ !$acc end kernels
+ end if
+
+ !$acc parallel
+ if (.true.) then
+ !$acc end parallel ! { dg-error "Unexpected" }
+ end if
+ !$acc end parallel
+
+ !$acc kernels
+ if (.true.) then
+ !$acc end kernels ! { dg-error "Unexpected" }
+ end if
+ !$acc end kernels
+
+ !$acc parallel
+ if (.true.) then
+ end if
+ !$acc end parallel
+
+ !$acc kernels
+ if (.true.) then
+ end if
+ !$acc end kernels
+
+ if (.true.) then
+ !$acc parallel
+ !$acc end parallel
+ end if
+
+ if (.true.) then
+ !$acc kernels
+ !$acc end kernels
+ end if
+10 i = 0
+
+
+end program test
\ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/goacc/continuation-free-form.f95 b/gcc/testsuite/gfortran.dg/goacc/continuation-free-form.f95
new file mode 100644
index 0000000..df32d9c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/continuation-free-form.f95
@@ -0,0 +1,24 @@
+! { dg-do compile }
+! { dg-options "-fopenacc" }
+
+program test
+ implicit none
+
+ integer :: i
+ real :: x
+
+ !$acc parallel &
+ !$acc loop & ! continuation
+ !$acc & reduction(+:x)
+
+ ! this line must be ignored
+ !$acc ! kernels
+ do i = 1,10
+ x = x + 0.3
+ enddo
+ ! continuation must begin with sentinel
+ !$acc end parallel & ! { dg-error "Unclassifiable OpenACC directive" }
+ ! loop
+
+ print *, x
+end
\ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/goacc/data-clauses.f95 b/gcc/testsuite/gfortran.dg/goacc/data-clauses.f95
new file mode 100644
index 0000000..1e0e246
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/data-clauses.f95
@@ -0,0 +1,261 @@
+! { dg-do compile }
+! { dg-options "-fopenacc -fmax-errors=100" }
+
+! todo: some of warnings are not necessary
+
+module test
+ implicit none
+contains
+
+ subroutine foo (vi)
+ integer, value :: vi
+ integer :: i, ia(10)
+ complex :: c, ca(10)
+ real, target:: r
+ real :: ra(10)
+ real, pointer :: rp
+ real, dimension(:), allocatable :: aa
+ type t
+ integer :: i
+ end type
+ type(t) :: ti
+ type(t), allocatable :: tia
+ type(t), target :: tit
+ type(t), pointer :: tip
+ rp => r
+ tip => tit
+
+ !$acc parallel deviceptr (rp) ! { dg-error "POINTER" }
+ !$acc end parallel
+ !$acc parallel deviceptr (vi) ! { dg-error "VALUE" }
+ !$acc end parallel
+ !$acc parallel deviceptr (aa) ! { dg-error "ALLOCATABLE" }
+ !$acc end parallel
+
+ !$acc parallel deviceptr (i, c, r, ia, ca, ra, ti)
+ !$acc end parallel
+ !$acc kernels deviceptr (i, c, r, ia, ca, ra, ti)
+ !$acc end kernels
+ !$acc data deviceptr (i, c, r, ia, ca, ra, ti)
+ !$acc end data
+
+
+ !$acc parallel copy (tip) ! { dg-error "POINTER" }
+ !$acc end parallel
+ !$acc parallel copy (tia) ! { dg-error "ALLOCATABLE" }
+ !$acc end parallel
+ !$acc parallel deviceptr (i) copy (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+
+ !$acc parallel copy (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end parallel
+ !$acc kernels copy (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end kernels
+ !$acc data copy (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end data
+
+
+ !$acc parallel copyin (tip) ! { dg-error "POINTER" }
+ !$acc end parallel
+ !$acc parallel copyin (tia) ! { dg-error "ALLOCATABLE" }
+ !$acc end parallel
+ !$acc parallel deviceptr (i) copyin (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel copy (i) copyin (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+
+ !$acc parallel copyin (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end parallel
+ !$acc kernels copyin (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end kernels
+ !$acc data copyin (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end data
+
+
+ !$acc parallel copyout (tip) ! { dg-error "POINTER" }
+ !$acc end parallel
+ !$acc parallel copyout (tia) ! { dg-error "ALLOCATABLE" }
+ !$acc end parallel
+ !$acc parallel deviceptr (i) copyout (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel copy (i) copyout (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel copyin (i) copyout (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+
+ !$acc parallel copyout (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end parallel
+ !$acc kernels copyout (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end kernels
+ !$acc data copyout (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end data
+
+
+ !$acc parallel create (tip) ! { dg-error "POINTER" }
+ !$acc end parallel
+ !$acc parallel create (tia) ! { dg-error "ALLOCATABLE" }
+ !$acc end parallel
+ !$acc parallel deviceptr (i) create (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel copy (i) create (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel copyin (i) create (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel copyout (i) create (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+
+ !$acc parallel create (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end parallel
+ !$acc kernels create (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end kernels
+ !$acc data create (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end data
+
+
+ !$acc parallel present (tip) ! { dg-error "POINTER" }
+ !$acc end parallel
+ !$acc parallel present (tia) ! { dg-error "ALLOCATABLE" }
+ !$acc end parallel
+ !$acc parallel deviceptr (i) present (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel copy (i) present (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel copyin (i) present (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel copyout (i) present (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel create (i) present (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+
+ !$acc parallel present (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end parallel
+ !$acc kernels present (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end kernels
+ !$acc data present (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end data
+
+
+ !$acc parallel pcopy (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end parallel
+ !$acc parallel pcopyin (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end parallel
+ !$acc parallel pcopyout (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end parallel
+ !$acc parallel pcreate (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end parallel
+
+
+ !$acc parallel present_or_copy (tip) ! { dg-error "POINTER" }
+ !$acc end parallel
+ !$acc parallel present_or_copy (tia) ! { dg-error "ALLOCATABLE" }
+ !$acc end parallel
+ !$acc parallel deviceptr (i) present_or_copy (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel copy (i) present_or_copy (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel copyin (i) present_or_copy (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel copyout (i) present_or_copy (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel create (i) present_or_copy (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel present (i) present_or_copy (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+
+ !$acc parallel present_or_copy (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end parallel
+ !$acc kernels present_or_copy (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end kernels
+ !$acc data present_or_copy (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end data
+
+
+ !$acc parallel present_or_copyin (tip) ! { dg-error "POINTER" }
+ !$acc end parallel
+ !$acc parallel present_or_copyin (tia) ! { dg-error "ALLOCATABLE" }
+ !$acc end parallel
+ !$acc parallel deviceptr (i) present_or_copyin (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel copy (i) present_or_copyin (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel copyin (i) present_or_copyin (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel copyout (i) present_or_copyin (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel create (i) present_or_copyin (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel present (i) present_or_copyin (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel present_or_copy (i) present_or_copyin (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+
+ !$acc parallel present_or_copyin (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end parallel
+ !$acc kernels present_or_copyin (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end kernels
+ !$acc data present_or_copyin (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end data
+
+
+ !$acc parallel present_or_copyout (tip) ! { dg-error "POINTER" }
+ !$acc end parallel
+ !$acc parallel present_or_copyout (tia) ! { dg-error "ALLOCATABLE" }
+ !$acc end parallel
+ !$acc parallel deviceptr (i) present_or_copyout (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel copy (i) present_or_copyout (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel copyin (i) present_or_copyout (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel copyout (i) present_or_copyout (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel create (i) present_or_copyout (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel present (i) present_or_copyout (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel present_or_copy (i) present_or_copyout (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel present_or_copyin (i) present_or_copyout (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+
+ !$acc parallel present_or_copyout (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end parallel
+ !$acc kernels present_or_copyout (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end kernels
+ !$acc data present_or_copyout (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end data
+
+
+ !$acc parallel present_or_create (tip) ! { dg-error "POINTER" }
+ !$acc end parallel
+ !$acc parallel present_or_create (tia) ! { dg-error "ALLOCATABLE" }
+ !$acc end parallel
+ !$acc parallel deviceptr (i) present_or_create (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel copy (i) present_or_create (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel copyin (i) present_or_create (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel copyout (i) present_or_create (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel create (i) present_or_create (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel present (i) present_or_create (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel present_or_copy (i) present_or_create (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel present_or_copyin (i) present_or_create (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel present_or_copyout (i) present_or_create (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+
+ !$acc parallel present_or_create (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end parallel
+ !$acc kernels present_or_create (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end kernels
+ !$acc data present_or_create (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end data
+
+ end subroutine foo
+
+end module test
\ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/goacc/data-tree.f95 b/gcc/testsuite/gfortran.dg/goacc/data-tree.f95
new file mode 100644
index 0000000..e7929f8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/data-tree.f95
@@ -0,0 +1,33 @@
+! { dg-do compile }
+! { dg-options "-fopenacc -fdump-tree-original" }
+
+! test for tree-dump-original and spaces-commas
+
+program test
+ implicit none
+ integer :: q, i, j, k, m, n, o, p, r, s, t, u, v, w
+ logical :: l
+
+ !$acc data if(l) copy(i), copyin(j), copyout(k), create(m) &
+ !$acc present(o), pcopy(p), pcopyin(r), pcopyout(s), pcreate(t) &
+ !$acc deviceptr(u)
+ !$acc end data
+
+end program test
+! { dg-excess-errors "unimplemented" }
+! { dg-final { scan-tree-dump "pragma acc data" "original" } }
+
+! { dg-final { scan-tree-dump "if" "original" } }
+! { dg-final { scan-tree-dump "force_tofrom" "original" } }
+! { dg-final { scan-tree-dump "force_to" "original" } }
+! { dg-final { scan-tree-dump "force_from" "original" } }
+! { dg-final { scan-tree-dump "force_alloc" "original" } }
+
+! { dg-final { scan-tree-dump "force_present" "original" } }
+! { dg-final { scan-tree-dump "tofrom" "original" } }
+! { dg-final { scan-tree-dump "to" "original" } }
+! { dg-final { scan-tree-dump "from" "original" } }
+! { dg-final { scan-tree-dump "alloc" "original" } }
+
+! { dg-final { scan-tree-dump "force_deviceptr" "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
\ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/goacc/declare-1.f95 b/gcc/testsuite/gfortran.dg/goacc/declare-1.f95
new file mode 100644
index 0000000..2784214
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/declare-1.f95
@@ -0,0 +1,13 @@
+! { dg-do compile }
+! { dg-options "-fopenacc -fdump-tree-original" }
+program test
+ implicit none
+ integer :: i
+
+ !$acc declare copy(i)
+
+end program test
+! { dg-excess-errors "unimplemented" }
+! { dg-final { scan-tree-dump "pragma acc declare" "original" } }
+! { dg-final { scan-tree-dump "force_tofrom" "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
diff --git a/gcc/testsuite/gfortran.dg/goacc/directive-names.f95 b/gcc/testsuite/gfortran.dg/goacc/directive-names.f95
new file mode 100644
index 0000000..f9e3a5d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/directive-names.f95
@@ -0,0 +1,20 @@
+! { dg-do compile }
+! { dg-options "-fopenacc" }
+
+program test
+ implicit none
+
+ !$acc parallel
+ !$acc end parallel
+
+ !$acc kernels
+ !$acc end kernels
+
+ !$acc data
+ !$acc end data
+
+ !$acc host_data
+ !$acc end host_data
+
+end program test
+! { dg-excess-errors "unimplemented" }
\ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/goacc/enter-exit-data.f95 b/gcc/testsuite/gfortran.dg/goacc/enter-exit-data.f95
new file mode 100644
index 0000000..58c2db3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/enter-exit-data.f95
@@ -0,0 +1,89 @@
+! { dg-do compile }
+! { dg-options "-fopenacc -fmax-errors=100" }
+
+
+module test
+ implicit none
+contains
+
+ subroutine foo (vi)
+ logical :: l
+ integer, value :: vi
+ integer :: i, ia(10), a(10), b(2:8)
+ complex :: c, ca(10)
+ real, target:: r
+ real :: ra(10)
+ real, pointer :: rp
+ real, dimension(:), allocatable :: aa
+ type t
+ integer :: i
+ end type
+ type(t) :: ti
+ type(t), allocatable :: tia
+ type(t), target :: tit
+ type(t), pointer :: tip
+ rp => r
+ tip => tit
+
+ ! enter data
+ !$acc enter data
+ !$acc enter data if (.false.)
+ !$acc enter data if (l)
+ !$acc enter data if (.false.) if (l) ! { dg-error "Unclassifiable" }
+ !$acc enter data if (i) ! { dg-error "LOGICAL" }
+ !$acc enter data if (1) ! { dg-error "LOGICAL" }
+ !$acc enter data if (a) ! { dg-error "LOGICAL" }
+ !$acc enter data if (b(5:6)) ! { dg-error "LOGICAL" }
+ !$acc enter data async (l) ! { dg-error "INTEGER" }
+ !$acc enter data async (.true.) ! { dg-error "INTEGER" }
+ !$acc enter data async (1)
+ !$acc enter data async (i)
+ !$acc enter data async (a) ! { dg-error "INTEGER" }
+ !$acc enter data async (b(5:6)) ! { dg-error "INTEGER" }
+ !$acc enter data wait (l) ! { dg-error "INTEGER" }
+ !$acc enter data wait (.true.) ! { dg-error "INTEGER" }
+ !$acc enter data wait (i, 1)
+ !$acc enter data wait (a) ! { dg-error "INTEGER" }
+ !$acc enter data wait (b(5:6)) ! { dg-error "INTEGER" }
+ !$acc enter data copyin (tip) ! { dg-error "POINTER" }
+ !$acc enter data copyin (tia) ! { dg-error "ALLOCATABLE" }
+ !$acc enter data create (tip) ! { dg-error "POINTER" }
+ !$acc enter data create (tia) ! { dg-error "ALLOCATABLE" }
+ !$acc enter data present_or_copyin (tip) ! { dg-error "POINTER" }
+ !$acc enter data present_or_copyin (tia) ! { dg-error "ALLOCATABLE" }
+ !$acc enter data present_or_create (tip) ! { dg-error "POINTER" }
+ !$acc enter data present_or_create (tia) ! { dg-error "ALLOCATABLE" }
+ !$acc enter data copyin (i) create (i) ! { dg-error "multiple clauses" }
+ !$acc enter data copyin (i) present_or_copyin (i) ! { dg-error "multiple clauses" }
+ !$acc enter data create (i) present_or_copyin (i) ! { dg-error "multiple clauses" }
+ !$acc enter data copyin (i) present_or_create (i) ! { dg-error "multiple clauses" }
+ !$acc enter data create (i) present_or_create (i) ! { dg-error "multiple clauses" }
+ !$acc enter data present_or_copyin (i) present_or_create (i) ! { dg-error "multiple clauses" }
+
+ ! exit data
+ !$acc exit data
+ !$acc exit data if (.false.)
+ !$acc exit data if (l)
+ !$acc exit data if (.false.) if (l) ! { dg-error "Unclassifiable" }
+ !$acc exit data if (i) ! { dg-error "LOGICAL" }
+ !$acc exit data if (1) ! { dg-error "LOGICAL" }
+ !$acc exit data if (a) ! { dg-error "LOGICAL" }
+ !$acc exit data if (b(5:6)) ! { dg-error "LOGICAL" }
+ !$acc exit data async (l) ! { dg-error "INTEGER" }
+ !$acc exit data async (.true.) ! { dg-error "INTEGER" }
+ !$acc exit data async (1)
+ !$acc exit data async (i)
+ !$acc exit data async (a) ! { dg-error "INTEGER" }
+ !$acc exit data async (b(5:6)) ! { dg-error "INTEGER" }
+ !$acc exit data wait (l) ! { dg-error "INTEGER" }
+ !$acc exit data wait (.true.) ! { dg-error "INTEGER" }
+ !$acc exit data wait (i, 1)
+ !$acc exit data wait (a) ! { dg-error "INTEGER" }
+ !$acc exit data wait (b(5:6)) ! { dg-error "INTEGER" }
+ !$acc exit data copyout (tip) ! { dg-error "POINTER" }
+ !$acc exit data copyout (tia) ! { dg-error "ALLOCATABLE" }
+ !$acc exit data delete (tip) ! { dg-error "POINTER" }
+ !$acc exit data delete (tia) ! { dg-error "ALLOCATABLE" }
+ !$acc exit data copyout (i) delete (i) ! { dg-error "multiple clauses" }
+ end subroutine foo
+end module test
diff --git a/gcc/testsuite/gfortran.dg/goacc/goacc.exp b/gcc/testsuite/gfortran.dg/goacc/goacc.exp
new file mode 100644
index 0000000..9ab131c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/goacc.exp
@@ -0,0 +1,36 @@
+# Copyright (C) 2005-2013 Free Software Foundation, Inc.
+#
+# This file is part of GCC.
+#
+# GCC is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3, or (at your option)
+# any later version.
+#
+# GCC is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with GCC; see the file COPYING3. If not see
+# <http://www.gnu.org/licenses/>.
+
+# GCC testsuite that uses the `dg.exp' driver.
+
+# Load support procs.
+load_lib gfortran-dg.exp
+
+if ![check_effective_target_fopenmp] {
+ return
+}
+
+# Initialize `dg'.
+dg-init
+
+# Main loop.
+gfortran-dg-runtest [lsort \
+ [find $srcdir/$subdir *.\[fF\]{,90,95,03,08} ] ] " -fopenacc -fdump-parse-tree"
+
+# All done.
+dg-finish
diff --git a/gcc/testsuite/gfortran.dg/goacc/host_data-tree.f95 b/gcc/testsuite/gfortran.dg/goacc/host_data-tree.f95
new file mode 100644
index 0000000..d2cf8df
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/host_data-tree.f95
@@ -0,0 +1,13 @@
+! { dg-do compile }
+! { dg-options "-fopenacc -fdump-tree-original" }
+
+program test
+ implicit none
+ integer :: i
+
+ !$acc host_data use_device(i)
+ !$acc end host_data
+end program test
+! { dg-excess-errors "unimplemented" }
+! { dg-final { scan-tree-dump "pragma acc host_data use_device" "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
diff --git a/gcc/testsuite/gfortran.dg/goacc/if.f95 b/gcc/testsuite/gfortran.dg/goacc/if.f95
new file mode 100644
index 0000000..f543c8a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/if.f95
@@ -0,0 +1,53 @@
+! { dg-do compile }
+! { dg-options "-fopenacc" }
+
+program test
+ implicit none
+
+ logical :: x
+ integer :: i
+
+ !$acc parallel if ! { dg-error "Unclassifiable OpenACC directive" }
+ !$acc parallel if () ! { dg-error "Invalid character" }
+ !$acc parallel if (i) ! { dg-error "scalar LOGICAL expression" }
+ !$acc end parallel
+ !$acc parallel if (1) ! { dg-error "scalar LOGICAL expression" }
+ !$acc end parallel
+ !$acc kernels if (i) ! { dg-error "scalar LOGICAL expression" }
+ !$acc end kernels
+ !$acc kernels if ! { dg-error "Unclassifiable OpenACC directive" }
+ !$acc kernels if () ! { dg-error "Invalid character" }
+ !$acc kernels if (1) ! { dg-error "scalar LOGICAL expression" }
+ !$acc end kernels
+ !$acc data if ! { dg-error "Unclassifiable OpenACC directive" }
+ !$acc data if () ! { dg-error "Invalid character" }
+ !$acc data if (i) ! { dg-error "scalar LOGICAL expression" }
+ !$acc end data
+ !$acc data if (1) ! { dg-error "scalar LOGICAL expression" }
+ !$acc end data
+
+ ! at most one if clause may appear
+ !$acc parallel if (.false.) if (.false.) { dg-error "Unclassifiable OpenACC directive" }
+ !$acc kernels if (.false.) if (.false.) { dg-error "Unclassifiable OpenACC directive" }
+ !$acc data if (.false.) if (.false.) { dg-error "Unclassifiable OpenACC directive" }
+
+ !$acc parallel if (x)
+ !$acc end parallel
+ !$acc parallel if (.true.)
+ !$acc end parallel
+ !$acc parallel if (i.gt.1)
+ !$acc end parallel
+ !$acc kernels if (x)
+ !$acc end kernels
+ !$acc kernels if (.true.)
+ !$acc end kernels
+ !$acc kernels if (i.gt.1)
+ !$acc end kernels
+ !$acc data if (x)
+ !$acc end data
+ !$acc data if (.true.)
+ !$acc end data
+ !$acc data if (i.gt.1)
+ !$acc end data
+
+end program test
\ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/goacc/kernels-tree.f95 b/gcc/testsuite/gfortran.dg/goacc/kernels-tree.f95
new file mode 100644
index 0000000..1fd4d52
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/kernels-tree.f95
@@ -0,0 +1,34 @@
+! { dg-do compile }
+! { dg-options "-fopenacc -fdump-tree-original" }
+
+! test for tree-dump-original and spaces-commas
+
+program test
+ implicit none
+ integer :: q, i, j, k, m, n, o, p, r, s, t, u, v, w
+ logical :: l
+
+ !$acc kernels if(l) async copy(i), copyin(j), copyout(k), create(m) &
+ !$acc present(o), pcopy(p), pcopyin(r), pcopyout(s), pcreate(t) &
+ !$acc deviceptr(u)
+ !$acc end kernels
+
+end program test
+! { dg-excess-errors "unimplemented" }
+! { dg-final { scan-tree-dump "pragma acc kernels" "original" } }
+
+! { dg-final { scan-tree-dump "if" "original" } }
+! { dg-final { scan-tree-dump "async" "original" } }
+! { dg-final { scan-tree-dump "force_tofrom" "original" } }
+! { dg-final { scan-tree-dump "force_to" "original" } }
+! { dg-final { scan-tree-dump "force_from" "original" } }
+! { dg-final { scan-tree-dump "force_alloc" "original" } }
+
+! { dg-final { scan-tree-dump "force_present" "original" } }
+! { dg-final { scan-tree-dump "tofrom" "original" } }
+! { dg-final { scan-tree-dump "to" "original" } }
+! { dg-final { scan-tree-dump "from" "original" } }
+! { dg-final { scan-tree-dump "alloc" "original" } }
+
+! { dg-final { scan-tree-dump "force_deviceptr" "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
diff --git a/gcc/testsuite/gfortran.dg/goacc/list.f95 b/gcc/testsuite/gfortran.dg/goacc/list.f95
new file mode 100644
index 0000000..6139f11
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/list.f95
@@ -0,0 +1,111 @@
+! { dg-do compile }
+! { dg-options "-fopenacc -fmax-errors=100" }
+
+program test
+ implicit none
+
+ integer :: i, j, k, l, a(10)
+ common /b/ j, k
+ real, pointer :: p1 => NULL()
+ complex :: c, d(10)
+
+ !$acc parallel private(i)
+ !$acc end parallel
+
+ !$acc parallel private(a)
+ !$acc end parallel
+
+ !$acc parallel private(c, d)
+ !$acc end parallel
+
+ !$acc parallel private(i, j, k, l, a)
+ !$acc end parallel
+
+ !$acc parallel private (i) private (j)
+ !$acc end parallel
+
+ !$acc parallel private ! { dg-error "Unclassifiable OpenACC directive" }
+
+ !$acc parallel private() ! { dg-error "Syntax error" }
+
+ !$acc parallel private(a(1:3)) ! { dg-error "Syntax error" }
+
+ !$acc parallel private(10) ! { dg-error "Syntax error" }
+
+ !$acc parallel private(/b/, /b/) ! { dg-error "present on multiple clauses" }
+ !$acc end parallel
+
+ !$acc parallel private(i, j, i) ! { dg-error "present on multiple clauses" }
+ !$acc end parallel
+
+ !$acc parallel private(p1)
+ !$acc end parallel
+
+ !$acc parallel firstprivate(i)
+ !$acc end parallel
+
+ !$acc parallel firstprivate(c, d)
+ !$acc end parallel
+
+ !$acc parallel firstprivate(a)
+ !$acc end parallel
+
+ !$acc parallel firstprivate(i, j, k, l, a)
+ !$acc end parallel
+
+ !$acc parallel firstprivate (i) firstprivate (j)
+ !$acc end parallel
+
+ !$acc parallel firstprivate ! { dg-error "Unclassifiable OpenACC directive" }
+
+ !$acc parallel firstprivate() ! { dg-error "Syntax error" }
+
+ !$acc parallel firstprivate(a(1:3)) ! { dg-error "Syntax error" }
+
+ !$acc parallel firstprivate(10) ! { dg-error "Syntax error" }
+
+ !$acc parallel firstprivate (/b/, /b/) ! { dg-error "present on multiple clauses" }
+ !$acc end parallel
+
+ !$acc parallel firstprivate (i, j, i) ! { dg-error "present on multiple clauses" }
+ !$acc end parallel
+
+ !$acc parallel firstprivate(p1)
+ !$acc end parallel
+
+ !$acc parallel private (i) firstprivate (i) ! { dg-error "present on multiple clauses" }
+ !$acc end parallel
+
+ !$acc host_data use_device(i)
+ !$acc end host_data
+
+ !$acc host_data use_device(c, d)
+ !$acc end host_data
+
+ !$acc host_data use_device(a)
+ !$acc end host_data
+
+ !$acc host_data use_device(i, j, k, l, a)
+ !$acc end host_data
+
+ !$acc host_data use_device (i) use_device (j)
+ !$acc end host_data
+
+ !$acc host_data use_device ! { dg-error "Unclassifiable OpenACC directive" }
+
+ !$acc host_data use_device() ! { dg-error "Syntax error" }
+
+ !$acc host_data use_device(a(1:3)) ! { dg-error "Syntax error" }
+
+ !$acc host_data use_device(10) ! { dg-error "Syntax error" }
+
+ !$acc host_data use_device(/b/, /b/) ! { dg-error "present on multiple clauses" }
+ !$acc end host_data
+
+ !$acc host_data use_device(i, j, i) ! { dg-error "present on multiple clauses" }
+ !$acc end host_data
+
+ !$acc host_data use_device(p1) ! { dg-error "POINTER" }
+ !$acc end host_data
+
+end program test
\ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/goacc/parallel-kernels-clauses.f95 b/gcc/testsuite/gfortran.dg/goacc/parallel-kernels-clauses.f95
new file mode 100644
index 0000000..4ee080d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/parallel-kernels-clauses.f95
@@ -0,0 +1,96 @@
+! { dg-do compile }
+! { dg-options "-fopenacc -fmax-errors=100" }
+
+! test clauses added in OpenACC ver 2.0
+
+program test
+ implicit none
+ integer :: i, a(10), b(5:7)
+ integer, parameter :: acc_async_noval = -1
+ integer, parameter :: acc_async_sync = -2
+ logical :: l
+
+ ! async
+ !$acc kernels async(i)
+ !$acc end kernels
+ !$acc parallel async(i)
+ !$acc end parallel
+
+ !$acc kernels async(0, 1) { dg-error "Unclassifiable" }
+ !$acc parallel async(0, 1) { dg-error "Unclassifiable" }
+
+ !$acc kernels async
+ !$acc end kernels
+ !$acc parallel async
+ !$acc end parallel
+
+ !$acc kernels async(acc_async_noval)
+ !$acc end kernels
+ !$acc parallel async(acc_async_noval)
+ !$acc end parallel
+
+ !$acc kernels async(acc_async_sync)
+ !$acc end kernels
+ !$acc parallel async(acc_async_sync)
+ !$acc end parallel
+
+ !$acc kernels async() { dg-error "Invalid character" }
+ !$acc parallel async() { dg-error "Invalid character" }
+
+ !$acc kernels async("a") { dg-error "Unclassifiable" }
+ !$acc parallel async("a") { dg-error "Unclassifiable" }
+
+ !$acc kernels async(.true.) { dg-error "Unclassifiable" }
+ !$acc parallel async(.true.) { dg-error "Unclassifiable" }
+
+ ! default(none)
+ !$acc kernels default(none)
+ !$acc end kernels
+ !$acc parallel default(none)
+ !$acc end parallel
+
+ !$acc kernels default (none)
+ !$acc end kernels
+ !$acc parallel default (none)
+ !$acc end parallel
+
+ !$acc kernels default ( none )
+ !$acc end kernels
+ !$acc parallel default ( none )
+ !$acc end parallel
+
+ !$acc kernels default { dg-error "Unclassifiable" }
+ !$acc parallel default { dg-error "Unclassifiable" }
+
+ !$acc kernels default() { dg-error "Unclassifiable" }
+ !$acc parallel default() { dg-error "Unclassifiable" }
+
+ !$acc kernels default(i) { dg-error "Unclassifiable" }
+ !$acc parallel default(i) { dg-error "Unclassifiable" }
+
+ !$acc kernels default(1) { dg-error "Unclassifiable" }
+ !$acc parallel default(1) { dg-error "Unclassifiable" }
+
+ ! Wait
+ !$acc kernels wait (l) ! { dg-error "INTEGER" }
+ !$acc end kernels
+ !$acc kernels wait (.true.) ! { dg-error "INTEGER" }
+ !$acc end kernels
+ !$acc kernels wait (i, 1)
+ !$acc end kernels
+ !$acc kernels wait (a) ! { dg-error "INTEGER" }
+ !$acc end kernels
+ !$acc kernels wait (b(5:6)) ! { dg-error "INTEGER" }
+ !$acc end kernels
+
+ !$acc parallel wait (l) ! { dg-error "INTEGER" }
+ !$acc end parallel
+ !$acc parallel wait (.true.) ! { dg-error "INTEGER" }
+ !$acc end parallel
+ !$acc parallel wait (i, 1)
+ !$acc end parallel
+ !$acc parallel wait (a) ! { dg-error "INTEGER" }
+ !$acc end parallel
+ !$acc parallel wait (b(5:6)) ! { dg-error "INTEGER" }
+ !$acc end parallel
+end
diff --git a/gcc/testsuite/gfortran.dg/goacc/parallel-kernels-regions.f95 b/gcc/testsuite/gfortran.dg/goacc/parallel-kernels-regions.f95
new file mode 100644
index 0000000..3208315
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/parallel-kernels-regions.f95
@@ -0,0 +1,57 @@
+! { dg-do compile }
+! { dg-options "-fopenacc" }
+
+! OpenACC 2.0 allows nested parallel/kernels regions
+! However, in middle-end there is check for nested parallel
+
+program test
+ implicit none
+
+ integer :: i
+
+ !$acc parallel
+ !$acc kernels
+ !$acc end kernels
+ !$acc end parallel
+
+ !$acc parallel
+ !$acc parallel ! { dg-error "may not be nested" }
+ !$acc end parallel
+ !$acc end parallel
+
+ !$acc parallel
+ !$acc parallel ! { dg-error "may not be nested" }
+ !$acc end parallel
+ !$acc kernels
+ !$acc end kernels
+ !$acc end parallel
+
+ !$acc kernels
+ !$acc kernels
+ !$acc end kernels
+ !$acc end kernels
+
+ !$acc kernels
+ !$acc parallel
+ !$acc end parallel
+ !$acc end kernels
+
+ !$acc kernels
+ !$acc parallel
+ !$acc end parallel
+ !$acc kernels
+ !$acc end kernels
+ !$acc end kernels
+
+ !$acc parallel
+ !$acc data
+ !$acc end data
+ !$acc end parallel
+
+ !$acc kernels
+ !$acc data
+ !$acc end data
+ !$acc end kernels
+
+end program test
+! { dg-excess-errors "unimplemented" }
\ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/goacc/parallel-tree.f95 b/gcc/testsuite/gfortran.dg/goacc/parallel-tree.f95
new file mode 100644
index 0000000..2c7ee5b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/parallel-tree.f95
@@ -0,0 +1,42 @@
+! { dg-do compile }
+! { dg-options "-fopenacc -fdump-tree-original" }
+
+! test for tree-dump-original and spaces-commas
+
+program test
+ implicit none
+ integer :: q, i, j, k, m, n, o, p, r, s, t, u, v, w
+ logical :: l
+
+ !$acc parallel if(l) async num_gangs(i) num_workers(i) vector_length(i) &
+ !$acc reduction(max:q), copy(i), copyin(j), copyout(k), create(m) &
+ !$acc present(o), pcopy(p), pcopyin(r), pcopyout(s), pcreate(t) &
+ !$acc deviceptr(u), private(v), firstprivate(w)
+ !$acc end parallel
+
+end program test
+! { dg-excess-errors "unimplemented" }
+! { dg-final { scan-tree-dump "pragma acc parallel" "original" } }
+
+! { dg-final { scan-tree-dump "if" "original" } }
+! { dg-final { scan-tree-dump "async" "original" } }
+! { dg-final { scan-tree-dump "num_gangs" "original" } }
+! { dg-final { scan-tree-dump "num_workers" "original" } }
+! { dg-final { scan-tree-dump "vector_length" "original" } }
+
+! { dg-final { scan-tree-dump "reduction" "original" } }
+! { dg-final { scan-tree-dump "force_tofrom" "original" } }
+! { dg-final { scan-tree-dump "force_to" "original" } }
+! { dg-final { scan-tree-dump "force_from" "original" } }
+! { dg-final { scan-tree-dump "force_alloc" "original" } }
+
+! { dg-final { scan-tree-dump "force_present" "original" } }
+! { dg-final { scan-tree-dump "tofrom" "original" } }
+! { dg-final { scan-tree-dump "to" "original" } }
+! { dg-final { scan-tree-dump "from" "original" } }
+! { dg-final { scan-tree-dump "alloc" "original" } }
+
+! { dg-final { scan-tree-dump "force_deviceptr" "original" } }
+! { dg-final { scan-tree-dump "private" "original" } }
+! { dg-final { scan-tree-dump "firstprivate" "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
diff --git a/gcc/testsuite/gfortran.dg/goacc/pure-elemental-procedures.f95 b/gcc/testsuite/gfortran.dg/goacc/pure-elemental-procedures.f95
new file mode 100644
index 0000000..18495b6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/pure-elemental-procedures.f95
@@ -0,0 +1,46 @@
+! { dg-do compile }
+! { dg-options "-fopenacc" }
+
+module test
+ implicit none
+contains
+ elemental subroutine test1
+ !$acc parallel ! { dg-error "may not appear in PURE or ELEMENTAL procedures" }
+ end subroutine test1
+
+ pure subroutine test2
+ !$acc parallel ! { dg-error "may not appear in PURE or ELEMENTAL procedures" }
+ end subroutine test2
+
+ elemental real function test3(x)
+ real, intent(in) :: x
+ !$acc parallel ! { dg-error "may not appear in PURE or ELEMENTAL procedures" }
+ test3 = x
+ end function test3
+
+ pure real function test4(x)
+ real, intent(in) :: x
+ !$acc parallel ! { dg-error "may not appear in PURE or ELEMENTAL procedures" }
+ test4 = x
+ end function test4
+
+ subroutine test5
+ real :: x = 0.0
+ integer :: i
+ !$acc parallel loop collapse(1) reduction(+:x)
+ do i = 1,10
+ x = x + 0.3
+ enddo
+ print *, x
+ end subroutine test5
+
+ real function test6(x)
+ real :: x
+ integer :: i
+ !$acc parallel loop collapse(1) reduction(+:x)
+ do i = 1,10
+ x = x + 0.3
+ enddo
+ test6 = x
+ end function test6
+end module test
\ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/goacc/reduction.f95 b/gcc/testsuite/gfortran.dg/goacc/reduction.f95
new file mode 100644
index 0000000..bc54745
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/reduction.f95
@@ -0,0 +1,138 @@
+! { dg-do compile }
+! { dg-options "-fopenacc -fmax-errors=100" }
+
+subroutine foo (ia1)
+integer :: i1, i2, i3
+integer, dimension (*) :: ia1
+integer, dimension (10) :: ia2
+real :: r1
+real, dimension (5) :: ra1
+double precision :: d1
+double precision, dimension (4) :: da1
+complex :: c1
+complex, dimension (7) :: ca1
+logical :: l1
+logical, dimension (3) :: la1
+character (5) :: a1
+type t
+ integer :: i
+end type
+type(t) :: t1
+type(t), dimension (2) :: ta1
+real, pointer :: p1 => NULL()
+integer, allocatable :: aa1 (:,:)
+save i2
+common /blk/ i1
+
+!$acc parallel reduction (+:ia2)
+!$acc end parallel
+!$acc parallel reduction (+:ra1)
+!$acc end parallel
+!$acc parallel reduction (+:ca1)
+!$acc end parallel
+!$acc parallel reduction (+:da1)
+!$acc end parallel
+!$acc parallel reduction (.and.:la1)
+!$acc end parallel
+!$acc parallel reduction (+:i3, r1, d1, c1)
+!$acc end parallel
+!$acc parallel reduction (*:i3, r1, d1, c1)
+!$acc end parallel
+!$acc parallel reduction (-:i3, r1, d1, c1)
+!$acc end parallel
+!$acc parallel reduction (.and.:l1)
+!$acc end parallel
+!$acc parallel reduction (.or.:l1)
+!$acc end parallel
+!$acc parallel reduction (.eqv.:l1)
+!$acc end parallel
+!$acc parallel reduction (.neqv.:l1)
+!$acc end parallel
+!$acc parallel reduction (min:i3, r1, d1)
+!$acc end parallel
+!$acc parallel reduction (max:i3, r1, d1)
+!$acc end parallel
+!$acc parallel reduction (iand:i3)
+!$acc end parallel
+!$acc parallel reduction (ior:i3)
+!$acc end parallel
+!$acc parallel reduction (ieor:i3)
+!$acc end parallel
+!$acc parallel reduction (+:/blk/) ! { dg-error "Syntax error" }
+!$acc end parallel ! { dg-error "Unexpected" }
+!$acc parallel reduction (*:p1) ! { dg-error "POINTER object" }
+!$acc end parallel
+!$acc parallel reduction (-:aa1)
+!$acc end parallel
+!$acc parallel reduction (*:ia1) ! { dg-error "Assumed size" }
+!$acc end parallel
+!$acc parallel reduction (+:l1) ! { dg-error "must be of numeric type, got LOGICAL" }
+!$acc end parallel
+!$acc parallel reduction (*:la1) ! { dg-error "must be of numeric type, got LOGICAL" }
+!$acc end parallel
+!$acc parallel reduction (-:a1) ! { dg-error "must be of numeric type, got CHARACTER" }
+!$acc end parallel
+!$acc parallel reduction (+:t1) ! { dg-error "must be of numeric type, got TYPE" }
+!$acc end parallel
+!$acc parallel reduction (*:ta1) ! { dg-error "must be of numeric type, got TYPE" }
+!$acc end parallel
+!$acc parallel reduction (.and.:i3) ! { dg-error "must be LOGICAL" }
+!$acc end parallel
+!$acc parallel reduction (.or.:ia2) ! { dg-error "must be LOGICAL" }
+!$acc end parallel
+!$acc parallel reduction (.eqv.:r1) ! { dg-error "must be LOGICAL" }
+!$acc end parallel
+!$acc parallel reduction (.neqv.:ra1) ! { dg-error "must be LOGICAL" }
+!$acc end parallel
+!$acc parallel reduction (.and.:d1) ! { dg-error "must be LOGICAL" }
+!$acc end parallel
+!$acc parallel reduction (.or.:da1) ! { dg-error "must be LOGICAL" }
+!$acc end parallel
+!$acc parallel reduction (.eqv.:c1) ! { dg-error "must be LOGICAL" }
+!$acc end parallel
+!$acc parallel reduction (.neqv.:ca1) ! { dg-error "must be LOGICAL" }
+!$acc end parallel
+!$acc parallel reduction (.and.:a1) ! { dg-error "must be LOGICAL" }
+!$acc end parallel
+!$acc parallel reduction (.or.:t1) ! { dg-error "must be LOGICAL" }
+!$acc end parallel
+!$acc parallel reduction (.eqv.:ta1) ! { dg-error "must be LOGICAL" }
+!$acc end parallel
+!$acc parallel reduction (min:c1) ! { dg-error "must be INTEGER or REAL" }
+!$acc end parallel
+!$acc parallel reduction (max:ca1) ! { dg-error "must be INTEGER or REAL" }
+!$acc end parallel
+!$acc parallel reduction (max:l1) ! { dg-error "must be INTEGER or REAL" }
+!$acc end parallel
+!$acc parallel reduction (min:la1) ! { dg-error "must be INTEGER or REAL" }
+!$acc end parallel
+!$acc parallel reduction (max:a1) ! { dg-error "must be INTEGER or REAL" }
+!$acc end parallel
+!$acc parallel reduction (min:t1) ! { dg-error "must be INTEGER or REAL" }
+!$acc end parallel
+!$acc parallel reduction (max:ta1) ! { dg-error "must be INTEGER or REAL" }
+!$acc end parallel
+!$acc parallel reduction (iand:r1) ! { dg-error "must be INTEGER" }
+!$acc end parallel
+!$acc parallel reduction (ior:ra1) ! { dg-error "must be INTEGER" }
+!$acc end parallel
+!$acc parallel reduction (ieor:d1) ! { dg-error "must be INTEGER" }
+!$acc end parallel
+!$acc parallel reduction (ior:da1) ! { dg-error "must be INTEGER" }
+!$acc end parallel
+!$acc parallel reduction (iand:c1) ! { dg-error "must be INTEGER" }
+!$acc end parallel
+!$acc parallel reduction (ior:ca1) ! { dg-error "must be INTEGER" }
+!$acc end parallel
+!$acc parallel reduction (ieor:l1) ! { dg-error "must be INTEGER" }
+!$acc end parallel
+!$acc parallel reduction (iand:la1) ! { dg-error "must be INTEGER" }
+!$acc end parallel
+!$acc parallel reduction (ior:a1) ! { dg-error "must be INTEGER" }
+!$acc end parallel
+!$acc parallel reduction (ieor:t1) ! { dg-error "must be INTEGER" }
+!$acc end parallel
+!$acc parallel reduction (iand:ta1) ! { dg-error "must be INTEGER" }
+!$acc end parallel
+
+end subroutine
\ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/goacc/sentinel-free-form.f95 b/gcc/testsuite/gfortran.dg/goacc/sentinel-free-form.f95
new file mode 100644
index 0000000..04c67d5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/sentinel-free-form.f95
@@ -0,0 +1,22 @@
+! { dg-do compile }
+! { dg-options "-fopenacc" }
+
+program test
+ implicit none
+
+ integer :: i
+ real :: x
+
+ ! sentinel may only be preceeded by white space
+ x = 0.0 !$acc parallel ! comment
+ ! sentinel must appear as a single word
+ ! $acc parallel ! comment
+ !$ acc parallel ! { dg-error "Unclassifiable statement" }
+ ! directive lines must have space after sentinel
+ !$accparallel ! { dg-warning "followed by a space" }
+ do i = 1,10
+ x = x + 0.3
+ enddo
+ !$acc end parallel ! { dg-error "Unexpected" }
+ print *, x
+end
\ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/goacc/several-directives.f95 b/gcc/testsuite/gfortran.dg/goacc/several-directives.f95
new file mode 100644
index 0000000..7e1d0f9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/several-directives.f95
@@ -0,0 +1,7 @@
+! { dg-do compile }
+! { dg-options "-fopenacc" }
+
+program test
+ ! only one directive-name may appear in directive
+ !$acc parallel kernels ! { dg-error "Unclassifiable OpenACC directive" }
+end
\ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/goacc/sie.f95 b/gcc/testsuite/gfortran.dg/goacc/sie.f95
new file mode 100644
index 0000000..e49c387
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/sie.f95
@@ -0,0 +1,252 @@
+! { dg-do compile }
+! { dg-options "-fopenacc -fmax-errors=100" }
+
+! tests async, num_gangs, num_workers, vector_length, gang, worker, vector clauses
+
+program test
+ implicit none
+
+ integer :: i
+
+ !$acc parallel async
+ !$acc end parallel
+
+ !$acc parallel async(3)
+ !$acc end parallel
+
+ !$acc parallel async(i)
+ !$acc end parallel
+
+ !$acc parallel async(i+1)
+ !$acc end parallel
+
+ !$acc parallel async(-1)
+ !$acc end parallel
+
+ !$acc parallel async(0)
+ !$acc end parallel
+
+ !$acc parallel async() ! { dg-error "Invalid character in name" }
+
+ !$acc parallel async(1.5) ! { dg-error "scalar INTEGER expression" }
+ !$acc end parallel
+
+ !$acc parallel async(.true.) ! { dg-error "scalar INTEGER expression" }
+ !$acc end parallel
+
+ !$acc parallel async("1") ! { dg-error "scalar INTEGER expression" }
+ !$acc end parallel
+
+ !$acc kernels async
+ !$acc end kernels
+
+ !$acc kernels async(3)
+ !$acc end kernels
+
+ !$acc kernels async(i)
+ !$acc end kernels
+
+ !$acc kernels async(i+1)
+ !$acc end kernels
+
+ !$acc kernels async(-1)
+ !$acc end kernels
+
+ !$acc kernels async(0)
+ !$acc end kernels
+
+ !$acc kernels async() ! { dg-error "Invalid character in name" }
+
+ !$acc kernels async(1.5) ! { dg-error "scalar INTEGER expression" }
+ !$acc end kernels
+
+ !$acc kernels async(.true.) ! { dg-error "scalar INTEGER expression" }
+ !$acc end kernels
+
+ !$acc kernels async("1") ! { dg-error "scalar INTEGER expression" }
+ !$acc end kernels
+
+
+ !$acc parallel num_gangs ! { dg-error "Unclassifiable OpenACC directive" }
+
+ !$acc parallel num_gangs(3)
+ !$acc end parallel
+
+ !$acc parallel num_gangs(i)
+ !$acc end parallel
+
+ !$acc parallel num_gangs(i+1)
+ !$acc end parallel
+
+ !$acc parallel num_gangs(-1) ! { dg-warning "must be positive" }
+ !$acc end parallel
+
+ !$acc parallel num_gangs(0) ! { dg-warning "must be positive" }
+ !$acc end parallel
+
+ !$acc parallel num_gangs() ! { dg-error "Invalid character in name" }
+
+ !$acc parallel num_gangs(1.5) ! { dg-error "scalar INTEGER expression" }
+ !$acc end parallel
+
+ !$acc parallel num_gangs(.true.) ! { dg-error "scalar INTEGER expression" }
+ !$acc end parallel
+
+ !$acc parallel num_gangs("1") ! { dg-error "scalar INTEGER expression" }
+ !$acc end parallel
+
+
+ !$acc parallel num_workers ! { dg-error "Unclassifiable OpenACC directive" }
+
+ !$acc parallel num_workers(3)
+ !$acc end parallel
+
+ !$acc parallel num_workers(i)
+ !$acc end parallel
+
+ !$acc parallel num_workers(i+1)
+ !$acc end parallel
+
+ !$acc parallel num_workers(-1) ! { dg-warning "must be positive" }
+ !$acc end parallel
+
+ !$acc parallel num_workers(0) ! { dg-warning "must be positive" }
+ !$acc end parallel
+
+ !$acc parallel num_workers() ! { dg-error "Invalid character in name" }
+
+ !$acc parallel num_workers(1.5) ! { dg-error "scalar INTEGER expression" }
+ !$acc end parallel
+
+ !$acc parallel num_workers(.true.) ! { dg-error "scalar INTEGER expression" }
+ !$acc end parallel
+
+ !$acc parallel num_workers("1") ! { dg-error "scalar INTEGER expression" }
+ !$acc end parallel
+
+
+ !$acc parallel vector_length ! { dg-error "Unclassifiable OpenACC directive" }
+
+ !$acc parallel vector_length(3)
+ !$acc end parallel
+
+ !$acc parallel vector_length(i)
+ !$acc end parallel
+
+ !$acc parallel vector_length(i+1)
+ !$acc end parallel
+
+ !$acc parallel vector_length(-1) ! { dg-warning "must be positive" }
+ !$acc end parallel
+
+ !$acc parallel vector_length(0) ! { dg-warning "must be positive" }
+ !$acc end parallel
+
+ !$acc parallel vector_length() ! { dg-error "Invalid character in name" }
+
+ !$acc parallel vector_length(1.5) ! { dg-error "scalar INTEGER expression" }
+ !$acc end parallel
+
+ !$acc parallel vector_length(.true.) ! { dg-error "scalar INTEGER expression" }
+ !$acc end parallel
+
+ !$acc parallel vector_length("1") ! { dg-error "scalar INTEGER expression" }
+ !$acc end parallel
+
+
+ !$acc loop gang
+ do i = 1,10
+ enddo
+ !$acc loop gang(3)
+ do i = 1,10
+ enddo
+ !$acc loop gang(i)
+ do i = 1,10
+ enddo
+ !$acc loop gang(i+1)
+ do i = 1,10
+ enddo
+ !$acc loop gang(-1) ! { dg-warning "must be positive" }
+ do i = 1,10
+ enddo
+ !$acc loop gang(0) ! { dg-warning "must be positive" }
+ do i = 1,10
+ enddo
+ !$acc loop gang() ! { dg-error "Invalid character in name" }
+ do i = 1,10
+ enddo
+ !$acc loop gang(1.5) ! { dg-error "scalar INTEGER expression" }
+ do i = 1,10
+ enddo
+ !$acc loop gang(.true.) ! { dg-error "scalar INTEGER expression" }
+ do i = 1,10
+ enddo
+ !$acc loop gang("1") ! { dg-error "scalar INTEGER expression" }
+ do i = 1,10
+ enddo
+
+
+ !$acc loop worker
+ do i = 1,10
+ enddo
+ !$acc loop worker(3)
+ do i = 1,10
+ enddo
+ !$acc loop worker(i)
+ do i = 1,10
+ enddo
+ !$acc loop worker(i+1)
+ do i = 1,10
+ enddo
+ !$acc loop worker(-1) ! { dg-warning "must be positive" }
+ do i = 1,10
+ enddo
+ !$acc loop worker(0) ! { dg-warning "must be positive" }
+ do i = 1,10
+ enddo
+ !$acc loop worker() ! { dg-error "Invalid character in name" }
+ do i = 1,10
+ enddo
+ !$acc loop worker(1.5) ! { dg-error "scalar INTEGER expression" }
+ do i = 1,10
+ enddo
+ !$acc loop worker(.true.) ! { dg-error "scalar INTEGER expression" }
+ do i = 1,10
+ enddo
+ !$acc loop worker("1") ! { dg-error "scalar INTEGER expression" }
+ do i = 1,10
+ enddo
+
+
+ !$acc loop vector
+ do i = 1,10
+ enddo
+ !$acc loop vector(3)
+ do i = 1,10
+ enddo
+ !$acc loop vector(i)
+ do i = 1,10
+ enddo
+ !$acc loop vector(i+1)
+ do i = 1,10
+ enddo
+ !$acc loop vector(-1) ! { dg-warning "must be positive" }
+ do i = 1,10
+ enddo
+ !$acc loop vector(0) ! { dg-warning "must be positive" }
+ do i = 1,10
+ enddo
+ !$acc loop vector() ! { dg-error "Invalid character in name" }
+ do i = 1,10
+ enddo
+ !$acc loop vector(1.5) ! { dg-error "scalar INTEGER expression" }
+ do i = 1,10
+ enddo
+ !$acc loop vector(.true.) ! { dg-error "scalar INTEGER expression" }
+ do i = 1,10
+ enddo
+ !$acc loop vector("1") ! { dg-error "scalar INTEGER expression" }
+ do i = 1,10
+ enddo
+
+end program test
\ No newline at end of file
--
1.8.3.2
^ permalink raw reply [flat|nested] 89+ messages in thread
* Re: [PATCH 6/6] [GOMP4] OpenACC 1.0+ support in fortran front-end
2014-01-31 11:34 ` [PATCH 5/6] " Ilmir Usmanov
@ 2014-01-31 11:45 ` Ilmir Usmanov
2014-02-09 23:43 ` [PATCH 5/6] " Tobias Burnus
1 sibling, 0 replies; 89+ messages in thread
From: Ilmir Usmanov @ 2014-01-31 11:45 UTC (permalink / raw)
To: Thomas Schwinge
Cc: Evgeny Gavrin, GarbuzovViacheslav, Dmitri Botcharnikov,
gcc-patches, jakub, fortran
[-- Attachment #1: Type: text/plain, Size: 222 bytes --]
OpenACC 1.0 support -- documentation.
gcc/doc/
* generic.texi: Document OACC_KERNELS, OACC_DATA, OACC_HOST_DATA,
OACC_DECLARE, OACC_UPDATE, OACC_ENTER_DATA, OACC_EXIT_DATA, OACC_WAIT,
OACC_CACHE.
[-- Attachment #2: 0006-OpenACC-GENERIC-docs.patch --]
[-- Type: text/x-diff, Size: 1789 bytes --]
From 2550374183627d221f8881d14939ea7b0045bfba Mon Sep 17 00:00:00 2001
From: Ilmir Usmanov <i.usmanov@samsung.com>
Date: Fri, 31 Jan 2014 13:30:18 +0400
Subject: [PATCH 6/6] OpenACC GENERIC docs
---
gcc/doc/generic.texi | 40 ++++++++++++++++++++++++++++++++++++++++
1 file changed, 40 insertions(+)
diff --git a/gcc/doc/generic.texi b/gcc/doc/generic.texi
index a56715b..8153a6e 100644
--- a/gcc/doc/generic.texi
+++ b/gcc/doc/generic.texi
@@ -2052,6 +2052,14 @@ edge. Rethrowing the exception is represented using @code{RESX_EXPR}.
@node OpenMP
@subsection OpenMP
@tindex OACC_PARALLEL
+@tindex OACC_KERNELS
+@tindex OACC_DATA
+@tindex OACC_HOST_DATA
+@tindex OACC_UPDATE
+@tindex OACC_ENTER_DATA
+@tindex OACC_EXIT_DATA
+@tindex OACC_WAIT
+@tindex OACC_CACHE
@tindex OMP_PARALLEL
@tindex OMP_FOR
@tindex OMP_SECTIONS
@@ -2073,6 +2081,38 @@ clauses used by the OpenMP API @w{@uref{http://www.openmp.org/}}.
Represents @code{#pragma acc parallel [clause1 @dots{} clauseN]}.
+@item OACC_KERNELS
+
+Represents @code{#pragma acc kernels [clause1 @dots{} clauseN]}.
+
+@item OACC_DATA
+
+Represents @code{#pragma acc data [clause1 @dots{} clauseN]}.
+
+@item OACC_HOST_DATA
+
+Represents @code{#pragma acc host_data [clause1 @dots{} clauseN]}.
+
+@item OACC_UPDATE
+
+Represents @code{#pragma acc update [clause1 @dots{} clauseN]}.
+
+@item OACC_ENTER_DATA
+
+Represents @code{#pragma acc enter data [clause1 @dots{} clauseN]}.
+
+@item OACC_EXIT_DATA
+
+Represents @code{#pragma acc exit data [clause1 @dots{} clauseN]}.
+
+@item OACC_WAIT
+
+Represents @code{#pragma acc wait [(num @dots{})]}.
+
+@item OACC_CACHE
+
+Represents @code{#pragma acc cache (var @dots{})}.
+
@item OMP_PARALLEL
Represents @code{#pragma omp parallel [clause1 @dots{} clauseN]}. It
--
1.8.3.2
^ permalink raw reply [flat|nested] 89+ messages in thread
* Re: [PATCH 1/6] [GOMP4] OpenACC 1.0+ support in fortran front-end
2014-01-31 11:16 ` [PATCH 1/6] " Ilmir Usmanov
2014-01-31 11:17 ` [PATCH 2/6] " Ilmir Usmanov
@ 2014-01-31 12:00 ` Jakub Jelinek
2014-01-31 12:33 ` Ilmir Usmanov
2014-02-09 22:22 ` Tobias Burnus
2 siblings, 1 reply; 89+ messages in thread
From: Jakub Jelinek @ 2014-01-31 12:00 UTC (permalink / raw)
To: Ilmir Usmanov
Cc: Thomas Schwinge, Evgeny Gavrin, GarbuzovViacheslav,
Dmitri Botcharnikov, gcc-patches, fortran
On Fri, Jan 31, 2014 at 03:10:59PM +0400, Ilmir Usmanov wrote:
> @@ -1182,6 +1281,26 @@ show_omp_node (int level, gfc_code *c)
> {
> switch (list_type)
> {
> + case OMP_LIST_COPY: type = "COPY"; break;
> + case OMP_LIST_OACC_COPYIN: type = "COPYIN"; break;
> + case OMP_LIST_COPYOUT: type = "COPYOUT"; break;
> + case OMP_LIST_CREATE: type = "CREATE"; break;
> + case OMP_LIST_DELETE: type = "DELETE"; break;
> + case OMP_LIST_PRESENT: type = "PRESENT"; break;
> + case OMP_LIST_PRESENT_OR_COPY:
> + type = "PRESENT_OR_COPY"; break;
> + case OMP_LIST_PRESENT_OR_COPYIN:
> + type = "PRESENT_OR_COPYIN"; break;
> + case OMP_LIST_PRESENT_OR_COPYOUT:
> + type = "PRESENT_OR_COPYOUT"; break;
> + case OMP_LIST_PRESENT_OR_CREATE:
> + type = "PRESENT_OR_CREATE"; break;
> + case OMP_LIST_DEVICEPTR: type = "DEVICEPTR"; break;
> + case OMP_LIST_USE_DEVICE: type = "USE_DEVICE"; break;
> + case OMP_LIST_DEVICE_RESIDENT: type = "USE_DEVICE"; break;
> + case OMP_LIST_HOST: type = "HOST"; break;
The above are OpenACC specific clauses, so they should have OACC_LIST_*?
> + case OMP_LIST_DEVICE: type = "DEVICE"; break;
This one is in OpenMP 4.0 too (though, I didn't get to OpenMP 4.0 / fortran
support yet), so this should be OMP_LIST_DEVICE.
> + case OMP_LIST_CACHE: type = ""; break;
Again, this is OpenACC specific.
Jakub
^ permalink raw reply [flat|nested] 89+ messages in thread
* Re: [PATCH 1/6] [GOMP4] OpenACC 1.0+ support in fortran front-end
2014-01-31 12:00 ` [PATCH 1/6] " Jakub Jelinek
@ 2014-01-31 12:33 ` Ilmir Usmanov
2014-02-03 15:21 ` [PING] " Ilmir Usmanov
0 siblings, 1 reply; 89+ messages in thread
From: Ilmir Usmanov @ 2014-01-31 12:33 UTC (permalink / raw)
To: Jakub Jelinek
Cc: Thomas Schwinge, Evgeny Gavrin, GarbuzovViacheslav,
Dmitri Botcharnikov, gcc-patches, fortran
Hi Jakub!
Thank you for review and quick answer.
> The above are OpenACC specific clauses, so they should have OACC_LIST_*?
I just followed Thomas's style recomendations:
> If we're adding new names for implementing OpenACC things, maybe we
> should also name these OMP_*, to keep things simple to read in the code
> that uses them.
And I agree with him.
>> + case OMP_LIST_DEVICE: type = "DEVICE"; break;
> This one is in OpenMP 4.0 too (though, I didn't get to OpenMP 4.0 / fortran
> support yet), so this should be OMP_LIST_DEVICE.
As far as I know, OpenMP device clause requires integer-expression, not
variable-list, so, I think, we can use OMP_LIST_DEVICE to represent
OpenACC device clause.
--
Thanks,
Ilmir.
^ permalink raw reply [flat|nested] 89+ messages in thread
* Re: [PING] [PATCH 1/6] [GOMP4] OpenACC 1.0+ support in fortran front-end
2014-01-31 12:33 ` Ilmir Usmanov
@ 2014-02-03 15:21 ` Ilmir Usmanov
0 siblings, 0 replies; 89+ messages in thread
From: Ilmir Usmanov @ 2014-02-03 15:21 UTC (permalink / raw)
To: Jakub Jelinek
Cc: Thomas Schwinge, Evgeny Gavrin, GarbuzovViacheslav,
Dmitri Botcharnikov, gcc-patches, fortran
Hi Jakub!
On 31.01.2014 15:45, Ilmir Usmanov wrote:
> Hi Jakub!
>
> Thank you for review and quick answer.
>> The above are OpenACC specific clauses, so they should have OACC_LIST_*?
> I just followed Thomas's style recomendations:
>> If we're adding new names for implementing OpenACC things, maybe we
>> should also name these OMP_*, to keep things simple to read in the code
>> that uses them.
> And I agree with him.
>>> + case OMP_LIST_DEVICE: type = "DEVICE"; break;
>> This one is in OpenMP 4.0 too (though, I didn't get to OpenMP 4.0 /
>> fortran
>> support yet), so this should be OMP_LIST_DEVICE.
> As far as I know, OpenMP device clause requires integer-expression,
> not variable-list, so, I think, we can use OMP_LIST_DEVICE to
> represent OpenACC device clause.
>
So, what should I do? Is current naming OK? Or you think it's better to
use OACC_ prefix for OpenACC specific stuff in Fortran front-end and
OMP_ prefix in middle-end?
--
Ilmir.
^ permalink raw reply [flat|nested] 89+ messages in thread
* Re: [PATCH 1/6] [GOMP4] OpenACC 1.0+ support in fortran front-end
2014-01-31 11:16 ` [PATCH 1/6] " Ilmir Usmanov
2014-01-31 11:17 ` [PATCH 2/6] " Ilmir Usmanov
2014-01-31 12:00 ` [PATCH 1/6] " Jakub Jelinek
@ 2014-02-09 22:22 ` Tobias Burnus
2014-02-19 15:34 ` Ilmir Usmanov
2 siblings, 1 reply; 89+ messages in thread
From: Tobias Burnus @ 2014-02-09 22:22 UTC (permalink / raw)
To: Ilmir Usmanov, Thomas Schwinge
Cc: Evgeny Gavrin, GarbuzovViacheslav, Dmitri Botcharnikov,
gcc-patches, jakub, fortran
Ilmir Usmanov wrote:
> OpenACC 1.0 support to fortran FE -- core.
> --- a/gcc/fortran/dump-parse-tree.c
> +++ b/gcc/fortran/dump-parse-tree.c
> @@ -1031,9 +1031,22 @@ show_omp_node (int level, gfc_code *c)
> {
> gfc_omp_clauses *omp_clauses = NULL;
> const char *name = NULL;
> + bool is_oacc = false;
I'd also update the comment before the function and mention OpenACC
there. It currently reads:
/* Show a single OpenMP directive node and everything underneath it
if necessary. */
> + fprintf (dumpfile, "!$%s %s", is_oacc?"ACC":"OMP", name);
Add spaces around "?" and ":"
> @@ -1215,7 +1334,7 @@ show_omp_node (int level, gfc_code *c)
> - fprintf (dumpfile, "!$OMP END %s", name);
> + fprintf (dumpfile, "!$%s END %s", is_oacc?"ACC":"OMP", name);
Ditto.
> --- a/gcc/fortran/gfortran.h
> +++ b/gcc/fortran/gfortran.h
>
> +/* Likewise to gfc_namelist, but contains expressions. */
> +typedef struct gfc_exprlist
> +{
> + struct gfc_expr *expr;
> + struct gfc_exprlist *next;
> +}
> +gfc_exprlist;
I don't feel strong about it, but I think it is more GCC / gfortran
style to use "gfc_expr_list" instead of "gfc_exprlist".
> + /* OpenACC. */
> + struct gfc_expr *async_expr;
> + struct gfc_expr *gang_expr;
> + struct gfc_expr *worker_expr;
> + struct gfc_expr *vector_expr;
> + struct gfc_expr *num_gangs_expr;
> + struct gfc_expr *num_workers_expr;
> + struct gfc_expr *vector_length_expr;
> + struct gfc_expr *non_clause_wait_expr;
> + gfc_exprlist *waitlist;
> + gfc_exprlist *tilelist;
> + bool async, gang, worker, vector, seq, independent;
> + bool wait, par_auto, gang_static;
I wonder whether it would make sense to use bit fields here.
> --- a/gcc/fortran/match.c
> +++ b/gcc/fortran/match.c
> @@ -2595,6 +2595,33 @@ match_exit_cycle (gfc_statement st, gfc_exec_op op)
> if (cnt > 0
> && o != NULL
> && o->state == COMP_OMP_STRUCTURED_BLOCK
> + && (o->head->op == EXEC_OACC_LOOP
> + || o->head->op == EXEC_OACC_PARALLEL_LOOP))
> + {
> + int collapse = 1;
> + gcc_assert (o->head->next != NULL
> + && (o->head->next->op == EXEC_DO
> + || o->head->next->op == EXEC_DO_WHILE)
Two questions:
a) Does this part work well when both -fopenmp and -fopenacc is used? I
mean: "!$acc loop" followed/preceded by "!$omp do"? I could imagine that
there could be clashes, especially when - e.g. - collapse doesn't match.
b) Do you also handle DO CONCURRENT - either by rejecting it or by
accepting it? Namely,
!$acc loop
do concurrent(i=1:5)
end do
!$acc end loop
end
Side remark, with -fopenmp, it does ICE:
http://gcc.gnu.org/bugzilla/show_bug.cgi?id=60127
Talking about "!$acc loop": I vaguely remember that OpenACC 1.0's spec
doesn't have "!$acc end loop" while I have seen OpenACC programs which
use it. How do you handle "!$acc end loop"?
Looking at parse.c, it seems to simply error out. I wonder whether one
should be a bit more graceful. For instance, the following examples use
"!$acc end loop":
http://devblogs.nvidia.com/parallelforall/openacc-example-part-2/ [If I
remember correctly, pgf95 and Cray ftn silently accepts "end loop" while
pathf95 accepts it with a warning.]
And looking at the spec of OpenACC 1.0 and 2.0a, the "end loop" seems to
be invalid. How about following PathScale's ENZO and accepting "end
loop" with a warning? Or at least error out with a good error message.
> + if (st == ST_EXIT && cnt <= collapse)
> + {
> + gfc_error ("EXIT statement at %C terminating !$ACC LOOP loop");
> + return MATCH_ERROR;
> + }
> + if (st == ST_CYCLE && cnt < collapse)
> + {
> + gfc_error ("CYCLE statement at %C to non-innermost collapsed"
> + " !$ACC LOOP loop");
> + return MATCH_ERROR;
> + }
> + }
I wonder whether one should include for OpenMP and OpenACC some
additional checks as done for DO CONCURRENT or whether those aren't
required. I think image controll statements like Fortran 2008's CRITICAL
block might cause problems with OpenACC/OpenMP concurrency. (Given that
OpenACC/OpenMP likely ignores Fortran 2008's coarrays, one might defer
this until OpenACC/OpenMP has been updated for Fortran 2008.)
> + if (gfc_pure (NULL))
> + {
> + gfc_error_now ("OpenACC directives at %C may not appear in PURE "
> + "or ELEMENTAL procedures");
Using gfc_pure() you do not check for ELEMENTAL: Since Fortran 2008,
there are also IMPURE ELEMENTAL procedures. I don't know the spec, but I
don't really see a reason why OpenACC shouldn't be permitted in IMPURE
ELEMENTAL procedures. (BTW: "ELEMENTAL" implies PURE unless an explicit
IMPURE is used.)
In any case, either drop "or ELEMENTAL" or also check for the elemental
attribute.
> + if (gfc_implicit_pure (NULL))
> + gfc_current_ns->proc_name->attr.implicit_pure = 0;
I believe that will fail with BLOCK - cf. gfc_implicit_pure()
real function foo(n)
integer, value :: n
BLOCK
integer i
real sum
!$acc loop reduce(+:sum)
do i=1, n
sum += sin(real(i))
end do
END BLOCK
end
> + /* All else has failed, so give up. See if any of the matchers has
> + stored an error message of some sort. */
Indenting of the second line looks wrong. And "all else" sounds language
wise strange to me.
> +static void
> +verify_token_free (const char* token, int length, bool last_was_use_stmt)
> +{
This function should have a comment describing what it does.
> +static bool
> +verify_token_fixed (const char *token, int length, bool last_was_use_stmt)
Also here, a short comment line before the function would be helpful.
> --- a/gcc/fortran/scanner.c
> +++ b/gcc/fortran/scanner.c
> +static int openmp_flag, openacc_flag; /* If !$omp/!&acc occurred in current comment line */
Is this really !&acc and not !$acc?
> + else if (gfc_option.gfc_flag_openmp&& !gfc_option.gfc_flag_openacc)
Space before "&&".
> + /* If -fopenmp/-fopenacc, we need to handle here 2 things:
> + 1) don't treat !$omp/!$acc|c$omp/c$acc|*$omp / *$acc as comments,
Is there a reason for the spaces around the last "/"?
> + gcc_assert(gfc_wide_tolower (c) == (unsigned char ) "!$acc"[i]);
Spurious " " before ")".
Tobias
^ permalink raw reply [flat|nested] 89+ messages in thread
* Re: [PATCH 2/6] [GOMP4] OpenACC 1.0+ support in fortran front-end
2014-01-31 11:17 ` [PATCH 2/6] " Ilmir Usmanov
2014-01-31 11:18 ` [PATCH 3/6] " Ilmir Usmanov
@ 2014-02-09 23:10 ` Tobias Burnus
2014-02-10 9:10 ` Thomas Schwinge
2014-02-19 16:43 ` Ilmir Usmanov
1 sibling, 2 replies; 89+ messages in thread
From: Tobias Burnus @ 2014-02-09 23:10 UTC (permalink / raw)
To: Ilmir Usmanov, Thomas Schwinge
Cc: Evgeny Gavrin, GarbuzovViacheslav, Dmitri Botcharnikov,
gcc-patches, jakub, fortran
Ilmir Usmanov wrote:
> OpenACC 1.0 fortran FE support -- matching and resolving.
> + return MATCH_ERROR;
> +}
> +
> +static match
> +match_oacc_clause_gang (gfc_omp_clauses *cp)
> +{
For consistency, can you add another empty line before the function?
> +#define OMP_CLAUSE_SEQ (1ll << 32)
I think you should use 1LL instead of 1ll - that should be more readable
and matches gcc/{configure,fold-const.c,glimits.h,simplify-rtx.c}
> +static void
> +resolve_oacc_scalar_int_expr (gfc_expr *expr, const char *clause)
> +{
> + if (!gfc_resolve_expr (expr)
> + || expr->ts.type != BT_INTEGER || expr->rank != 0)
> + gfc_error ("%s clause at %L requires a scalar INTEGER expression",
> + clause, &expr->where);
> +}
I'd use "integer" instead of "INTEGER" as it is not a 'reserved' word
> + gfc_warning ("INTEGER expression of %s clause at %L must be positive",
> + clause, &expr->where);
> +}
Ditto.
> @@ -800,10 +1366,14 @@ resolve_omp_clauses (gfc_code *code)
> static const char *clause_names[]
> = { "PRIVATE", "FIRSTPRIVATE", "LASTPRIVATE", "COPYPRIVATE", "SHARED",
> - "COPYIN", "REDUCTION" };
> + "COPYIN", "COPY", "COPYIN", "COPYOUT", "CREATE", "DELETE",
> + "PRESENT", "PRESENT_OR_COPY", "PRESENT_OR_COPYIN", "PRESENT_OR_COPYOUT",
> + "PRESENT_OR_CREATE", "DEVICEPTR", "USE_DEVICE", "DEVICE_RESIDENT",
> + "HOST", "DEVICE", "CACHE", "REDUCTION"};
Indention: Should be a tab not spaces.
> @@ -933,8 +1503,43 @@ resolve_omp_clauses (gfc_code *code)
> else
> gcc_unreachable ();
>
> + if (list >= OMP_LIST_DATA_CLAUSE_FIRST
> + && list <= OMP_LIST_DATA_CLAUSE_LAST)
> + {
> + if (n->sym->ts.type == BT_DERIVED
> + && n->sym->attr.allocatable)
> + gfc_error ("ALLOCATABLE object '%s' of DERIVED type in %s clause at %L",
> + n->sym->name, name, &code->loc);
> + if (n->sym->ts.type == BT_DERIVED
> + && n->sym->attr.pointer)
> + gfc_error ("POINTER object '%s' of DERIVED type in %s clause at %L",
> + n->sym->name, name, &code->loc);
I'd use "derived type" for the same reason as above.
Shouldn't you also reject polymorphic types ("BT_CLASS" and
"BT_ASSUMED")? [BT_CLASS = "class(derived_type_name)" or "class(*)";
BT_ASSUMED = "type(*)"]
> + if (n->sym->attr.pointer)
> + gfc_error ("POINTER object '%s' in %s clause at %L",
> + n->sym->name, name, &code->loc);
Actually, here and probably elsewhere: Do you need to take care of
derived-type components? I mean something like
clause(derived_type%comp)
If so, note that symtree->n.sym->attr.pointer only checks for
"derived_type" - even if you are interested in "comp"'s attributes. You
probably should use gfc_expr_attr() in this and similar cases.
> + if (n->sym->as && n->sym->as->type == AS_ASSUMED_SIZE)
> + gfc_error ("Assumed size array '%s' in %s clause at %L",
> + n->sym->name, name, &code->loc);
> + }
Do you also need to reject AS_ASSUMED_RANK (new since Fortran Technical
Specification ISO/IEC TS 29113:2012)? I mean code like:
subroutine foo(x)
integer, DIMENSION(..) :: x
... openacc_clause(x)
Side note: One should also check how OpenMP handles those.
> + case OMP_LIST_DEVICEPTR:
> + if (n->sym->attr.pointer)
> + gfc_error ("POINTER object '%s' in %s clause at %L",
> + n->sym->name, name, &code->loc);
Talking about pointers, you probably also want to reject Cray pointers
(attr.cray_pointee - and cray_pointee). [One should also check what
OpenMP does; I think it does handle it correctly.]
And another point: I think you have to check whether the argument is a
named constant (PARAMETER, attr.flavor == FL_PARAMETER), I think those
you cannot put them there either.
What happens if you try to use a literal such as "deviceptr(5)"?
> +}
> +
> +static void
> +resolve_oacc_params_in_parallel (gfc_code *code, const char *clause)
> +{
Another empty line for consistency.
> + if (oacc_is_parallel (code))
> + gfc_error ("LOOP %s in PARALLEL section allows no argument or static at %L",
> + clause, &code->loc);
I am not sure whether I understand the error - in particular what
"static" means. (It might be obvious after looking at the spec - if not,
the error message should be improved.) In any case, I think you want to
use "nor" instead of "or".
> + if (code->ext.omp_clauses->seq)
> + {
> + if (code->ext.omp_clauses->independent)
> + gfc_error ("Both SEQ and INDEPENDENT are not allowed in %L", &code->loc);
Somehow, I don't like the wording; it sounds to me a bit as if SEQ is
not permitted and INDEPENDENT is not permitted while you mean that only
using them simultaneously is wrong. I don't have a very good suggestion,
but here are some: "SEQ clause conflicts with INDEPENDENT at %L", "SEQ
shall not be used together with INDEPENDENT at %L" or ...
> + resolve_oacc_positive_int_expr (el->expr, "TILE");
> + if (el->expr->expr_type != EXPR_CONSTANT)
> + gfc_error ("TILE requires constant expression at %L", &code->loc);
Is the following permitted: "tile(4+5)"? If so, do you need to call
gfc_simplify_expr() as some point? (Or is this already done at some point?)
> +static void
> +resolve_oacc_cache (gfc_code *)
> +{
> + //TODO: resolve subarrays
> +}
;-)
Tobias
^ permalink raw reply [flat|nested] 89+ messages in thread
* Re: [PATCH 3/6] [GOMP4] OpenACC 1.0+ support in fortran front-end
2014-01-31 11:18 ` [PATCH 3/6] " Ilmir Usmanov
2014-01-31 11:22 ` [PATCH 4/6] " Ilmir Usmanov
@ 2014-02-09 23:24 ` Tobias Burnus
1 sibling, 0 replies; 89+ messages in thread
From: Tobias Burnus @ 2014-02-09 23:24 UTC (permalink / raw)
To: Ilmir Usmanov, Thomas Schwinge
Cc: Evgeny Gavrin, GarbuzovViacheslav, Dmitri Botcharnikov,
gcc-patches, jakub, fortran
Ilmir Usmanov wrote:
> OpenACC 1.0 fortran FE support -- translation to GENERIC.
> +static tree
> +gfc_trans_oacc_loop (gfc_code *, gfc_omp_clauses *)
> +{
> + gfc_error ("Unimplemented");
> + return NULL_TREE;
> +}
I think that should be a bit more explicit: First, there should be a
location ("%L"); secondly, it should state what is unimplemented
(presumably "OpenACC LOOP").
Tobias
^ permalink raw reply [flat|nested] 89+ messages in thread
* Re: [PATCH 5/6] [GOMP4] OpenACC 1.0+ support in fortran front-end
2014-01-31 11:34 ` [PATCH 5/6] " Ilmir Usmanov
2014-01-31 11:45 ` [PATCH 6/6] " Ilmir Usmanov
@ 2014-02-09 23:43 ` Tobias Burnus
2014-02-10 8:52 ` Thomas Schwinge
2014-02-10 9:45 ` Ilmir Usmanov
1 sibling, 2 replies; 89+ messages in thread
From: Tobias Burnus @ 2014-02-09 23:43 UTC (permalink / raw)
To: Ilmir Usmanov, Thomas Schwinge
Cc: Evgeny Gavrin, GarbuzovViacheslav, Dmitri Botcharnikov,
gcc-patches, jakub, fortran
Some general questions to the patch set:
* I miss "-fopenacc". Is the support already in the branch? I assume
that part is then in c-family/c.opt fortran/lang.opt?
* Documentation: Do you also need to update fortran/gfortran.texi and/or
fortran/invoke.texi? (I assume that -fopenacc is already documented in
docs/invoke.texi) [Search for openmp to find possible spots.]
* Intrinsic module "openacc" and "openacc_lib.h": I assume that those
will be created as follow up - or do they already exist? If so, do you
need to document something in fortran/intrinsic.texi? Or in libgomp.texi?
Ilmir Usmanov wrote:
> OpenACC 1.0 fortran FE support -- tests.
>
> gcc/testsuite/gfortran.dg/goacc/
> * goacc.exp: New test directory.
> +++ b/gcc/testsuite/gfortran.dg/goacc/branch.f95
> @@ -0,0 +1,55 @@
> +! { dg-do compile }
> +! { dg-options "-fopenacc" }
Is there a reason that you don't automatically add that flag via goacc.exp?
> +! { dg-final { scan-tree-dump "pragma acc data" "original" } }
> +! { dg-final { scan-tree-dump "if" "original" } }
This one looks rather general. Shouldn't use narrow it down a bit, e.g.
by using "scan-tree-dump-times"?
> +! { dg-final { scan-tree-dump "to" "original" } }
> +! { dg-final { scan-tree-dump "from" "original" } }
> +! { dg-final { scan-tree-dump "alloc" "original" } }
Ditto. Also spaces before/after the pattern should make it more unique.
> --- /dev/null
> +++ b/gcc/testsuite/gfortran.dg/goacc/goacc.exp
> @@ -0,0 +1,36 @@
> +# Load support procs.
> +load_lib gfortran-dg.exp
> +
> +if ![check_effective_target_fopenmp] {
> + return
> +}
I assume that this should be indeed "fopenmp" here and not "fopenacc" as
both share libgomp?
> +# Main loop.
> +gfortran-dg-runtest [lsort \
> + [find $srcdir/$subdir *.\[fF\]{,90,95,03,08} ] ] " -fopenacc -fdump-parse-tree"
As you use -fopenacc here, you probably can get rid of it in dg-options.
Can't you? I am not sure whether -fdump-parse-tree is needed; on the
other hand, it just clutters the *log files.
As -fopenmp seemingly can be mixed with -fopenacc, I think it would be
nice to have some test cases where !$omp and !$acc are both placed - in
either order - before the same Fortran statement.
Tobias
^ permalink raw reply [flat|nested] 89+ messages in thread
* Re: [PATCH 5/6] [GOMP4] OpenACC 1.0+ support in fortran front-end
2014-02-09 23:43 ` [PATCH 5/6] " Tobias Burnus
@ 2014-02-10 8:52 ` Thomas Schwinge
2014-02-10 9:34 ` Ilmir Usmanov
2014-02-10 23:13 ` Tobias Burnus
2014-02-10 9:45 ` Ilmir Usmanov
1 sibling, 2 replies; 89+ messages in thread
From: Thomas Schwinge @ 2014-02-10 8:52 UTC (permalink / raw)
To: Tobias Burnus, Ilmir Usmanov
Cc: Evgeny Gavrin, GarbuzovViacheslav, Dmitri Botcharnikov,
gcc-patches, jakub, fortran
[-- Attachment #1: Type: text/plain, Size: 9447 bytes --]
Hi!
On Mon, 10 Feb 2014 00:42:54 +0100, Tobias Burnus <burnus@net-b.de> wrote:
> Some general questions to the patch set:
Thanks for helping review!
> * I miss "-fopenacc". Is the support already in the branch? I assume
> that part is then in c-family/c.opt fortran/lang.opt?
>
> * Documentation: Do you also need to update fortran/gfortran.texi and/or
> fortran/invoke.texi? (I assume that -fopenacc is already documented in
> docs/invoke.texi) [Search for openmp to find possible spots.]
>
> * Intrinsic module "openacc" and "openacc_lib.h": I assume that those
> will be created as follow up - or do they already exist? If so, do you
> need to document something in fortran/intrinsic.texi? Or in libgomp.texi?
Please see
<http://news.gmane.org/find-root.php?message_id=%3C1383766943-8863-3-git-send-email-thomas%40codesourcery.com%3E>
and following for the patch submissions including Fortran bits, and/or
something like the following for reviewing the existing set of changes on
gomp-4_0-branch:
$ svn log svn://gcc.gnu.org/svn/gcc/branches/gomp-4_0-branch | sed -n '/^svn merge/ { p; q; }'
svn merge -r205223:206958 svn+ssh://gcc.gnu.org/svn/gcc/trunk
$ svn diff svn://gcc.gnu.org/svn/gcc/trunk@206958 svn://gcc.gnu.org/svn/gcc/branches/gomp-4_0-branch > diff
..., or the equivalent Git invocation (which is orders of magnitudes
faster):
$ git log origin/gomp-4_0-branch | sed -n '/svn merge/ { p; q; }'
svn merge -r205223:206958 svn+ssh://gcc.gnu.org/svn/gcc/trunk
$ git svn find-rev r206958 origin/trunk
765faa80eda3bb75aa044ad015e2e5214bf02c6d
$ git diff --stat 765faa80eda3bb75aa044ad015e2e5214bf02c6d origin/gomp-4_0-branch | grep -v ChangeLog
gcc/Makefile.in | 3 +-
gcc/builtins.def | 10 +
gcc/c-family/c-cppbuiltin.c | 3 +
gcc/c-family/c-omp.c | 1 +
gcc/c-family/c-pragma.c | 23 +
gcc/c-family/c-pragma.h | 13 +-
gcc/c-family/c.opt | 4 +
gcc/c/c-parser.c | 278 ++++-
gcc/c/c-tree.h | 1 +
gcc/c/c-typeck.c | 23 +-
gcc/cgraph.h | 5 +
gcc/cgraphbuild.c | 14 +-
gcc/cgraphunit.c | 15 +-
gcc/config/arc/arc.h | 2 +-
gcc/config/darwin.h | 2 +-
gcc/config/i386/mingw32.h | 2 +-
gcc/config/ia64/hpux.h | 2 +-
gcc/config/pa/pa-hpux11.h | 4 +-
gcc/config/pa/pa64-hpux.h | 24 +-
gcc/cp/parser.c | 2 +-
gcc/doc/generic.texi | 5 +
gcc/doc/gimple.texi | 8 +
gcc/doc/invoke.texi | 14 +-
gcc/doc/sourcebuild.texi | 3 +
gcc/fortran/cpp.c | 3 +
gcc/fortran/f95-lang.c | 10 +
gcc/fortran/gfortran.h | 1 +
gcc/fortran/invoke.texi | 7 +-
gcc/fortran/lang.opt | 4 +
gcc/fortran/options.c | 5 +
gcc/gcc.c | 5 +-
gcc/gimple-low.c | 1 +
gcc/gimple-pretty-print.c | 58 +
gcc/gimple-walk.c | 16 +
gcc/gimple.c | 20 +
gcc/gimple.def | 10 +-
gcc/gimple.h | 127 ++-
gcc/gimplify.c | 144 ++-
gcc/ipa-inline-analysis.c | 2 +-
gcc/lto-cgraph.c | 14 +
gcc/lto-streamer.c | 5 +-
gcc/lto-streamer.h | 6 +
gcc/lto/lto-partition.c | 3 +
gcc/oacc-builtins.def | 31 +
gcc/omp-low.c | 1081 ++++++++++++++----
gcc/passes.c | 6 +-
gcc/testsuite/c-c++-common/cpp/openacc-define-1.c | 6 +
gcc/testsuite/c-c++-common/cpp/openacc-define-2.c | 7 +
gcc/testsuite/c-c++-common/cpp/openacc-define-3.c | 11 +
.../c-c++-common/goacc-gomp/nesting-fail-1.c | 121 ++
.../c-c++-common/goacc/data-clause-duplicate-1.c | 13 +
gcc/testsuite/c-c++-common/goacc/deviceptr-1.c | 64 ++
gcc/testsuite/c-c++-common/goacc/nesting-fail-1.c | 11 +
gcc/testsuite/c-c++-common/goacc/parallel-1.c | 6 +
gcc/testsuite/c-c++-common/goacc/parallel-fail-1.c | 6 +
gcc/testsuite/gcc.dg/goacc-gomp/goacc-gomp.exp | 38 +
gcc/testsuite/gcc.dg/goacc/goacc.exp | 37 +
gcc/testsuite/gfortran.dg/openacc-define-1.f90 | 7 +
gcc/testsuite/gfortran.dg/openacc-define-2.f90 | 7 +
gcc/testsuite/gfortran.dg/openacc-define-3.f90 | 11 +
gcc/testsuite/lib/target-supports.exp | 9 +
gcc/tree-core.h | 41 +-
gcc/tree-inline.c | 4 +
gcc/tree-nested.c | 12 +
gcc/tree-pass.h | 2 +-
gcc/tree-pretty-print.c | 26 +
gcc/tree.def | 11 +-
gcc/tree.h | 9 +-
libgomp/Makefile.am | 11 +-
libgomp/Makefile.in | 15 +-
libgomp/config.h.in | 6 +
libgomp/configure | 63 ++
libgomp/configure.ac | 9 +
libgomp/libgomp.map | 8 +
libgomp/libgomp_g.h | 5 +
libgomp/oacc-parallel.c | 53 +
libgomp/openacc.f90 | 39 +
libgomp/openacc.h | 45 +
libgomp/openacc_lib.h | 29 +
libgomp/splay-tree.h | 232 ++++
libgomp/target.c | 634 ++++++++++-
libgomp/testsuite/libgomp.oacc-c++/c++.exp | 66 ++
libgomp/testsuite/libgomp.oacc-c/c.exp | 36 +
libgomp/testsuite/libgomp.oacc-c/goacc_parallel.c | 25 +
libgomp/testsuite/libgomp.oacc-c/lib-1.c | 7 +
libgomp/testsuite/libgomp.oacc-c/parallel-1.c | 156 +++
libgomp/testsuite/libgomp.oacc-fortran/fortran.exp | 69 ++
libgomp/testsuite/libgomp.oacc-fortran/lib-1.f90 | 3 +
libgomp/testsuite/libgomp.oacc-fortran/lib-2.f | 3 +
libgomp/testsuite/libgomp.oacc-fortran/lib-3.f | 3 +
.../libgomp.oacc-fortran/openacc_version-1.f | 9 +
.../libgomp.oacc-fortran/openacc_version-2.f90 | 9 +
102 files changed, 6964 insertions(+), 297 deletions(-)
> Ilmir Usmanov wrote:
> > OpenACC 1.0 fortran FE support -- tests.
> >
> > gcc/testsuite/gfortran.dg/goacc/
> > * goacc.exp: New test directory.
> > +++ b/gcc/testsuite/gfortran.dg/goacc/branch.f95
> > @@ -0,0 +1,55 @@
> > +! { dg-do compile }
> > +! { dg-options "-fopenacc" }
>
> Is there a reason that you don't automatically add that flag via goacc.exp?
Right, see below.
> > --- /dev/null
> > +++ b/gcc/testsuite/gfortran.dg/goacc/goacc.exp
> > @@ -0,0 +1,36 @@
> > +# Load support procs.
> > +load_lib gfortran-dg.exp
> > +
> > +if ![check_effective_target_fopenmp] {
> > + return
> > +}
>
> I assume that this should be indeed "fopenmp" here and not "fopenacc" as
> both share libgomp?
It should be fopenacc, because it tests whether the compiler accepts
-fopenacc.
> > +# Main loop.
> > +gfortran-dg-runtest [lsort \
> > + [find $srcdir/$subdir *.\[fF\]{,90,95,03,08} ] ] " -fopenacc -fdump-parse-tree"
>
> As you use -fopenacc here, you probably can get rid of it in dg-options.
Right.
> Can't you? I am not sure whether -fdump-parse-tree is needed; on the
> other hand, it just clutters the *log files.
Yes, I think that should just be in the test case files that actually
need it?
> As -fopenmp seemingly can be mixed with -fopenacc, I think it would be
> nice to have some test cases where !$omp and !$acc are both placed - in
> either order - before the same Fortran statement.
Grüße,
Thomas
[-- Attachment #2: Type: application/pgp-signature, Size: 489 bytes --]
^ permalink raw reply [flat|nested] 89+ messages in thread
* Re: [PATCH 2/6] [GOMP4] OpenACC 1.0+ support in fortran front-end
2014-02-09 23:10 ` [PATCH 2/6] " Tobias Burnus
@ 2014-02-10 9:10 ` Thomas Schwinge
2014-02-19 16:43 ` Ilmir Usmanov
1 sibling, 0 replies; 89+ messages in thread
From: Thomas Schwinge @ 2014-02-10 9:10 UTC (permalink / raw)
To: Tobias Burnus, Ilmir Usmanov
Cc: Evgeny Gavrin, GarbuzovViacheslav, Dmitri Botcharnikov,
gcc-patches, jakub, fortran
[-- Attachment #1: Type: text/plain, Size: 1298 bytes --]
Hi!
On Mon, 10 Feb 2014 00:10:26 +0100, Tobias Burnus <burnus@net-b.de> wrote:
> Ilmir Usmanov wrote:
> > OpenACC 1.0 fortran FE support -- matching and resolving.
> > +static void
> > +resolve_oacc_cache (gfc_code *)
> > +{
> > + //TODO: resolve subarrays
> > +}
>
> ;-)
Just to clarify: I'm fine with incomplete changes being committed to the
gomp-4_0-branch, which is a development branch, as long as such changes
don't largely break the existing (working) code, as determined by the
testsuite for example. Occasional "small" breakage should be fine, if it
is understood, and will be fixed later, like in the case where a recent
merge that I did from trunk into gomp-4_0-branch caused a regression in
one C++ OpenMP test case, which I could pinpoint to one
gomp-4_0-branch-specific patch, which Ilya Tocar by now has fixed
(pending commit).
What I'd generally like to see added are markers à la:
/* TODO: resolve subarrays */
gcc_unreachable ();
This makes it obvious both to the reader/reviewer and user of GCC ;-)
that this code path has not yet been implemented. This is of course not
acceptable for released versions of GCC, but I think it's fine for the
gomp-4_0-branch, in this early OpenACC development stage.
Grüße,
Thomas
[-- Attachment #2: Type: application/pgp-signature, Size: 489 bytes --]
^ permalink raw reply [flat|nested] 89+ messages in thread
* Re: [PATCH 5/6] [GOMP4] OpenACC 1.0+ support in fortran front-end
2014-02-10 8:52 ` Thomas Schwinge
@ 2014-02-10 9:34 ` Ilmir Usmanov
2014-02-10 23:13 ` Tobias Burnus
1 sibling, 0 replies; 89+ messages in thread
From: Ilmir Usmanov @ 2014-02-10 9:34 UTC (permalink / raw)
To: Thomas Schwinge
Cc: Tobias Burnus, Evgeny Gavrin, GarbuzovViacheslav,
Dmitri Botcharnikov, gcc-patches, jakub, fortran
Hi Thomas!
On 10.02.2014 12:52, Thomas Schwinge wrote:
> --- /dev/null
> +++ b/gcc/testsuite/gfortran.dg/goacc/goacc.exp
> @@ -0,0 +1,36 @@
> +# Load support procs.
> +load_lib gfortran-dg.exp
> +
> +if ![check_effective_target_fopenmp] {
> + return
> +}
>> I assume that this should be indeed "fopenmp" here and not "fopenacc" as
>> both share libgomp?
> It should be fopenacc, because it tests whether the compiler accepts
> -fopenacc.
My bad. I've missed the fact that you use
check_effective_target_fopenacc in gcc.gd/goacc/goacc.exp.
>
>>> +# Main loop.
>>> +gfortran-dg-runtest [lsort \
>>> + [find $srcdir/$subdir *.\[fF\]{,90,95,03,08} ] ] " -fopenacc -fdump-parse-tree"
>> As you use -fopenacc here, you probably can get rid of it in dg-options.
> Right.
>
>> Can't you? I am not sure whether -fdump-parse-tree is needed; on the
>> other hand, it just clutters the *log files.
> Yes, I think that should just be in the test case files that actually
> need it?
I've also missed this, will fix.
I think, we need GENERIC nodes checks right now since the implementation
is "up to GENERIC". However, in future, when back-end will be
implemented, we can remove them.
--
Regards,
Ilmir.
^ permalink raw reply [flat|nested] 89+ messages in thread
* Re: [PATCH 5/6] [GOMP4] OpenACC 1.0+ support in fortran front-end
2014-02-09 23:43 ` [PATCH 5/6] " Tobias Burnus
2014-02-10 8:52 ` Thomas Schwinge
@ 2014-02-10 9:45 ` Ilmir Usmanov
2014-02-10 10:52 ` Thomas Schwinge
1 sibling, 1 reply; 89+ messages in thread
From: Ilmir Usmanov @ 2014-02-10 9:45 UTC (permalink / raw)
To: Tobias Burnus, Thomas Schwinge
Cc: Evgeny Gavrin, GarbuzovViacheslav, Dmitri Botcharnikov,
gcc-patches, jakub, fortran
Hi Tobias!
Thanks a lot for your review!
I'm going to test you notes in "reference implementation" (PGI
compiler), and then share the results.
On 10.02.2014 03:42, Tobias Burnus wrote:
> Is there a reason that you don't automatically add that flag via
> goacc.exp?
> Ditto. Also spaces before/after the pattern should make it more unique.
> I assume that this should be indeed "fopenmp" here and not "fopenacc"
> as both share libgomp?
Yes, I'll fix this, thank you.
>
> As -fopenmp seemingly can be mixed with -fopenacc, I think it would be
> nice to have some test cases where !$omp and !$acc are both placed -
> in either order - before the same Fortran statement.
>
I'm going to test this, too. There are can be some compilcations while
using both !$omp and !$acc on single statement.
--
Ilmir.
^ permalink raw reply [flat|nested] 89+ messages in thread
* Re: [PATCH 5/6] [GOMP4] OpenACC 1.0+ support in fortran front-end
2014-02-10 9:45 ` Ilmir Usmanov
@ 2014-02-10 10:52 ` Thomas Schwinge
0 siblings, 0 replies; 89+ messages in thread
From: Thomas Schwinge @ 2014-02-10 10:52 UTC (permalink / raw)
To: Ilmir Usmanov, Tobias Burnus
Cc: Evgeny Gavrin, GarbuzovViacheslav, Dmitri Botcharnikov,
gcc-patches, jakub, fortran
[-- Attachment #1: Type: text/plain, Size: 827 bytes --]
Hi!
On Mon, 10 Feb 2014 13:44:51 +0400, Ilmir Usmanov <i.usmanov@samsung.com> wrote:
> > As -fopenmp seemingly can be mixed with -fopenacc, I think it would be
> > nice to have some test cases where !$omp and !$acc are both placed -
> > in either order - before the same Fortran statement.
> >
> I'm going to test this, too. There are can be some compilcations while
> using both !$omp and !$acc on single statement.
For the record, in the C front end and middle end, I'm currently refusing
any nesting of OpenACC and OpenMP directives (keeping that "fun" for
later...). See gcc/testsuite/c-c++-common/goacc-gomp/nesting-fail-1.c
and gcc/testsuite/c-c++-common/goacc/nesting-fail-1.c in r204532,
<http://news.gmane.org/find-root.php?message_id=%3C8761s5joir.fsf%40schwinge.name%3E>.
Grüße,
Thomas
[-- Attachment #2: Type: application/pgp-signature, Size: 489 bytes --]
^ permalink raw reply [flat|nested] 89+ messages in thread
* Re: [PATCH 5/6] [GOMP4] OpenACC 1.0+ support in fortran front-end
2014-02-10 8:52 ` Thomas Schwinge
2014-02-10 9:34 ` Ilmir Usmanov
@ 2014-02-10 23:13 ` Tobias Burnus
1 sibling, 0 replies; 89+ messages in thread
From: Tobias Burnus @ 2014-02-10 23:13 UTC (permalink / raw)
To: Thomas Schwinge, Ilmir Usmanov
Cc: Evgeny Gavrin, GarbuzovViacheslav, Dmitri Botcharnikov,
gcc-patches, jakub, fortran
Hi!
Thomas Schwinge wrote:
> Please see
> [...]
> $ git diff --stat 765faa80eda3bb75aa044ad015e2e5214bf02c6d origin/gomp-4_0-branch | grep -v ChangeLog
I am now browsing through the changes. Remarks:
1) I think you also want to set in gcc/fortran/options.c
gfc_option.flag_recursive = -1
for OpenACC as it is done for OpenMP. That should be also mentioned in
fortran/invoke.texi - without -frecursive, local array variables might
be allocated in static memory, which should be incompatible with
concurrent invocation. [At least with OpenACC 2.0's $acc routine.]
2) I think OpenACC should also be mentioned at
http://gcc.gnu.org/onlinedocs/gfortran/Standards.html and, maybe, at
http://gcc.gnu.org/onlinedocs/gfortran/Project-Status.html - however, I
suggest not to put the version number there.
3) I think it would be useful to document the constants and the still
lacking functions/procedures of openacc.h, openacc_lib.h and the openacc
module; maybe you should start with a stub documentation - either by
adding it into a separate chapter in libgomp.texi or in an extra
document. In any case, there should be some reference to that document
from http://gcc.gnu.org/onlinedocs/gfortran/Intrinsic-Modules.html
(fortran/intrinsic.texi)
>> Can't you? I am not sure whether -fdump-parse-tree is needed; on the
>> other hand, it just clutters the *log files.
> Yes, I think that should just be in the test case files that actually
> need it?
I think the parse tree is never really needed - it just dumps the
gfortran AST in a somewhat readable form to stdout. Hence, it mainly
tests that the compiler doesn't ICE, unless one tries to do pattern
matching.
(As -fdump-parse-tree is only rarely used, one keeps forgetting about it
when extending the AST. Consequently, ICEs aren't that rare.)
Tobias
^ permalink raw reply [flat|nested] 89+ messages in thread
* Re: [PATCH 4/6] [GOMP4] OpenACC 1.0+ support in fortran front-end
2014-01-31 11:22 ` [PATCH 4/6] " Ilmir Usmanov
2014-01-31 11:34 ` [PATCH 5/6] " Ilmir Usmanov
@ 2014-02-11 16:51 ` Thomas Schwinge
2014-02-13 13:15 ` Ilmir Usmanov
2014-02-21 19:29 ` [GOMP4] gimple_code_is_oacc -> is_gimple_omp_oacc_specifically (was: [PATCH 4/6] [GOMP4] OpenACC 1.0+ support in fortran front-end) Thomas Schwinge
1 sibling, 2 replies; 89+ messages in thread
From: Thomas Schwinge @ 2014-02-11 16:51 UTC (permalink / raw)
To: Ilmir Usmanov
Cc: Evgeny Gavrin, GarbuzovViacheslav, Dmitri Botcharnikov,
gcc-patches, jakub, fortran
[-- Attachment #1: Type: text/plain, Size: 14084 bytes --]
Hi!
On Fri, 31 Jan 2014 15:16:07 +0400, Ilmir Usmanov <i.usmanov@samsung.com> wrote:
> OpenACC 1.0 support -- GENERIC nodes and gimplify stubs.
Thanks! This one is nearly ready for commit, and can then go in already,
while the Fortran front end patches are still being dicussed. :-)
Please merge »OpenACC 1.0 support -- documentation« into this patch. In
gcc/doc/generic.texi, please also add an entry for OACC_DECLARE, which is
currently missing. Ideally, gcc/doc/generic.texi <OMP_CLAUSE> should
also be updated for the OpenACC clauses (as well as recently added OpenMP
ones), but as that one's outdated already, this is not a prerequisite.
For ChangeLog files updates (on gomp-4_0-branch, use the respective
ChangeLog.gomp files, by the way), should just you be listed as the
author, or also your colleagues?
> --- a/gcc/gimplify.c
> +++ b/gcc/gimplify.c
> @@ -6157,6 +6166,20 @@ gimplify_scan_omp_clauses (tree *list_p, gimple_seq *pre_p,
> remove = true;
> break;
>
> + case OMP_CLAUSE_HOST:
> + case [...]
> + case OMP_CLAUSE_VECTOR_LENGTH:
> case OMP_CLAUSE_NOWAIT:
> case OMP_CLAUSE_ORDERED:
> case OMP_CLAUSE_UNTIED:
Indentation (one tab instead of two spaces).
> @@ -6476,6 +6499,23 @@ gimplify_adjust_omp_clauses (tree *list_p)
> }
> break;
>
> + case OMP_CLAUSE_HOST:
> + case [...]
> + case OMP_CLAUSE_VECTOR_LENGTH:
> + sorry ("Clause not supported yet");
> + break;
> +
> case OMP_CLAUSE_REDUCTION:
> case OMP_CLAUSE_COPYIN:
> case OMP_CLAUSE_COPYPRIVATE:
Indentation.
Also, shouldn't the sorry be moved to gimplify_scan_omp_clauses, and a
»remove = true« be added in there, and gimplify_adjust_omp_clauses then
just contain a gcc_unreachable (or, move the new »case OMP_CLAUSE_*« next
to the existing default: that already contains gcc_unreachable)?
> @@ -7988,6 +8028,19 @@ gimplify_expr (tree *expr_p, gimple_seq *pre_p, gimple_seq *post_p,
> ret = GS_ALL_DONE;
> break;
>
> + case OACC_KERNELS:
> + case OACC_DATA:
> + case OACC_CACHE:
> + case OACC_WAIT:
> + case OACC_HOST_DATA:
> + case OACC_DECLARE:
> + case OACC_UPDATE:
> + case OACC_ENTER_DATA:
> + case OACC_EXIT_DATA:
> + sorry ("directive not yet implemented");
> + ret = GS_ALL_DONE;
> + break;
> +
> case OMP_PARALLEL:
> gimplify_omp_parallel (expr_p, pre_p);
> ret = GS_ALL_DONE;
Indentation.
Further down in gimplify_expr, shouldn't these new OACC_* codes also be
added to the »These expressions should already be in gimple IR form«
assert?
> --- a/gcc/omp-low.c
> +++ b/gcc/omp-low.c
> @@ -1491,6 +1491,18 @@ fixup_child_record_type (omp_context *ctx)
> TREE_TYPE (ctx->receiver_decl) = build_pointer_type (type);
> }
>
> +static bool
> +gimple_code_is_oacc (const_gimple g)
> +{
> + switch (gimple_code (g))
> + {
> + case GIMPLE_OACC_PARALLEL:
> + return true;
> + default:
> + return false;
> + }
> +}
> +
Eventually, this will probably end up next to CASE_GIMPLE_OP/is_gimple_op
in gimple.h (or the latter be reworked to be able to ask for is_omp vs.
is_oacc vs. is_omp_or_oacc), but it's fine to do that once we actually
need it in files other than just omp-low.c, and once we support more
GIMPLE_OACC_* codes.
> @@ -1710,17 +1732,34 @@ scan_sharing_clauses (tree clauses, omp_context *ctx)
> + case OMP_CLAUSE_HOST:
> + case OMP_CLAUSE_OACC_DEVICE:
> + case OMP_CLAUSE_DEVICE_RESIDENT:
> + case OMP_CLAUSE_USE_DEVICE:
> + case OMP_CLAUSE_ASYNC:
> + case OMP_CLAUSE_GANG:
> + case OMP_CLAUSE_WAIT:
> + case OMP_NO_CLAUSE_CACHE:
> + case OMP_CLAUSE_INDEPENDENT:
> + case OMP_CLAUSE_WORKER:
> + case OMP_CLAUSE_VECTOR:
> + case OMP_CLAUSE_NUM_GANGS:
> + case OMP_CLAUSE_NUM_WORKERS:
> + case OMP_CLAUSE_VECTOR_LENGTH:
> + sorry ("Clause not supported yet");
> + break;
> +
> default:
> gcc_unreachable ();
> }
Indentation.
> @@ -1827,9 +1876,26 @@ scan_sharing_clauses (tree clauses, omp_context *ctx)
> case OMP_CLAUSE__LOOPTEMP_:
> case OMP_CLAUSE_TO:
> case OMP_CLAUSE_FROM:
> - gcc_assert (gimple_code (ctx->stmt) != GIMPLE_OACC_PARALLEL);
> + gcc_assert (!gimple_code_is_oacc (ctx->stmt));
> break;
>
> + case OMP_CLAUSE_HOST:
> + case OMP_CLAUSE_OACC_DEVICE:
> + case OMP_CLAUSE_DEVICE_RESIDENT:
> + case OMP_CLAUSE_USE_DEVICE:
> + case OMP_CLAUSE_ASYNC:
> + case OMP_CLAUSE_GANG:
> + case OMP_CLAUSE_WAIT:
> + case OMP_NO_CLAUSE_CACHE:
> + case OMP_CLAUSE_INDEPENDENT:
> + case OMP_CLAUSE_WORKER:
> + case OMP_CLAUSE_VECTOR:
> + case OMP_CLAUSE_NUM_GANGS:
> + case OMP_CLAUSE_NUM_WORKERS:
> + case OMP_CLAUSE_VECTOR_LENGTH:
> + sorry ("Clause not supported yet");
> + break;
> +
> default:
> gcc_unreachable ();
> }
Indentation.
> --- a/gcc/tree-core.h
> +++ b/gcc/tree-core.h
> @@ -213,19 +213,19 @@ enum omp_clause_code {
> (c_parser_omp_variable_list). */
> OMP_CLAUSE_ERROR = 0,
>
> - /* OpenMP clause: private (variable_list). */
> + /* OpenMP/OpenACC clause: private (variable_list). */
> OMP_CLAUSE_PRIVATE,
>
> /* OpenMP clause: shared (variable_list). */
> OMP_CLAUSE_SHARED,
>
> - /* OpenMP clause: firstprivate (variable_list). */
> + /* OpenMP/OpenACC clause: firstprivate (variable_list). */
> OMP_CLAUSE_FIRSTPRIVATE,
>
> /* OpenMP clause: lastprivate (variable_list). */
> OMP_CLAUSE_LASTPRIVATE,
>
> - /* OpenMP clause: reduction (operator:variable_list).
> + /* OpenMP/OpenACC clause: reduction (operator:variable_list).
> OMP_CLAUSE_REDUCTION_CODE: The tree_code of the operator.
> Operand 1: OMP_CLAUSE_REDUCTION_INIT: Stmt-list to initialize the var.
> Operand 2: OMP_CLAUSE_REDUCTION_MERGE: Stmt-list to merge private var
> @@ -265,10 +265,40 @@ enum omp_clause_code {
> OpenMP clause: map ({alloc:,to:,from:,tofrom:,}variable-list). */
> OMP_CLAUSE_MAP,
>
> + /* OpenACC clause: host (variable_list). */
> + OMP_CLAUSE_HOST,
> +
> + /* OpenACC clause: device (variable_list). */
> + OMP_CLAUSE_OACC_DEVICE,
> +
> + /* OpenACC clause: device_resident (variable_list). */
> + OMP_CLAUSE_DEVICE_RESIDENT,
> +
> + /* OpenACC clause: use_device (variable_list). */
> + OMP_CLAUSE_USE_DEVICE,
> +
> + /* OpenACC clause: async [(integer-expression)]. */
> + OMP_CLAUSE_ASYNC,
> +
> + /* OpenACC clause: gang [(gang-argument-list)].
> + Where
> + gang-argument-list: [gang-argument-list, ] gang-argument
> + gang-argument: [num:] integer-expression
> + | static: size-expression
> + size-expression: * | integer-expression. */
> + OMP_CLAUSE_GANG,
> +
> + /* OpenACC clause/directive: wait [(integer-expression-list)]. */
> + OMP_CLAUSE_WAIT,
> +
> + /* Internal structure to hold OpenACC cache directive's variable-list.
> + #pragma acc cache (variable-list). */
> + OMP_NO_CLAUSE_CACHE,
> +
> /* Internal clause: temporary for combined loops expansion. */
> OMP_CLAUSE__LOOPTEMP_,
>
> - /* OpenMP clause: if (scalar-expression). */
> + /* OpenMP/OpenACC clause: if (scalar-expression). */
> OMP_CLAUSE_IF,
>
> /* OpenMP clause: num_threads (integer-expression). */
> @@ -281,12 +311,13 @@ enum omp_clause_code {
> OMP_CLAUSE_NOWAIT,
>
> /* OpenMP clause: ordered. */
> + /* OpenACC clause: seq. */
> OMP_CLAUSE_ORDERED,
>
> /* OpenMP clause: default. */
> OMP_CLAUSE_DEFAULT,
>
> - /* OpenMP clause: collapse (constant-integer-expression). */
> + /* OpenMP/OpenACC clause: collapse (constant-integer-expression). */
> OMP_CLAUSE_COLLAPSE,
>
> /* OpenMP clause: untied. */
> @@ -338,7 +369,25 @@ enum omp_clause_code {
> OMP_CLAUSE_TASKGROUP,
>
> /* Internally used only clause, holding SIMD uid. */
> - OMP_CLAUSE__SIMDUID_
> + OMP_CLAUSE__SIMDUID_,
> +
> + /* OpenACC clause: independent. */
> + OMP_CLAUSE_INDEPENDENT,
> +
> + /* OpenACC clause: worker [( [num:] integer-expression)]. */
> + OMP_CLAUSE_WORKER,
> +
> + /* OpenACC clause: vector [( [length:] integer-expression)]. */
> + OMP_CLAUSE_VECTOR,
> +
> + /* OpenACC clause: num_gangs (integer-expression). */
> + OMP_CLAUSE_NUM_GANGS,
> +
> + /* OpenACC clause: num_workers (integer-expression). */
> + OMP_CLAUSE_NUM_WORKERS,
> +
> + /* OpenACC clause: vector_length (integer-expression). */
> + OMP_CLAUSE_VECTOR_LENGTH
> };
Unless I'm confused, some of the new clauses (those that deal with more
than just a single operand) will need to get special handling added à la
the other omp_clause_subcode variants in tree-core.h:tree_omp_clause?
(It is fine to rework that in a later patch, once we actually implement
these clauses.)
> --- a/gcc/tree-pretty-print.c
> +++ b/gcc/tree-pretty-print.c
> @@ -326,6 +326,21 @@ dump_omp_clause (pretty_printer *buffer, tree clause, int spc, int flags)
OMP_CLAUSE_WAIT is missing.
> @@ -2384,6 +2452,41 @@ dump_generic_node (pretty_printer *buffer, tree node, int spc, int flags,
OACC_ENTER_DATA and OACC_EXIT_DATA are missing.
> --- a/gcc/tree.c
> +++ b/gcc/tree.c
> @@ -327,7 +350,13 @@ const char * const omp_clause_code_name[] =
> + "indepentend",
Typo: independent.
> @@ -11034,6 +11063,18 @@ walk_tree_1 (tree *tp, walk_tree_fn func, void *data,
OMP_CLAUSE_GANG missing.
> case OMP_CLAUSE:
> switch (OMP_CLAUSE_CODE (*tp))
> {
> + case OMP_CLAUSE_HOST:
> + case OMP_CLAUSE_OACC_DEVICE:
> + case OMP_CLAUSE_DEVICE_RESIDENT:
> + case OMP_CLAUSE_USE_DEVICE:
> + case OMP_NO_CLAUSE_CACHE:
> + case OMP_CLAUSE_ASYNC:
> + case OMP_CLAUSE_WORKER:
> + case OMP_CLAUSE_VECTOR:
> + case OMP_CLAUSE_NUM_GANGS:
> + case OMP_CLAUSE_NUM_WORKERS:
> + case OMP_CLAUSE_VECTOR_LENGTH:
> + case OMP_CLAUSE_WAIT:
> case OMP_CLAUSE_PRIVATE:
> case OMP_CLAUSE_SHARED:
> case OMP_CLAUSE_FIRSTPRIVATE:
Indentation.
> @@ -11056,6 +11097,7 @@ walk_tree_1 (tree *tp, walk_tree_fn func, void *data,
> WALK_SUBTREE (OMP_CLAUSE_OPERAND (*tp, 0));
> /* FALLTHRU */
>
> + case OMP_CLAUSE_INDEPENDENT:
> case OMP_CLAUSE_NOWAIT:
> case OMP_CLAUSE_ORDERED:
> case OMP_CLAUSE_DEFAULT:
Indentation.
> --- a/gcc/tree.def
> +++ b/gcc/tree.def
> @@ -1017,6 +1017,56 @@ DEFTREECODE (MEM_REF, "mem_ref", tcc_reference, 2)
>
> DEFTREECODE (OACC_PARALLEL, "oacc_parallel", tcc_statement, 2)
>
> +/* #pragma acc kernels */
> +/* Operand 0: BODY
> + Operand 1: CLAUSES
> +*/
> +DEFTREECODE (OACC_KERNELS, "oacc_kernels", tcc_statement, 2)
> +
> +/* #pragma acc data */
> +/* Operand 0: BODY
> + Operand 1: CLAUSES
> +*/
> +DEFTREECODE (OACC_DATA, "oacc_data", tcc_statement, 2)
> +
> +/* #pragma acc host_data */
> +/* Operand 0: BODY
> + Operand 1: CLAUSES
> +*/
> +DEFTREECODE (OACC_HOST_DATA, "oacc_host_data", tcc_statement, 2)
> +
> +/* #pragma acc declare */
> +/* Operand 0: CLAUSES
> +*/
> +DEFTREECODE (OACC_DECLARE, "oacc_declare", tcc_statement, 1)
> +[...]
| [...]
| DEFTREECODE (OMP_PARALLEL, "omp_parallel", tcc_statement, 2)
| [...]
| DEFTREECODE (OMP_SINGLE, "omp_single", tcc_statement, 2)
| [...]
| DEFTREECODE (OMP_CRITICAL, "omp_critical", tcc_statement, 2)
| [...]
If you look at tree.h:OMP_BODY and OMP_CLAUSES:
#define OMP_BODY(NODE) \
TREE_OPERAND (TREE_RANGE_CHECK (NODE, OACC_PARALLEL, OMP_CRITICAL), 0)
#define OMP_CLAUSES(NODE) \
TREE_OPERAND (TREE_RANGE_CHECK (NODE, OACC_PARALLEL, OMP_SINGLE), 1)
..., you'll see that any codes from OACC_PARALLEL to OMP_CRITICAL are
expected to have a body as operand 0, and all from OACC_PARALLEL to
OMP_SINGLE are expected to have a list of clauses as operand 1.
This doesn't matter as long as all code paths are using the more
specialized OMP_*_BODY/OACC_*_BODY and OMP_*_CLAUSES/OACC_*_CLAUSES
accessor macros instead of the generic OMP_BODY and OMP_CLAUSES ones when
working with such OMP_* nodes, but to reduce confusion for readers of
this list/code, we should anyway pay attention, that is, distribute the
new OACC_* tree codes in tree.def to the appropriate places, to fit into
the existing scheme (as good as possible). Please then also try to
maintain the same order of OACC_* codes in tree.h, tree.c, and so on:
> --- a/gcc/tree.h
> +++ b/gcc/tree.h
> @@ -1367,6 +1367,59 @@ extern void protected_set_expr_location (tree, location_t);
> #define OMP_CLAUSE_DEFAULT_KIND(NODE) \
> (OMP_CLAUSE_SUBCODE_CHECK (NODE, OMP_CLAUSE_DEFAULT)->omp_clause.subcode.default_kind)
>
> +/* OpenACC directives and clause accessors. */
> +
> +#define OACC_KERNELS_BODY(NODE) TREE_OPERAND (OACC_KERNELS_CHECK(NODE), 0)
> +#define OACC_KERNELS_CLAUSES(NODE) TREE_OPERAND (OACC_KERNELS_CHECK(NODE), 1)
..., that is, move these (and the following ones) after the existing
OACC_PARALLEL_*, and so on, as appropriate.
> +#define OACC_DATA_BODY(NODE) \
> + TREE_OPERAND (OACC_DATA_CHECK (NODE), 0)
> +
> +#define OACC_DATA_CLAUSES(NODE) \
> + TREE_OPERAND (OACC_DATA_CHECK (NODE), 1)
No empty line between macros for the same tree code (OACC_DATA).
> +/* OpenACC clauses */
> +#define OMP_CLAUSE_[...]_EXPR(NODE) \
Please also try to sort these into the appropriate order (that is, as
defined in tree-core.h:omp_clause_code) -- if possible: I see that it is
not really consistent right now. (This would also apply to the other
files where any OMP_*/OACC_* are used, for example the pretty printers,
but alas, if it's not in the right order now, then don't bother too much
about it.)
With these issues addressed, this patch is ready for commit to
gomp-4_0-branch. Use your own judgement; if you feel confident, just
commit it, or otherwise post it again for a final review -- as you
prefer.
Grüße,
Thomas
[-- Attachment #2: Type: application/pgp-signature, Size: 489 bytes --]
^ permalink raw reply [flat|nested] 89+ messages in thread
* Re: [PATCH 4/6] [GOMP4] OpenACC 1.0+ support in fortran front-end
2014-02-11 16:51 ` [PATCH 4/6] " Thomas Schwinge
@ 2014-02-13 13:15 ` Ilmir Usmanov
2014-02-13 14:57 ` Thomas Schwinge
2014-02-21 19:29 ` [GOMP4] gimple_code_is_oacc -> is_gimple_omp_oacc_specifically (was: [PATCH 4/6] [GOMP4] OpenACC 1.0+ support in fortran front-end) Thomas Schwinge
1 sibling, 1 reply; 89+ messages in thread
From: Ilmir Usmanov @ 2014-02-13 13:15 UTC (permalink / raw)
To: Thomas Schwinge
Cc: Evgeny Gavrin, GarbuzovViacheslav, Dmitri Botcharnikov,
gcc-patches, jakub, fortran
[-- Attachment #1: Type: text/plain, Size: 714 bytes --]
Hi Thomas!
Thanks a lot for your review!
I agree with all your notes.
On 11.02.2014 20:51, Thomas Schwinge wrote:
> For ChangeLog files updates (on gomp-4_0-branch, use the respective
> ChangeLog.gomp files, by the way), should just you be listed as the
> author, or also your colleagues?
Thank you for the notice, I added Evgeny and Dmitry as authors for this
part (see attached ChangeLog entry).
> With these issues addressed, this patch is ready for commit to
> gomp-4_0-branch. Use your own judgement; if you feel confident, just
> commit it, or otherwise post it again for a final review -- as you
> prefer.
I fixed patch according to your review and ready to commit it. OK for
GOMP4 branch?
--
Ilmir.
[-- Attachment #2: 0001-OpenACC-GENERIC-nodes.patch --]
[-- Type: text/x-diff, Size: 29010 bytes --]
From bf14158b1a28c2c5b29c41071fa62c011d9f4f65 Mon Sep 17 00:00:00 2001
From: Ilmir Usmanov <i.usmanov@samsung.com>
Date: Thu, 13 Feb 2014 15:58:28 +0400
Subject: [PATCH] OpenACC GENERIC nodes
---
gcc/doc/generic.texi | 45 ++++++++++++++++++
gcc/gimplify.c | 62 +++++++++++++++++++++++++
gcc/omp-low.c | 96 ++++++++++++++++++++++++++++++++------
gcc/tree-core.h | 61 ++++++++++++++++++++++---
gcc/tree-pretty-print.c | 119 ++++++++++++++++++++++++++++++++++++++++++++++++
gcc/tree.c | 44 +++++++++++++++++-
gcc/tree.def | 42 +++++++++++++++++
gcc/tree.h | 61 ++++++++++++++++++++++++-
8 files changed, 507 insertions(+), 23 deletions(-)
diff --git a/gcc/doc/generic.texi b/gcc/doc/generic.texi
index a56715b..ce14620 100644
--- a/gcc/doc/generic.texi
+++ b/gcc/doc/generic.texi
@@ -2052,6 +2052,15 @@ edge. Rethrowing the exception is represented using @code{RESX_EXPR}.
@node OpenMP
@subsection OpenMP
@tindex OACC_PARALLEL
+@tindex OACC_KERNELS
+@tindex OACC_DATA
+@tindex OACC_HOST_DATA
+@tindex OACC_DECLARE
+@tindex OACC_UPDATE
+@tindex OACC_ENTER_DATA
+@tindex OACC_EXIT_DATA
+@tindex OACC_WAIT
+@tindex OACC_CACHE
@tindex OMP_PARALLEL
@tindex OMP_FOR
@tindex OMP_SECTIONS
@@ -2073,6 +2082,42 @@ clauses used by the OpenMP API @w{@uref{http://www.openmp.org/}}.
Represents @code{#pragma acc parallel [clause1 @dots{} clauseN]}.
+@item OACC_KERNELS
+
+Represents @code{#pragma acc kernels [clause1 @dots{} clauseN]}.
+
+@item OACC_DATA
+
+Represents @code{#pragma acc data [clause1 @dots{} clauseN]}.
+
+@item OACC_HOST_DATA
+
+Represents @code{#pragma acc host_data [clause1 @dots{} clauseN]}.
+
+@item OACC_DECLARE
+
+Represents @code{#pragma acc declare [clause1 @dots{} clauseN]}.
+
+@item OACC_UPDATE
+
+Represents @code{#pragma acc update [clause1 @dots{} clauseN]}.
+
+@item OACC_ENTER_DATA
+
+Represents @code{#pragma acc enter data [clause1 @dots{} clauseN]}.
+
+@item OACC_EXIT_DATA
+
+Represents @code{#pragma acc exit data [clause1 @dots{} clauseN]}.
+
+@item OACC_WAIT
+
+Represents @code{#pragma acc wait [(num @dots{})]}.
+
+@item OACC_CACHE
+
+Represents @code{#pragma acc cache (var @dots{})}.
+
@item OMP_PARALLEL
Represents @code{#pragma omp parallel [clause1 @dots{} clauseN]}. It
diff --git a/gcc/gimplify.c b/gcc/gimplify.c
index d20f07f..06d7790 100644
--- a/gcc/gimplify.c
+++ b/gcc/gimplify.c
@@ -4333,6 +4333,15 @@ is_gimple_stmt (tree t)
case ASM_EXPR:
case STATEMENT_LIST:
case OACC_PARALLEL:
+ case OACC_KERNELS:
+ case OACC_DATA:
+ case OACC_HOST_DATA:
+ case OACC_DECLARE:
+ case OACC_UPDATE:
+ case OACC_ENTER_DATA:
+ case OACC_EXIT_DATA:
+ case OACC_WAIT:
+ case OACC_CACHE:
case OMP_PARALLEL:
case OMP_FOR:
case OMP_SIMD:
@@ -6157,6 +6166,23 @@ gimplify_scan_omp_clauses (tree *list_p, gimple_seq *pre_p,
remove = true;
break;
+ case OMP_CLAUSE_HOST:
+ case OMP_CLAUSE_OACC_DEVICE:
+ case OMP_CLAUSE_DEVICE_RESIDENT:
+ case OMP_CLAUSE_USE_DEVICE:
+ case OMP_CLAUSE_GANG:
+ case OMP_CLAUSE_WAIT:
+ case OMP_NO_CLAUSE_CACHE:
+ case OMP_CLAUSE_INDEPENDENT:
+ case OMP_CLAUSE_ASYNC:
+ case OMP_CLAUSE_WORKER:
+ case OMP_CLAUSE_VECTOR:
+ case OMP_CLAUSE_NUM_GANGS:
+ case OMP_CLAUSE_NUM_WORKERS:
+ case OMP_CLAUSE_VECTOR_LENGTH:
+ remove = true;
+ break;
+
case OMP_CLAUSE_NOWAIT:
case OMP_CLAUSE_ORDERED:
case OMP_CLAUSE_UNTIED:
@@ -6498,6 +6524,20 @@ gimplify_adjust_omp_clauses (tree *list_p)
case OMP_CLAUSE_DEPEND:
break;
+ case OMP_CLAUSE_HOST:
+ case OMP_CLAUSE_OACC_DEVICE:
+ case OMP_CLAUSE_DEVICE_RESIDENT:
+ case OMP_CLAUSE_USE_DEVICE:
+ case OMP_CLAUSE_GANG:
+ case OMP_CLAUSE_WAIT:
+ case OMP_NO_CLAUSE_CACHE:
+ case OMP_CLAUSE_INDEPENDENT:
+ case OMP_CLAUSE_ASYNC:
+ case OMP_CLAUSE_WORKER:
+ case OMP_CLAUSE_VECTOR:
+ case OMP_CLAUSE_NUM_GANGS:
+ case OMP_CLAUSE_NUM_WORKERS:
+ case OMP_CLAUSE_VECTOR_LENGTH:
default:
gcc_unreachable ();
}
@@ -7988,6 +8028,19 @@ gimplify_expr (tree *expr_p, gimple_seq *pre_p, gimple_seq *post_p,
ret = GS_ALL_DONE;
break;
+ case OACC_KERNELS:
+ case OACC_DATA:
+ case OACC_HOST_DATA:
+ case OACC_DECLARE:
+ case OACC_UPDATE:
+ case OACC_ENTER_DATA:
+ case OACC_EXIT_DATA:
+ case OACC_WAIT:
+ case OACC_CACHE:
+ sorry ("directive not yet implemented");
+ ret = GS_ALL_DONE;
+ break;
+
case OMP_PARALLEL:
gimplify_omp_parallel (expr_p, pre_p);
ret = GS_ALL_DONE;
@@ -8396,6 +8449,15 @@ gimplify_expr (tree *expr_p, gimple_seq *pre_p, gimple_seq *post_p,
&& code != SWITCH_EXPR
&& code != TRY_FINALLY_EXPR
&& code != OACC_PARALLEL
+ && code != OACC_KERNELS
+ && code != OACC_DATA
+ && code != OACC_HOST_DATA
+ && code != OACC_DECLARE
+ && code != OACC_UPDATE
+ && code != OACC_ENTER_DATA
+ && code != OACC_EXIT_DATA
+ && code != OACC_WAIT
+ && code != OACC_CACHE
&& code != OMP_CRITICAL
&& code != OMP_FOR
&& code != OMP_MASTER
diff --git a/gcc/omp-low.c b/gcc/omp-low.c
index 4bbe6d6..fd94e63 100644
--- a/gcc/omp-low.c
+++ b/gcc/omp-low.c
@@ -1491,6 +1491,18 @@ fixup_child_record_type (omp_context *ctx)
TREE_TYPE (ctx->receiver_decl) = build_pointer_type (type);
}
+static bool
+gimple_code_is_oacc (const_gimple g)
+{
+ switch (gimple_code (g))
+ {
+ case GIMPLE_OACC_PARALLEL:
+ return true;
+ default:
+ return false;
+ }
+}
+
/* Instantiate decls as necessary in CTX to satisfy the data sharing
specified by CLAUSES. */
@@ -1552,8 +1564,13 @@ scan_sharing_clauses (tree clauses, omp_context *ctx)
case OMP_CLAUSE_FIRSTPRIVATE:
case OMP_CLAUSE_REDUCTION:
+ if (gimple_code (ctx->stmt) == GIMPLE_OACC_PARALLEL)
+ {
+ sorry ("clause not supported yet");
+ break;
+ }
case OMP_CLAUSE_LINEAR:
- gcc_assert (gimple_code (ctx->stmt) != GIMPLE_OACC_PARALLEL);
+ gcc_assert (!gimple_code_is_oacc (ctx->stmt));
decl = OMP_CLAUSE_DECL (c);
do_private:
if (is_variable_sized (decl))
@@ -1591,7 +1608,7 @@ scan_sharing_clauses (tree clauses, omp_context *ctx)
case OMP_CLAUSE_COPYPRIVATE:
case OMP_CLAUSE_COPYIN:
- gcc_assert (gimple_code (ctx->stmt) != GIMPLE_OACC_PARALLEL);
+ gcc_assert (!gimple_code_is_oacc (ctx->stmt));
decl = OMP_CLAUSE_DECL (c);
by_ref = use_pointer_for_field (decl, NULL);
install_var_field (decl, by_ref, 3, ctx);
@@ -1602,8 +1619,13 @@ scan_sharing_clauses (tree clauses, omp_context *ctx)
ctx->default_kind = OMP_CLAUSE_DEFAULT_KIND (c);
break;
- case OMP_CLAUSE_FINAL:
case OMP_CLAUSE_IF:
+ if (gimple_code (ctx->stmt) == GIMPLE_OACC_PARALLEL)
+ {
+ sorry ("clause not supported yet");
+ break;
+ }
+ case OMP_CLAUSE_FINAL:
case OMP_CLAUSE_NUM_THREADS:
case OMP_CLAUSE_NUM_TEAMS:
case OMP_CLAUSE_THREAD_LIMIT:
@@ -1611,14 +1633,14 @@ scan_sharing_clauses (tree clauses, omp_context *ctx)
case OMP_CLAUSE_SCHEDULE:
case OMP_CLAUSE_DIST_SCHEDULE:
case OMP_CLAUSE_DEPEND:
- gcc_assert (gimple_code (ctx->stmt) != GIMPLE_OACC_PARALLEL);
+ gcc_assert (!gimple_code_is_oacc (ctx->stmt));
if (ctx->outer)
scan_omp_op (&OMP_CLAUSE_OPERAND (c, 0), ctx->outer);
break;
case OMP_CLAUSE_TO:
case OMP_CLAUSE_FROM:
- gcc_assert (gimple_code (ctx->stmt) != GIMPLE_OACC_PARALLEL);
+ gcc_assert (!gimple_code_is_oacc (ctx->stmt));
case OMP_CLAUSE_MAP:
if (ctx->outer)
scan_omp_op (&OMP_CLAUSE_SIZE (c), ctx->outer);
@@ -1641,7 +1663,7 @@ scan_sharing_clauses (tree clauses, omp_context *ctx)
/* Ignore OMP_CLAUSE_MAP_POINTER kind for arrays in
#pragma omp target data, there is nothing to map for
those. */
- if (gimple_code (ctx->stmt) != GIMPLE_OACC_PARALLEL
+ if (!gimple_code_is_oacc (ctx->stmt)
&& gimple_omp_target_kind (ctx->stmt) == GF_OMP_TARGET_KIND_DATA
&& !POINTER_TYPE_P (TREE_TYPE (decl)))
break;
@@ -1710,17 +1732,34 @@ scan_sharing_clauses (tree clauses, omp_context *ctx)
case OMP_CLAUSE_MERGEABLE:
case OMP_CLAUSE_PROC_BIND:
case OMP_CLAUSE_SAFELEN:
- gcc_assert (gimple_code (ctx->stmt) != GIMPLE_OACC_PARALLEL);
+ gcc_assert (!gimple_code_is_oacc (ctx->stmt));
break;
case OMP_CLAUSE_ALIGNED:
- gcc_assert (gimple_code (ctx->stmt) != GIMPLE_OACC_PARALLEL);
+ gcc_assert (!gimple_code_is_oacc (ctx->stmt));
decl = OMP_CLAUSE_DECL (c);
if (is_global_var (decl)
&& TREE_CODE (TREE_TYPE (decl)) == ARRAY_TYPE)
install_var_local (decl, ctx);
break;
+ case OMP_CLAUSE_HOST:
+ case OMP_CLAUSE_OACC_DEVICE:
+ case OMP_CLAUSE_DEVICE_RESIDENT:
+ case OMP_CLAUSE_USE_DEVICE:
+ case OMP_CLAUSE_GANG:
+ case OMP_CLAUSE_WAIT:
+ case OMP_NO_CLAUSE_CACHE:
+ case OMP_CLAUSE_INDEPENDENT:
+ case OMP_CLAUSE_ASYNC:
+ case OMP_CLAUSE_WORKER:
+ case OMP_CLAUSE_VECTOR:
+ case OMP_CLAUSE_NUM_GANGS:
+ case OMP_CLAUSE_NUM_WORKERS:
+ case OMP_CLAUSE_VECTOR_LENGTH:
+ sorry ("Clause not supported yet");
+ break;
+
default:
gcc_unreachable ();
}
@@ -1731,7 +1770,7 @@ scan_sharing_clauses (tree clauses, omp_context *ctx)
switch (OMP_CLAUSE_CODE (c))
{
case OMP_CLAUSE_LASTPRIVATE:
- gcc_assert (gimple_code (ctx->stmt) != GIMPLE_OACC_PARALLEL);
+ gcc_assert (!gimple_code_is_oacc (ctx->stmt));
/* Let the corresponding firstprivate clause create
the variable. */
if (OMP_CLAUSE_LASTPRIVATE_GIMPLE_SEQ (c))
@@ -1743,8 +1782,13 @@ scan_sharing_clauses (tree clauses, omp_context *ctx)
case OMP_CLAUSE_PRIVATE:
case OMP_CLAUSE_FIRSTPRIVATE:
case OMP_CLAUSE_REDUCTION:
+ if (gimple_code (ctx->stmt) == GIMPLE_OACC_PARALLEL)
+ {
+ sorry ("clause not supported yet");
+ break;
+ }
case OMP_CLAUSE_LINEAR:
- gcc_assert (gimple_code (ctx->stmt) != GIMPLE_OACC_PARALLEL);
+ gcc_assert (!gimple_code_is_oacc (ctx->stmt));
decl = OMP_CLAUSE_DECL (c);
if (is_variable_sized (decl))
install_var_local (decl, ctx);
@@ -1757,7 +1801,7 @@ scan_sharing_clauses (tree clauses, omp_context *ctx)
break;
case OMP_CLAUSE_SHARED:
- gcc_assert (gimple_code (ctx->stmt) != GIMPLE_OACC_PARALLEL);
+ gcc_assert (!gimple_code_is_oacc (ctx->stmt));
/* Ignore shared directives in teams construct. */
if (gimple_code (ctx->stmt) == GIMPLE_OMP_TEAMS)
break;
@@ -1767,7 +1811,7 @@ scan_sharing_clauses (tree clauses, omp_context *ctx)
break;
case OMP_CLAUSE_MAP:
- if (gimple_code (ctx->stmt) != GIMPLE_OACC_PARALLEL
+ if (!gimple_code_is_oacc (ctx->stmt)
&& gimple_omp_target_kind (ctx->stmt) == GF_OMP_TARGET_KIND_DATA)
break;
decl = OMP_CLAUSE_DECL (c);
@@ -1776,7 +1820,7 @@ scan_sharing_clauses (tree clauses, omp_context *ctx)
&& lookup_attribute ("omp declare target",
DECL_ATTRIBUTES (decl)))
{
- gcc_assert (gimple_code (ctx->stmt) != GIMPLE_OACC_PARALLEL);
+ gcc_assert (!gimple_code_is_oacc (ctx->stmt));
break;
}
if (DECL_P (decl))
@@ -1804,10 +1848,15 @@ scan_sharing_clauses (tree clauses, omp_context *ctx)
}
break;
+ case OMP_CLAUSE_IF:
+ if (gimple_code (ctx->stmt) == GIMPLE_OACC_PARALLEL)
+ {
+ sorry ("clause not supported yet");
+ break;
+ }
case OMP_CLAUSE_COPYPRIVATE:
case OMP_CLAUSE_COPYIN:
case OMP_CLAUSE_DEFAULT:
- case OMP_CLAUSE_IF:
case OMP_CLAUSE_NUM_THREADS:
case OMP_CLAUSE_NUM_TEAMS:
case OMP_CLAUSE_THREAD_LIMIT:
@@ -1827,7 +1876,24 @@ scan_sharing_clauses (tree clauses, omp_context *ctx)
case OMP_CLAUSE__LOOPTEMP_:
case OMP_CLAUSE_TO:
case OMP_CLAUSE_FROM:
- gcc_assert (gimple_code (ctx->stmt) != GIMPLE_OACC_PARALLEL);
+ gcc_assert (!gimple_code_is_oacc (ctx->stmt));
+ break;
+
+ case OMP_CLAUSE_HOST:
+ case OMP_CLAUSE_OACC_DEVICE:
+ case OMP_CLAUSE_DEVICE_RESIDENT:
+ case OMP_CLAUSE_USE_DEVICE:
+ case OMP_CLAUSE_GANG:
+ case OMP_CLAUSE_WAIT:
+ case OMP_NO_CLAUSE_CACHE:
+ case OMP_CLAUSE_INDEPENDENT:
+ case OMP_CLAUSE_ASYNC:
+ case OMP_CLAUSE_WORKER:
+ case OMP_CLAUSE_VECTOR:
+ case OMP_CLAUSE_NUM_GANGS:
+ case OMP_CLAUSE_NUM_WORKERS:
+ case OMP_CLAUSE_VECTOR_LENGTH:
+ sorry ("Clause not supported yet");
break;
default:
diff --git a/gcc/tree-core.h b/gcc/tree-core.h
index 1b974f8..d7b4ef4 100644
--- a/gcc/tree-core.h
+++ b/gcc/tree-core.h
@@ -213,19 +213,19 @@ enum omp_clause_code {
(c_parser_omp_variable_list). */
OMP_CLAUSE_ERROR = 0,
- /* OpenMP clause: private (variable_list). */
+ /* OpenMP/OpenACC clause: private (variable_list). */
OMP_CLAUSE_PRIVATE,
/* OpenMP clause: shared (variable_list). */
OMP_CLAUSE_SHARED,
- /* OpenMP clause: firstprivate (variable_list). */
+ /* OpenMP/OpenACC clause: firstprivate (variable_list). */
OMP_CLAUSE_FIRSTPRIVATE,
/* OpenMP clause: lastprivate (variable_list). */
OMP_CLAUSE_LASTPRIVATE,
- /* OpenMP clause: reduction (operator:variable_list).
+ /* OpenMP/OpenACC clause: reduction (operator:variable_list).
OMP_CLAUSE_REDUCTION_CODE: The tree_code of the operator.
Operand 1: OMP_CLAUSE_REDUCTION_INIT: Stmt-list to initialize the var.
Operand 2: OMP_CLAUSE_REDUCTION_MERGE: Stmt-list to merge private var
@@ -265,10 +265,37 @@ enum omp_clause_code {
OpenMP clause: map ({alloc:,to:,from:,tofrom:,}variable-list). */
OMP_CLAUSE_MAP,
+ /* OpenACC clause: host (variable_list). */
+ OMP_CLAUSE_HOST,
+
+ /* OpenACC clause: device (variable_list). */
+ OMP_CLAUSE_OACC_DEVICE,
+
+ /* OpenACC clause: device_resident (variable_list). */
+ OMP_CLAUSE_DEVICE_RESIDENT,
+
+ /* OpenACC clause: use_device (variable_list). */
+ OMP_CLAUSE_USE_DEVICE,
+
+ /* OpenACC clause: gang [(gang-argument-list)].
+ Where
+ gang-argument-list: [gang-argument-list, ] gang-argument
+ gang-argument: [num:] integer-expression
+ | static: size-expression
+ size-expression: * | integer-expression. */
+ OMP_CLAUSE_GANG,
+
+ /* OpenACC clause/directive: wait [(integer-expression-list)]. */
+ OMP_CLAUSE_WAIT,
+
+ /* Internal structure to hold OpenACC cache directive's variable-list.
+ #pragma acc cache (variable-list). */
+ OMP_NO_CLAUSE_CACHE,
+
/* Internal clause: temporary for combined loops expansion. */
OMP_CLAUSE__LOOPTEMP_,
- /* OpenMP clause: if (scalar-expression). */
+ /* OpenMP/OpenACC clause: if (scalar-expression). */
OMP_CLAUSE_IF,
/* OpenMP clause: num_threads (integer-expression). */
@@ -281,12 +308,13 @@ enum omp_clause_code {
OMP_CLAUSE_NOWAIT,
/* OpenMP clause: ordered. */
+ /* OpenACC clause: seq. */
OMP_CLAUSE_ORDERED,
/* OpenMP clause: default. */
OMP_CLAUSE_DEFAULT,
- /* OpenMP clause: collapse (constant-integer-expression). */
+ /* OpenMP/OpenACC clause: collapse (constant-integer-expression). */
OMP_CLAUSE_COLLAPSE,
/* OpenMP clause: untied. */
@@ -338,7 +366,28 @@ enum omp_clause_code {
OMP_CLAUSE_TASKGROUP,
/* Internally used only clause, holding SIMD uid. */
- OMP_CLAUSE__SIMDUID_
+ OMP_CLAUSE__SIMDUID_,
+
+ /* OpenACC clause: independent. */
+ OMP_CLAUSE_INDEPENDENT,
+
+ /* OpenACC clause: async [(integer-expression)]. */
+ OMP_CLAUSE_ASYNC,
+
+ /* OpenACC clause: worker [( [num:] integer-expression)]. */
+ OMP_CLAUSE_WORKER,
+
+ /* OpenACC clause: vector [( [length:] integer-expression)]. */
+ OMP_CLAUSE_VECTOR,
+
+ /* OpenACC clause: num_gangs (integer-expression). */
+ OMP_CLAUSE_NUM_GANGS,
+
+ /* OpenACC clause: num_workers (integer-expression). */
+ OMP_CLAUSE_NUM_WORKERS,
+
+ /* OpenACC clause: vector_length (integer-expression). */
+ OMP_CLAUSE_VECTOR_LENGTH
};
#undef DEFTREESTRUCT
diff --git a/gcc/tree-pretty-print.c b/gcc/tree-pretty-print.c
index 5a87728..5c9e249 100644
--- a/gcc/tree-pretty-print.c
+++ b/gcc/tree-pretty-print.c
@@ -326,6 +326,21 @@ dump_omp_clause (pretty_printer *buffer, tree clause, int spc, int flags)
case OMP_CLAUSE__LOOPTEMP_:
name = "_looptemp_";
goto print_remap;
+ case OMP_CLAUSE_HOST:
+ name = "host";
+ goto print_remap;
+ case OMP_CLAUSE_OACC_DEVICE:
+ name = "device";
+ goto print_remap;
+ case OMP_CLAUSE_DEVICE_RESIDENT:
+ name = "device_resident";
+ goto print_remap;
+ case OMP_CLAUSE_USE_DEVICE:
+ name = "use_device";
+ goto print_remap;
+ case OMP_NO_CLAUSE_CACHE:
+ name = "_cache_";
+ goto print_remap;
print_remap:
pp_string (buffer, name);
pp_left_paren (buffer);
@@ -634,6 +649,62 @@ dump_omp_clause (pretty_printer *buffer, tree clause, int spc, int flags)
pp_right_paren (buffer);
break;
+ case OMP_CLAUSE_GANG:
+ pp_string (buffer, "gang(");
+ dump_generic_node (buffer, OMP_CLAUSE_DECL (clause), spc, flags, false);
+ pp_character(buffer, ')');
+ break;
+
+ case OMP_CLAUSE_WAIT:
+ pp_string (buffer, "wait(");
+ dump_generic_node (buffer, OMP_CLAUSE_DECL (clause), spc, flags, false);
+ pp_character(buffer, ')');
+ break;
+
+ case OMP_CLAUSE_ASYNC:
+ pp_string (buffer, "async");
+ if (OMP_CLAUSE_DECL (clause))
+ {
+ pp_character(buffer, '(');
+ dump_generic_node (buffer, OMP_CLAUSE_DECL (clause),
+ spc, flags, false);
+ pp_character(buffer, ')');
+ }
+ break;
+
+ case OMP_CLAUSE_WORKER:
+ pp_string (buffer, "worker(");
+ dump_generic_node (buffer, OMP_CLAUSE_DECL (clause), spc, flags, false);
+ pp_character(buffer, ')');
+ break;
+
+ case OMP_CLAUSE_VECTOR:
+ pp_string (buffer, "vector(");
+ dump_generic_node (buffer, OMP_CLAUSE_DECL (clause), spc, flags, false);
+ pp_character(buffer, ')');
+ break;
+
+ case OMP_CLAUSE_NUM_GANGS:
+ pp_string (buffer, "num_gangs(");
+ dump_generic_node (buffer, OMP_CLAUSE_NUM_GANGS_EXPR (clause),
+ spc, flags, false);
+ pp_character (buffer, ')');
+ break;
+
+ case OMP_CLAUSE_NUM_WORKERS:
+ pp_string (buffer, "num_workers(");
+ dump_generic_node (buffer, OMP_CLAUSE_NUM_WORKERS_EXPR (clause),
+ spc, flags, false);
+ pp_character (buffer, ')');
+ break;
+
+ case OMP_CLAUSE_VECTOR_LENGTH:
+ pp_string (buffer, "vector_length(");
+ dump_generic_node (buffer, OMP_CLAUSE_VECTOR_LENGTH_EXPR (clause),
+ spc, flags, false);
+ pp_character (buffer, ')');
+ break;
+
case OMP_CLAUSE_INBRANCH:
pp_string (buffer, "inbranch");
break;
@@ -652,6 +723,9 @@ dump_omp_clause (pretty_printer *buffer, tree clause, int spc, int flags)
case OMP_CLAUSE_TASKGROUP:
pp_string (buffer, "taskgroup");
break;
+ case OMP_CLAUSE_INDEPENDENT:
+ pp_string (buffer, "independent");
+ break;
default:
/* Should never happen. */
@@ -2384,6 +2458,51 @@ dump_generic_node (pretty_printer *buffer, tree node, int spc, int flags,
dump_omp_clauses (buffer, OACC_PARALLEL_CLAUSES (node), spc, flags);
goto dump_omp_body;
+ case OACC_KERNELS:
+ pp_string (buffer, "#pragma acc kernels");
+ dump_omp_clauses (buffer, OACC_KERNELS_CLAUSES (node), spc, flags);
+ goto dump_omp_body;
+
+ case OACC_DATA:
+ pp_string (buffer, "#pragma acc data");
+ dump_omp_clauses (buffer, OACC_DATA_CLAUSES (node), spc, flags);
+ goto dump_omp_body;
+
+ case OACC_HOST_DATA:
+ pp_string (buffer, "#pragma acc host_data");
+ dump_omp_clauses (buffer, OACC_HOST_DATA_CLAUSES (node), spc, flags);
+ goto dump_omp_body;
+
+ case OACC_DECLARE:
+ pp_string (buffer, "#pragma acc declare");
+ dump_omp_clauses (buffer, OACC_DECLARE_CLAUSES (node), spc, flags);
+ break;
+
+ case OACC_UPDATE:
+ pp_string (buffer, "#pragma acc update");
+ dump_omp_clauses (buffer, OACC_UPDATE_CLAUSES (node), spc, flags);
+ break;
+
+ case OACC_ENTER_DATA:
+ pp_string (buffer, "#pragma acc enter data");
+ dump_omp_clauses (buffer, OACC_ENTER_DATA_CLAUSES (node), spc, flags);
+ break;
+
+ case OACC_EXIT_DATA:
+ pp_string (buffer, "#pragma acc exit data");
+ dump_omp_clauses (buffer, OACC_EXIT_DATA_CLAUSES (node), spc, flags);
+ break;
+
+ case OACC_WAIT:
+ pp_string (buffer, "#pragma acc wait");
+ dump_omp_clauses (buffer, OACC_WAIT_CLAUSES (node), spc, flags);
+ break;
+
+ case OACC_CACHE:
+ pp_string (buffer, "#pragma acc cache");
+ dump_omp_clauses (buffer, OACC_CACHE_CLAUSES(node), spc, flags);
+ break;
+
case OMP_PARALLEL:
pp_string (buffer, "#pragma omp parallel");
dump_omp_clauses (buffer, OMP_PARALLEL_CLAUSES (node), spc, flags);
diff --git a/gcc/tree.c b/gcc/tree.c
index 76e3efb..95df2a3 100644
--- a/gcc/tree.c
+++ b/gcc/tree.c
@@ -259,6 +259,13 @@ unsigned const char omp_clause_num_ops[] =
2, /* OMP_CLAUSE_FROM */
2, /* OMP_CLAUSE_TO */
2, /* OMP_CLAUSE_MAP */
+ 1, /* OMP_CLAUSE_HOST */
+ 1, /* OMP_CLAUSE_OACC_DEVICE */
+ 1, /* OMP_CLAUSE_DEVICE_RESIDENT */
+ 1, /* OMP_CLAUSE_USE_DEVICE */
+ 1, /* OMP_CLAUSE_GANG */
+ 1, /* OMP_CLAUSE_WAIT */
+ 1, /* OMP_NO_CLAUSE_CACHE */
1, /* OMP_CLAUSE__LOOPTEMP_ */
1, /* OMP_CLAUSE_IF */
1, /* OMP_CLAUSE_NUM_THREADS */
@@ -284,6 +291,13 @@ unsigned const char omp_clause_num_ops[] =
0, /* OMP_CLAUSE_SECTIONS */
0, /* OMP_CLAUSE_TASKGROUP */
1, /* OMP_CLAUSE__SIMDUID_ */
+ 0, /* OMP_CLAUSE_INDEPENDENT */
+ 1, /* OMP_CLAUSE_ASYNC */
+ 1, /* OMP_CLAUSE_WORKER */
+ 1, /* OMP_CLAUSE_VECTOR */
+ 1, /* OMP_CLAUSE_NUM_GANGS */
+ 1, /* OMP_CLAUSE_NUM_WORKERS */
+ 1, /* OMP_CLAUSE_VECTOR_LENGTH */
};
const char * const omp_clause_code_name[] =
@@ -303,6 +317,13 @@ const char * const omp_clause_code_name[] =
"from",
"to",
"map",
+ "host",
+ "device",
+ "device_resident",
+ "use_device",
+ "gang",
+ "wait",
+ "_cache_",
"_looptemp_",
"if",
"num_threads",
@@ -327,7 +348,14 @@ const char * const omp_clause_code_name[] =
"parallel",
"sections",
"taskgroup",
- "_simduid_"
+ "_simduid_",
+ "independent",
+ "async",
+ "worker",
+ "vector",
+ "num_gangs",
+ "num_workers",
+ "vector_length"
};
@@ -11034,6 +11062,19 @@ walk_tree_1 (tree *tp, walk_tree_fn func, void *data,
case OMP_CLAUSE:
switch (OMP_CLAUSE_CODE (*tp))
{
+ case OMP_CLAUSE_HOST:
+ case OMP_CLAUSE_OACC_DEVICE:
+ case OMP_CLAUSE_DEVICE_RESIDENT:
+ case OMP_CLAUSE_USE_DEVICE:
+ case OMP_CLAUSE_GANG:
+ case OMP_CLAUSE_WAIT:
+ case OMP_NO_CLAUSE_CACHE:
+ case OMP_CLAUSE_ASYNC:
+ case OMP_CLAUSE_WORKER:
+ case OMP_CLAUSE_VECTOR:
+ case OMP_CLAUSE_NUM_GANGS:
+ case OMP_CLAUSE_NUM_WORKERS:
+ case OMP_CLAUSE_VECTOR_LENGTH:
case OMP_CLAUSE_PRIVATE:
case OMP_CLAUSE_SHARED:
case OMP_CLAUSE_FIRSTPRIVATE:
@@ -11056,6 +11097,7 @@ walk_tree_1 (tree *tp, walk_tree_fn func, void *data,
WALK_SUBTREE (OMP_CLAUSE_OPERAND (*tp, 0));
/* FALLTHRU */
+ case OMP_CLAUSE_INDEPENDENT:
case OMP_CLAUSE_NOWAIT:
case OMP_CLAUSE_ORDERED:
case OMP_CLAUSE_DEFAULT:
diff --git a/gcc/tree.def b/gcc/tree.def
index b921b12..623ebb0 100644
--- a/gcc/tree.def
+++ b/gcc/tree.def
@@ -1017,6 +1017,24 @@ DEFTREECODE (MEM_REF, "mem_ref", tcc_reference, 2)
DEFTREECODE (OACC_PARALLEL, "oacc_parallel", tcc_statement, 2)
+/* OpenACC - #pragma acc kernels [clause1 ... clauseN]
+ Operand 0: OACC_KERNELS_BODY: Sequence of kernels.
+ Operand 1: OACC_KERNELS_CLAUSES: List of clauses. */
+
+DEFTREECODE (OACC_KERNELS, "oacc_kernels", tcc_statement, 2)
+
+/* OpenACC - #pragma acc data [clause1 ... clauseN]
+ Operand 0: OACC_DATA_BODY: Data construct body.
+ Operand 1: OACC_DATA_CLAUSES: List of clauses. */
+
+DEFTREECODE (OACC_DATA, "oacc_data", tcc_statement, 2)
+
+/* OpenACC - #pragma acc host_data [clause1 ... clauseN]
+ Operand 0: OACC_HOST_DATA_BODY: Host_data construct body.
+ Operand 1: OACC_HOST_DATA_CLAUSES: List of clauses. */
+
+DEFTREECODE (OACC_HOST_DATA, "oacc_host_data", tcc_statement, 2)
+
/* OpenMP - #pragma omp parallel [clause1 ... clauseN]
Operand 0: OMP_PARALLEL_BODY: Code to be executed by all threads.
Operand 1: OMP_PARALLEL_CLAUSES: List of clauses. */
@@ -1108,6 +1126,30 @@ DEFTREECODE (OMP_ORDERED, "omp_ordered", tcc_statement, 1)
Operand 1: OMP_CRITICAL_NAME: Identifier for critical section. */
DEFTREECODE (OMP_CRITICAL, "omp_critical", tcc_statement, 2)
+/* OpenACC - #pragma acc declare [clause1 ... clauseN]
+ Operand 0: OACC_DECLARE_CLAUSES: List of clauses. */
+DEFTREECODE (OACC_DECLARE, "oacc_declare", tcc_statement, 1)
+
+/* OpenACC - #pragma acc update [clause1 ... clauseN]
+ Operand 0: OACC_UPDATE_CLAUSES: List of clauses. */
+DEFTREECODE (OACC_UPDATE, "oacc_update", tcc_statement, 1)
+
+/* OpenACC - #pragma acc enter data [clause1 ... clauseN]
+ Operand 0: OACC_ENTER_DATA_CLAUSES: List of clauses. */
+DEFTREECODE (OACC_ENTER_DATA, "oacc_enter_data", tcc_statement, 1)
+
+/* OpenACC - #pragma acc exit data [clause1 ... clauseN]
+ Operand 0: OACC_EXIT_DATA_CLAUSES: List of clauses. */
+DEFTREECODE (OACC_EXIT_DATA, "oacc_exit_data", tcc_statement, 1)
+
+/* OpenACC - #pragma acc wait [clause1 ... clauseN]
+ Operand 0: OACC_WAIT_CLAUSES: List of clauses. */
+DEFTREECODE (OACC_WAIT, "oacc_wait", tcc_statement, 1)
+
+/* OpenACC - #pragma acc cache [clause1 ... clauseN]
+ Operand 0: OACC_CACHE_CLAUSES: List of clauses. */
+DEFTREECODE (OACC_CACHE, "oacc_cache", tcc_statement, 1)
+
/* OpenMP - #pragma omp target update [clause1 ... clauseN]
Operand 0: OMP_TARGET_UPDATE_CLAUSES: List of clauses. */
DEFTREECODE (OMP_TARGET_UPDATE, "omp_target_update", tcc_statement, 1)
diff --git a/gcc/tree.h b/gcc/tree.h
index 202ad9e..dd90cde 100644
--- a/gcc/tree.h
+++ b/gcc/tree.h
@@ -1155,7 +1155,7 @@ extern void protected_set_expr_location (tree, location_t);
#define TRANSACTION_EXPR_RELAXED(NODE) \
(TRANSACTION_EXPR_CHECK (NODE)->base.public_flag)
-/* OpenMP directive and clause accessors. */
+/* OpenMP and OpenACC directive and clause accessors. */
#define OMP_BODY(NODE) \
TREE_OPERAND (TREE_RANGE_CHECK (NODE, OACC_PARALLEL, OMP_CRITICAL), 0)
@@ -1167,6 +1167,39 @@ extern void protected_set_expr_location (tree, location_t);
#define OACC_PARALLEL_CLAUSES(NODE) \
TREE_OPERAND (OACC_PARALLEL_CHECK (NODE), 1)
+#define OACC_KERNELS_BODY(NODE) \
+ TREE_OPERAND (OACC_KERNELS_CHECK(NODE), 0)
+#define OACC_KERNELS_CLAUSES(NODE) \
+ TREE_OPERAND (OACC_KERNELS_CHECK(NODE), 1)
+
+#define OACC_DATA_BODY(NODE) \
+ TREE_OPERAND (OACC_DATA_CHECK (NODE), 0)
+#define OACC_DATA_CLAUSES(NODE) \
+ TREE_OPERAND (OACC_DATA_CHECK (NODE), 1)
+
+#define OACC_HOST_DATA_BODY(NODE) \
+ TREE_OPERAND (OACC_HOST_DATA_CHECK (NODE), 0)
+#define OACC_HOST_DATA_CLAUSES(NODE) \
+ TREE_OPERAND (OACC_HOST_DATA_CHECK (NODE), 1)
+
+#define OACC_DECLARE_CLAUSES(NODE) \
+ TREE_OPERAND (OACC_DECLARE_CHECK (NODE), 0)
+
+#define OACC_ENTER_DATA_CLAUSES(NODE) \
+ TREE_OPERAND (OACC_ENTER_DATA_CHECK (NODE), 0)
+
+#define OACC_EXIT_DATA_CLAUSES(NODE) \
+ TREE_OPERAND (OACC_EXIT_DATA_CHECK (NODE), 0)
+
+#define OACC_UPDATE_CLAUSES(NODE) \
+ TREE_OPERAND (OACC_UPDATE_CHECK (NODE), 0)
+
+#define OACC_WAIT_CLAUSES(NODE) \
+ TREE_OPERAND (OACC_WAIT_CHECK (NODE), 0)
+
+#define OACC_CACHE_CLAUSES(NODE) \
+ TREE_OPERAND (OACC_CACHE_CHECK (NODE), 0)
+
#define OMP_PARALLEL_BODY(NODE) TREE_OPERAND (OMP_PARALLEL_CHECK (NODE), 0)
#define OMP_PARALLEL_CLAUSES(NODE) TREE_OPERAND (OMP_PARALLEL_CHECK (NODE), 1)
@@ -1278,6 +1311,32 @@ extern void protected_set_expr_location (tree, location_t);
#define OMP_CLAUSE_SCHEDULE_CHUNK_EXPR(NODE) \
OMP_CLAUSE_OPERAND (OMP_CLAUSE_SUBCODE_CHECK (NODE, OMP_CLAUSE_SCHEDULE), 0)
+/* OpenACC clause expressions */
+#define OMP_CLAUSE_GANG_EXPR(NODE) \
+ OMP_CLAUSE_OPERAND ( \
+ OMP_CLAUSE_SUBCODE_CHECK (NODE, OMP_CLAUSE_GANG), 0)
+#define OMP_WAIT_EXPR(NODE) \
+ OMP_CLAUSE_OPERAND ( \
+ OMP_CLAUSE_SUBCODE_CHECK (NODE, OMP_CLAUSE_WAIT), 0)
+#define OMP_CLAUSE_VECTOR_EXPR(NODE) \
+ OMP_CLAUSE_OPERAND ( \
+ OMP_CLAUSE_SUBCODE_CHECK (NODE, OMP_CLAUSE_VECTOR_LENGTH), 0)
+#define OMP_CLAUSE_ASYNC_EXPR(NODE) \
+ OMP_CLAUSE_OPERAND ( \
+ OMP_CLAUSE_SUBCODE_CHECK (NODE, OMP_CLAUSE_ASYNC), 0)
+#define OMP_CLAUSE_WORKER_EXPR(NODE) \
+ OMP_CLAUSE_OPERAND ( \
+ OMP_CLAUSE_SUBCODE_CHECK (NODE, OMP_CLAUSE_WORKER), 0)
+#define OMP_CLAUSE_NUM_GANGS_EXPR(NODE) \
+ OMP_CLAUSE_OPERAND ( \
+ OMP_CLAUSE_SUBCODE_CHECK (NODE, OMP_CLAUSE_NUM_GANGS), 0)
+#define OMP_CLAUSE_NUM_WORKERS_EXPR(NODE) \
+ OMP_CLAUSE_OPERAND ( \
+ OMP_CLAUSE_SUBCODE_CHECK (NODE, OMP_CLAUSE_NUM_WORKERS), 0)
+#define OMP_CLAUSE_VECTOR_LENGTH_EXPR(NODE) \
+ OMP_CLAUSE_OPERAND ( \
+ OMP_CLAUSE_SUBCODE_CHECK (NODE, OMP_CLAUSE_VECTOR_LENGTH), 0)
+
#define OMP_CLAUSE_DEPEND_KIND(NODE) \
(OMP_CLAUSE_SUBCODE_CHECK (NODE, OMP_CLAUSE_DEPEND)->omp_clause.subcode.depend_kind)
--
1.8.3.2
[-- Attachment #3: ChangeLog --]
[-- Type: text/plain, Size: 1912 bytes --]
13-02-2014 Ilmir Usmanov <i.usmanov@samsung.com>
Add OpenACC 1.0 support to GENERIC, except loop directive and subarrays.
Dmitry Bocharnikov <dmitry.b@samsung.com>
Evgeny Gavrin <e.gavrin@samsung.com>
Ilmir Usmanov <i.usmanov@samsung.com>
gcc/
* gimplify.c (is_gimple_stmt): Stub OpenACC directives and clauses.
(gimplify_scan_omp_clauses, gimplify_adjust_omp_clauses): Likewise.
(gimplify_expr): Likewise.
* omp-low.c (scan_sharing_clauses): Likewise.
(gimple_code_is_oacc): New helper function.
(scan_sharing_clauses): Use it.
* tree-core.h
(OMP_CLAUSE_HOST, OMP_CLAUSE_OACC_DEVICE, OMP_CLAUSE_DEVICE_RESIDENT,
OMP_CLAUSE_USE_DEVICE, OMP_CLAUSE_GANG, OMP_CLAUSE_WAIT,
OMP_NO_CLAUSE_CACHE, OMP_CLAUSE_INDEPENDENT, OMP_CLAUSE_ASYNC,
OMP_CLAUSE_WORKER, OMP_CLAUSE_VECTOR, OMP_CLAUSE_NUM_GANGS,
OMP_CLAUSE_NUM_WORKERS, OMP_CLAUSE_VECTOR_LENGTH): New clauses.
* tree-pretty-print.c (dump_omp_clause): Print OpenACC clause.
(dump_generic_node): Print OpenACC directives and its clauses.
* tree.c (omp_clause_num_ops): Add OpenACC clauses.
(omp_clause_code_name): Likewise.
(walk_tree_1): Likewise.
* tree.def (OACC_KERNELS): New tree node.
(OACC_DATA, OACC_HOST_DATA, OACC_DECLARE, OACC_UPDATE): Likewise.
(OACC_ENTER_DATA, OACC_EXIT_DATA, OACC_WAIT, OACC_CACHE): Likewise.
* tree.h (OACC_KERNELS_BODY): New macros.
(OACC_KERNELS_CLAUSES, OACC_CLAUSE_NUM_GANGS_EXPR,
OMP_CLAUSE_NUM_WORKERS_EXPR, OMP_CLAUSE_VECTOR_LENGTH_EXPR,
OMP_CLAUSE_VECTOR_EXPR, OMP_CLAUSE_WORKER_EXPR, OMP_CLAUSE_GANG_EXPR,
OMP_CLAUSE_ASYNC_EXPR, OMP_WAIT_EXPR, OACC_DATA_BODY, OACC_DATA_CLAUSES,
OACC_DECLARE_CLAUSES, OACC_UPDATE_CLAUSES, OACC_WAIT_CLAUSES,
OACC_CACHE_CLAUSES, OACC_HOST_DATA_BODY,
OACC_HOST_DATA_CLAUSES): Likewise.
gcc/doc/
* generic.texi: Document OACC_KERNELS, OACC_DATA, OACC_HOST_DATA,
OACC_DECLARE, OACC_UPDATE, OACC_ENTER_DATA, OACC_EXIT_DATA, OACC_WAIT,
OACC_CACHE.
^ permalink raw reply [flat|nested] 89+ messages in thread
* Re: [PATCH 4/6] [GOMP4] OpenACC 1.0+ support in fortran front-end
2014-02-13 13:15 ` Ilmir Usmanov
@ 2014-02-13 14:57 ` Thomas Schwinge
2014-02-14 5:45 ` Ilmir Usmanov
0 siblings, 1 reply; 89+ messages in thread
From: Thomas Schwinge @ 2014-02-13 14:57 UTC (permalink / raw)
To: Ilmir Usmanov
Cc: Evgeny Gavrin, GarbuzovViacheslav, Dmitri Botcharnikov,
gcc-patches, jakub, fortran
[-- Attachment #1: Type: text/plain, Size: 2063 bytes --]
Hi Ilmir!
On Thu, 13 Feb 2014 17:15:47 +0400, Ilmir Usmanov <i.usmanov@samsung.com> wrote:
> I fixed patch according to your review and ready to commit it. OK for
> GOMP4 branch?
Yes! :-) Congratulations, and thanks for promptly addressing the issues
raised during review. I'm aware this can be a bit of a boring or tedious
process, but in the end, the code quality will be higher (well, that's
the idea about code review), and certainly you'll have learned some
things, too (and I have, too), and so next time this process will likely
be faster.
Only a few minor comments about the ChangeLog formatting:
> 13-02-2014 Ilmir Usmanov <i.usmanov@samsung.com>
YYYY-MM-DD is the format used in ChangeLogs.
> Add OpenACC 1.0 support to GENERIC, except loop directive and subarrays.
>
> Dmitry Bocharnikov <dmitry.b@samsung.com>
> Evgeny Gavrin <e.gavrin@samsung.com>
> Ilmir Usmanov <i.usmanov@samsung.com>
For multiple authors, do it like this:
2014-02-13 Ilmir Usmanov <i.usmanov@samsung.com>
Dmitry Bocharnikov <dmitry.b@samsung.com>
Evgeny Gavrin <e.gavrin@samsung.com>
|> gcc/
|> * gimplify.c (is_gimple_stmt): Stub OpenACC directives and clauses.
|> (gimplify_scan_omp_clauses, gimplify_adjust_omp_clauses): Likewise.
|> (gimplify_expr): Likewise.
(I don't care, but) you can also do it as follows, a bit simpler:
* [file] ([item 1], [item 2], [...]): [text].
|> * tree-core.h
|> (OMP_CLAUSE_HOST, OMP_CLAUSE_OACC_DEVICE, OMP_CLAUSE_DEVICE_RESIDENT,
|> OMP_CLAUSE_USE_DEVICE, OMP_CLAUSE_GANG, OMP_CLAUSE_WAIT,
|> OMP_NO_CLAUSE_CACHE, OMP_CLAUSE_INDEPENDENT, OMP_CLAUSE_ASYNC,
|> OMP_CLAUSE_WORKER, OMP_CLAUSE_VECTOR, OMP_CLAUSE_NUM_GANGS,
|> OMP_CLAUSE_NUM_WORKERS, OMP_CLAUSE_VECTOR_LENGTH): New clauses.
As the enum omp_clause_code is the thing that you modify, that would be:
* tree-core.h (enum omp_clause_code): Add OMP_CLAUSE_HOST, [...].
Or, as other people do:
* tree-core.h (omp_clause_code): Add OMP_CLAUSE_HOST, [...].
Grüße,
Thomas
[-- Attachment #2: Type: application/pgp-signature, Size: 489 bytes --]
^ permalink raw reply [flat|nested] 89+ messages in thread
* Re: [PATCH 4/6] [GOMP4] OpenACC 1.0+ support in fortran front-end
2014-02-13 14:57 ` Thomas Schwinge
@ 2014-02-14 5:45 ` Ilmir Usmanov
0 siblings, 0 replies; 89+ messages in thread
From: Ilmir Usmanov @ 2014-02-14 5:45 UTC (permalink / raw)
To: Thomas Schwinge
Cc: Evgeny Gavrin, GarbuzovViacheslav, Dmitri Botcharnikov,
gcc-patches, jakub, fortran
Committed as r207776.
--
Ilmir.
^ permalink raw reply [flat|nested] 89+ messages in thread
* Re: [PATCH 1/6] [GOMP4] OpenACC 1.0+ support in fortran front-end
2014-02-09 22:22 ` Tobias Burnus
@ 2014-02-19 15:34 ` Ilmir Usmanov
2014-02-19 23:52 ` Tobias Burnus
0 siblings, 1 reply; 89+ messages in thread
From: Ilmir Usmanov @ 2014-02-19 15:34 UTC (permalink / raw)
To: Tobias Burnus, Thomas Schwinge
Cc: Evgeny Gavrin, GarbuzovViacheslav, Dmitri Botcharnikov,
gcc-patches, jakub, fortran
Hi Tobias!
Thanks a lot for your review!
I have tested your notes on two compilers which support OpenACC: PGI
14.1 and CAPS 3.4.1.
If I made a mistake and you've collected results which differ from mine
(whether you compiler is one of the above or not), please, let me know.
Unfortunally, neither PGI nor CAPS don't support Fortran 2008.
These are results:
On 10.02.2014 02:22, Tobias Burnus wrote:
>
> a) Does this part work well when both -fopenmp and -fopenacc is used?
> I mean: "!$acc loop" followed/preceded by "!$omp do"? I could imagine
> that there could be clashes, especially when - e.g. - collapse doesn't
> match.
PGI: Silently ignores OpenMP pragmas.
CAPS: Ignored option '--define' (_OPENMP=).
>
> b) Do you also handle DO CONCURRENT - either by rejecting it or by
> accepting it? Namely,
>
> !$acc loop
> do concurrent(i=1:5)
> end do
> !$acc end loop
> end
> Side remark, with -fopenmp, it does ICE:
> http://gcc.gnu.org/bugzilla/show_bug.cgi?id=60127
>
My implemetation also fails, will fix.
By the way, should we support these loops? I think we should, since DO
CONCURRENT loops are parallelizable.
>
> Talking about "!$acc loop": I vaguely remember that OpenACC 1.0's spec
> doesn't have "!$acc end loop" while I have seen OpenACC programs which
> use it. How do you handle "!$acc end loop"?
> Looking at parse.c, it seems to simply error out. I wonder whether one
> should be a bit more graceful. For instance, the following examples
> use "!$acc end loop":
> http://devblogs.nvidia.com/parallelforall/openacc-example-part-2/ [If
> I remember correctly, pgf95 and Cray ftn silently accepts "end loop"
> while pathf95 accepts it with a warning.]
>
> And looking at the spec of OpenACC 1.0 and 2.0a, the "end loop" seems
> to be invalid. How about following PathScale's ENZO and accepting "end
> loop" with a warning? Or at least error out with a good error message.
>
No, the spec doesn't specify !$acc end loop. However, compilers handle
this construction differently:
PGI: silently accepts.
CAPS: Syntax error: expecting ('parallel' ('loop' or end)) or
(('kernels' or 'dfkernels') ('loop' or end)) or 'data' or 'host_data'
!$acc end loop
My implementation also errors out, but I agree, we should accept this
with warning.
>
>> + if (gfc_pure (NULL))
>> + {
>> + gfc_error_now ("OpenACC directives at %C may not appear in PURE "
>> + "or ELEMENTAL procedures");
>
> Using gfc_pure() you do not check for ELEMENTAL: Since Fortran 2008,
> there are also IMPURE ELEMENTAL procedures. I don't know the spec, but
> I don't really see a reason why OpenACC shouldn't be permitted in
> IMPURE ELEMENTAL procedures. (BTW: "ELEMENTAL" implies PURE unless an
> explicit IMPURE is used.)
>
> In any case, either drop "or ELEMENTAL" or also check for the
> elemental attribute.
>
I think I should drop "or ELEMENTAL" since OpenMP also accepts
directives in IMPURE ELEMENTAL procecdures.
>> + if (gfc_implicit_pure (NULL))
>> + gfc_current_ns->proc_name->attr.implicit_pure = 0;
>
> I believe that will fail with BLOCK - cf. gfc_implicit_pure()
>
> real function foo(n)
> integer, value :: n
> BLOCK
> integer i
> real sum
> !$acc loop reduce(+:sum)
> do i=1, n
> sum += sin(real(i))
> end do
> END BLOCK
> end
>
Fortunally, it doesn't.
--
Ilmir.
^ permalink raw reply [flat|nested] 89+ messages in thread
* Re: [PATCH 2/6] [GOMP4] OpenACC 1.0+ support in fortran front-end
2014-02-09 23:10 ` [PATCH 2/6] " Tobias Burnus
2014-02-10 9:10 ` Thomas Schwinge
@ 2014-02-19 16:43 ` Ilmir Usmanov
1 sibling, 0 replies; 89+ messages in thread
From: Ilmir Usmanov @ 2014-02-19 16:43 UTC (permalink / raw)
To: Tobias Burnus, Thomas Schwinge
Cc: Evgeny Gavrin, GarbuzovViacheslav, Dmitri Botcharnikov,
gcc-patches, jakub, fortran
Hi Tobias!
On 10.02.2014 03:10, Tobias Burnus wrote:
> Shouldn't you also reject polymorphic types ("BT_CLASS" and
> "BT_ASSUMED")? [BT_CLASS = "class(derived_type_name)" or "class(*)";
> BT_ASSUMED = "type(*)"]
>
>> + if (n->sym->attr.pointer)
>> + gfc_error ("POINTER object '%s' in %s clause at %L",
>> + n->sym->name, name, &code->loc);
>
> Actually, here and probably elsewhere: Do you need to take care of
> derived-type components? I mean something like
> clause(derived_type%comp)
>
> Do you also need to reject AS_ASSUMED_RANK (new since Fortran
> Technical Specification ISO/IEC TS 29113:2012)? I mean code like:
>
> subroutine foo(x)
> integer, DIMENSION(..) :: x
> ... openacc_clause(x)
>
> Side note: One should also check how OpenMP handles those.
>
I think we should reject assumed size, assumed shape and assumed rank
variables, as OpenMP does.
>> + case OMP_LIST_DEVICEPTR:
>> + if (n->sym->attr.pointer)
>> + gfc_error ("POINTER object '%s' in %s clause at %L",
>> + n->sym->name, name, &code->loc);
>
> Talking about pointers, you probably also want to reject Cray pointers
> (attr.cray_pointee - and cray_pointee). [One should also check what
> OpenMP does; I think it does handle it correctly.]
>
I agree, currently my implementation does not handle Cray pointers
correctly, will fix.
> And another point: I think you have to check whether the argument is a
> named constant (PARAMETER, attr.flavor == FL_PARAMETER), I think those
> you cannot put them there either.
>
> What happens if you try to use a literal such as "deviceptr(5)"?
>
Both parameter and literal are rejected.
By the way, PGI compiler accepts parameters with warning, CAPS silently
accepts. I think, we also should support parameters with warning.
>
>> + resolve_oacc_positive_int_expr (el->expr, "TILE");
>> + if (el->expr->expr_type != EXPR_CONSTANT)
>> + gfc_error ("TILE requires constant expression at %L",
>> &code->loc);
>
> Is the following permitted: "tile(4+5)"? If so, do you need to call
> gfc_simplify_expr() as some point? (Or is this already done at some
> point?)
>
Yes, the syntax is allowed, but ...
CAPSCompilers-3.4.1/bin/hmpp: [Error HP0112] tile.f95:30: Syntax error:
expecting ')'
!$acc parallel loop collapse(1+ 1)
CAPS compiler doesn't support this. But PGI does.
There is no need to simplify expression since it is constant anyway. The
simplification is done during match stage (gfc_match_expr calls gfc_add).
--
Ilmir.
^ permalink raw reply [flat|nested] 89+ messages in thread
* Re: [PATCH 1/6] [GOMP4] OpenACC 1.0+ support in fortran front-end
2014-02-19 15:34 ` Ilmir Usmanov
@ 2014-02-19 23:52 ` Tobias Burnus
2014-02-20 8:19 ` Ilmir Usmanov
0 siblings, 1 reply; 89+ messages in thread
From: Tobias Burnus @ 2014-02-19 23:52 UTC (permalink / raw)
To: Ilmir Usmanov, Thomas Schwinge
Cc: Evgeny Gavrin, GarbuzovViacheslav, Dmitri Botcharnikov,
gcc-patches, jakub, fortran
Hi Ilmir,
thanks for your reply; I am looking forward to your updated patch.
Ilmir Usmanov wrote:
> I have tested your notes on two compilers which support OpenACC: PGI
> 14.1 and CAPS 3.4.1.
I can add Cray ftn results, if you want me to cross-check something.
> On 10.02.2014 02:22, Tobias Burnus wrote:
>>
>> a) Does this part work well when both -fopenmp and -fopenacc is used?
>> I mean: "!$acc loop" followed/preceded by "!$omp do"? I could imagine
>> that there could be clashes, especially when - e.g. - collapse
>> doesn't match.
> PGI: Silently ignores OpenMP pragmas.
> CAPS: Ignored option '--define' (_OPENMP=).
I like how Cray handles it: It permits both - but neither OpenMP ->
OpenACC nesting nor vice versa. (It might not always detectable.)
ERROR:
The !$OMP PARALLEL DO directive cannot be specified within a !$ACC
PARALLEL region.
And adding OpenACC to an OpenMP loop fails with:
ERROR:
The !$ACC LOOP directive cannot be specified within a !$OMP PARALLEL
DO region.
(One gets the same error independent whether one tries to place the
pragma on the same loop or just nested in the parallel pragma or on
different loops.)
I think doing likewise would be best. A simpler approach is to reject
using -fopenmp and -fopenacc simultaneously.
>> b) Do you also handle DO CONCURRENT - either by rejecting it or by
>> accepting it? Namely,
>>
>> !$acc loop
>> do concurrent(i=1:5)
>> end do
>> !$acc end loop
>> end
>> Side remark, with -fopenmp, it does ICE:
>> http://gcc.gnu.org/bugzilla/show_bug.cgi?id=60127
>>
> My implemetation also fails, will fix. By the way, should we support
> these loops? I think we should, since DO CONCURRENT loops are
> parallelizable.
I think one should at least error out and not ICE.
The long-term solution should be to support DO CONCURRENT with both
OpenMP and OpenACC; although one option would be to wait until the specs
officially support it.
If you want to support it, please recall that do concurrent also permits
a mask argument, which makes everything a bit more complicated. (Cf.
gcc/fortran/trans-stmt.c's gfc_trans_forall_1 function.)
> No, the spec doesn't specify !$acc end loop. However, compilers handle
> this construction differently:
> PGI: silently accepts.
Which is not surprising given that NVidia's and PGI's example often use
"!$acc end loop". [Cray ftn also accepts it silently.]
>>> + if (gfc_pure (NULL))
>>> + {
>>> + gfc_error_now ("OpenACC directives at %C may not appear in
>>> PURE "
>>> + "or ELEMENTAL procedures");
...
>> In any case, either drop "or ELEMENTAL" or also check for the
>> elemental attribute.
>>
> I think I should drop "or ELEMENTAL" since OpenMP also accepts
> directives in IMPURE ELEMENTAL procecdures.
Fine with me.
>>> + if (gfc_implicit_pure (NULL))
>>> + gfc_current_ns->proc_name->attr.implicit_pure = 0;
>>
>> I believe that will fail with BLOCK - cf. gfc_implicit_pure()
> Fortunally, it doesn't.
Are you sure that it works? A block starts a new namespace, hence,
gfc_implicit_pure() does:
----------------------cut---------------
/* Check if the current procedure is implicit_pure. Walk up
the procedure list until we find a procedure. */
for (ns = gfc_current_ns; ns; ns = ns->parent)
{
sym = ns->proc_name;
if (sym == NULL)
return 0;
if (sym->attr.flavor == FL_PROCEDURE)
break;
}
}
return sym->attr.flavor == FL_PROCEDURE && sym->attr.implicit_pure
&& !sym->attr.pure;
----------------------cut---------------
But you set "gfc_current_ns->proc_name->attr.implicit_pure = 0". If
gfc_current_ns is the BLOCK, the procedure might still have the
"implict_pure" attribute set.
Side question: Do we also need to unset implicit_pure for OpenMP?
Tobias
^ permalink raw reply [flat|nested] 89+ messages in thread
* Re: [PATCH 1/6] [GOMP4] OpenACC 1.0+ support in fortran front-end
2014-02-19 23:52 ` Tobias Burnus
@ 2014-02-20 8:19 ` Ilmir Usmanov
2014-03-04 7:56 ` [PATCH 1/4] [GOMP4] [Fortran] " Ilmir Usmanov
0 siblings, 1 reply; 89+ messages in thread
From: Ilmir Usmanov @ 2014-02-20 8:19 UTC (permalink / raw)
To: Tobias Burnus, Thomas Schwinge
Cc: Evgeny Gavrin, GarbuzovViacheslav, Dmitri Botcharnikov,
gcc-patches, jakub, fortran
Hi Tobias!
On 20.02.2014 03:51, Tobias Burnus wrote:
>> On 10.02.2014 02:22, Tobias Burnus wrote:
>>>
>>> a) Does this part work well when both -fopenmp and -fopenacc is
>>> used? I mean: "!$acc loop" followed/preceded by "!$omp do"? I could
>>> imagine that there could be clashes, especially when - e.g. -
>>> collapse doesn't match.
>> PGI: Silently ignores OpenMP pragmas.
>> CAPS: Ignored option '--define' (_OPENMP=).
>
> I like how Cray handles it: It permits both - but neither OpenMP ->
> OpenACC nesting nor vice versa. (It might not always detectable.)
>
> ERROR:
> The !$OMP PARALLEL DO directive cannot be specified within a !$ACC
> PARALLEL region.
>
> And adding OpenACC to an OpenMP loop fails with:
>
> ERROR:
> The !$ACC LOOP directive cannot be specified within a !$OMP PARALLEL
> DO region.
>
> (One gets the same error independent whether one tries to place the
> pragma on the same loop or just nested in the parallel pragma or on
> different loops.)
>
> I think doing likewise would be best.
I agree.
>
>>>> + if (gfc_implicit_pure (NULL))
>>>> + gfc_current_ns->proc_name->attr.implicit_pure = 0;
>>>
>>> I believe that will fail with BLOCK - cf. gfc_implicit_pure()
>> Fortunally, it doesn't.
>
> Are you sure that it works? A block starts a new namespace, hence,
> gfc_implicit_pure() does:
>
After your notice about namespaces, I tested !$acc declare attribute.
Viola, it fails. However, other directives work.
>
> Side question: Do we also need to unset implicit_pure for OpenMP?
As you can see in decode_omp_directive function, the flag is already
unset.
--
Ilmir.
^ permalink raw reply [flat|nested] 89+ messages in thread
* [GOMP4] gimple_code_is_oacc -> is_gimple_omp_oacc_specifically (was: [PATCH 4/6] [GOMP4] OpenACC 1.0+ support in fortran front-end)
2014-02-11 16:51 ` [PATCH 4/6] " Thomas Schwinge
2014-02-13 13:15 ` Ilmir Usmanov
@ 2014-02-21 19:29 ` Thomas Schwinge
1 sibling, 0 replies; 89+ messages in thread
From: Thomas Schwinge @ 2014-02-21 19:29 UTC (permalink / raw)
To: Ilmir Usmanov
Cc: Evgeny Gavrin, GarbuzovViacheslav, Dmitri Botcharnikov,
gcc-patches, jakub
[-- Attachment #1: Type: text/plain, Size: 17267 bytes --]
Hi!
On Tue, 11 Feb 2014 17:51:15 +0100, I wrote:
> On Fri, 31 Jan 2014 15:16:07 +0400, Ilmir Usmanov <i.usmanov@samsung.com> wrote:
> > --- a/gcc/omp-low.c
> > +++ b/gcc/omp-low.c
> > @@ -1491,6 +1491,18 @@ fixup_child_record_type (omp_context *ctx)
> > TREE_TYPE (ctx->receiver_decl) = build_pointer_type (type);
> > }
> >
> > +static bool
> > +gimple_code_is_oacc (const_gimple g)
> > +{
> > + switch (gimple_code (g))
> > + {
> > + case GIMPLE_OACC_PARALLEL:
> > + return true;
> > + default:
> > + return false;
> > + }
> > +}
> > +
>
> Eventually, this will probably end up next to CASE_GIMPLE_OMP/is_gimple_omp
> in gimple.h (or the latter be reworked to be able to ask for is_omp vs.
> is_oacc vs. is_omp_or_oacc), but it's fine to do that once we actually
> need it in files other than just omp-low.c, and once we support more
> GIMPLE_OACC_* codes.
Ah, well, I'm now in the situation that I need to do such a check in
another file, so I have applied the following to gomp-4_0-branch in
r208013. I have also renamed the function to
is_gimple_omp_oacc_specifically, building on the existing is_gimple_omp
name. (Don't worry about the unwieldy name, as all this is to disappear
as the development progresses.)
commit 25aab0dd39a57661e9d7f3a5f405f4647977b9de
Author: tschwinge <tschwinge@138bc75d-0d04-0410-961f-82ee72b054a4>
Date: Fri Feb 21 19:26:01 2014 +0000
gimple_code_is_oacc -> is_gimple_omp_oacc_specifically.
gcc/
* omp-low.c (gimple_code_is_oacc): Move to...
* gimple.h (is_gimple_omp_oacc_specifically): ... here. Update
users, and also use it in more places where currently we've only
been checking for GIMPLE_OACC_PARALLEL.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/branches/gomp-4_0-branch@208013 138bc75d-0d04-0410-961f-82ee72b054a4
diff --git gcc/ChangeLog.gomp gcc/ChangeLog.gomp
index 14d8805..1ce952d 100644
--- gcc/ChangeLog.gomp
+++ gcc/ChangeLog.gomp
@@ -1,3 +1,10 @@
+2014-02-21 Thomas Schwinge <thomas@codesourcery.com>
+
+ * omp-low.c (gimple_code_is_oacc): Move to...
+ * gimple.h (is_gimple_omp_oacc_specifically): ... here. Update
+ users, and also use it in more places where currently we've only
+ been checking for GIMPLE_OACC_PARALLEL.
+
2014-02-18 Thomas Schwinge <thomas@codesourcery.com>
* omp-low.c (diagnose_sb_0, diagnose_sb_1, diagnose_sb_2): Handle
diff --git gcc/gimple.h gcc/gimple.h
index 5b5a0ee..0d250ef 100644
--- gcc/gimple.h
+++ gcc/gimple.h
@@ -5670,6 +5670,25 @@ is_gimple_omp (const_gimple stmt)
}
}
+/* Return true if STMT is any of the OpenACC types specifically.
+
+ TODO: This function should go away eventually, once all its callers have
+ either been fixed, changed into more specific checks, or verified to not
+ need any special handling for OpenACC. */
+
+static inline bool
+is_gimple_omp_oacc_specifically (const_gimple stmt)
+{
+ gcc_assert (is_gimple_omp (stmt));
+ switch (gimple_code (stmt))
+ {
+ case GIMPLE_OACC_PARALLEL:
+ return true;
+ default:
+ return false;
+ }
+}
+
/* Returns TRUE if statement G is a GIMPLE_NOP. */
diff --git gcc/omp-low.c gcc/omp-low.c
index 110ea63..b975dad 100644
--- gcc/omp-low.c
+++ gcc/omp-low.c
@@ -863,7 +863,7 @@ use_pointer_for_field (tree decl, omp_context *shared_ctx)
when we know the value is not accessible from an outer scope. */
if (shared_ctx)
{
- gcc_assert (gimple_code (shared_ctx->stmt) != GIMPLE_OACC_PARALLEL);
+ gcc_assert (!is_gimple_omp_oacc_specifically (shared_ctx->stmt));
/* ??? Trivially accessible from anywhere. But why would we even
be passing an address in this case? Should we simply assert
@@ -1006,7 +1006,7 @@ build_receiver_ref (tree var, bool by_ref, omp_context *ctx)
static tree
build_outer_var_ref (tree var, omp_context *ctx)
{
- gcc_assert (gimple_code (ctx->stmt) != GIMPLE_OACC_PARALLEL);
+ gcc_assert (!is_gimple_omp_oacc_specifically (ctx->stmt));
tree x;
@@ -1072,7 +1072,7 @@ install_var_field (tree var, bool by_ref, int mask, omp_context *ctx)
gcc_assert ((mask & 2) == 0 || !ctx->sfield_map
|| !splay_tree_lookup (ctx->sfield_map, (splay_tree_key) var));
gcc_assert ((mask & 3) == 3
- || gimple_code (ctx->stmt) != GIMPLE_OACC_PARALLEL);
+ || !is_gimple_omp_oacc_specifically (ctx->stmt));
type = TREE_TYPE (var);
if (mask & 4)
@@ -1491,18 +1491,6 @@ fixup_child_record_type (omp_context *ctx)
TREE_TYPE (ctx->receiver_decl) = build_pointer_type (type);
}
-static bool
-gimple_code_is_oacc (const_gimple g)
-{
- switch (gimple_code (g))
- {
- case GIMPLE_OACC_PARALLEL:
- return true;
- default:
- return false;
- }
-}
-
/* Instantiate decls as necessary in CTX to satisfy the data sharing
specified by CLAUSES. */
@@ -1519,7 +1507,7 @@ scan_sharing_clauses (tree clauses, omp_context *ctx)
switch (OMP_CLAUSE_CODE (c))
{
case OMP_CLAUSE_PRIVATE:
- gcc_assert (gimple_code (ctx->stmt) != GIMPLE_OACC_PARALLEL);
+ gcc_assert (!is_gimple_omp_oacc_specifically (ctx->stmt));
decl = OMP_CLAUSE_DECL (c);
if (OMP_CLAUSE_PRIVATE_OUTER_REF (c))
goto do_private;
@@ -1528,7 +1516,7 @@ scan_sharing_clauses (tree clauses, omp_context *ctx)
break;
case OMP_CLAUSE_SHARED:
- gcc_assert (gimple_code (ctx->stmt) != GIMPLE_OACC_PARALLEL);
+ gcc_assert (!is_gimple_omp_oacc_specifically (ctx->stmt));
/* Ignore shared directives in teams construct. */
if (gimple_code (ctx->stmt) == GIMPLE_OMP_TEAMS)
break;
@@ -1555,7 +1543,7 @@ scan_sharing_clauses (tree clauses, omp_context *ctx)
goto do_private;
case OMP_CLAUSE_LASTPRIVATE:
- gcc_assert (gimple_code (ctx->stmt) != GIMPLE_OACC_PARALLEL);
+ gcc_assert (!is_gimple_omp_oacc_specifically (ctx->stmt));
/* Let the corresponding firstprivate clause create
the variable. */
if (OMP_CLAUSE_LASTPRIVATE_FIRSTPRIVATE (c))
@@ -1564,13 +1552,13 @@ scan_sharing_clauses (tree clauses, omp_context *ctx)
case OMP_CLAUSE_FIRSTPRIVATE:
case OMP_CLAUSE_REDUCTION:
- if (gimple_code (ctx->stmt) == GIMPLE_OACC_PARALLEL)
+ if (is_gimple_omp_oacc_specifically (ctx->stmt))
{
sorry ("clause not supported yet");
break;
}
case OMP_CLAUSE_LINEAR:
- gcc_assert (!gimple_code_is_oacc (ctx->stmt));
+ gcc_assert (!is_gimple_omp_oacc_specifically (ctx->stmt));
decl = OMP_CLAUSE_DECL (c);
do_private:
if (is_variable_sized (decl))
@@ -1599,7 +1587,7 @@ scan_sharing_clauses (tree clauses, omp_context *ctx)
break;
case OMP_CLAUSE__LOOPTEMP_:
- gcc_assert (gimple_code (ctx->stmt) != GIMPLE_OACC_PARALLEL);
+ gcc_assert (!is_gimple_omp_oacc_specifically (ctx->stmt));
gcc_assert (is_parallel_ctx (ctx));
decl = OMP_CLAUSE_DECL (c);
install_var_field (decl, false, 3, ctx);
@@ -1608,19 +1596,19 @@ scan_sharing_clauses (tree clauses, omp_context *ctx)
case OMP_CLAUSE_COPYPRIVATE:
case OMP_CLAUSE_COPYIN:
- gcc_assert (!gimple_code_is_oacc (ctx->stmt));
+ gcc_assert (!is_gimple_omp_oacc_specifically (ctx->stmt));
decl = OMP_CLAUSE_DECL (c);
by_ref = use_pointer_for_field (decl, NULL);
install_var_field (decl, by_ref, 3, ctx);
break;
case OMP_CLAUSE_DEFAULT:
- gcc_assert (gimple_code (ctx->stmt) != GIMPLE_OACC_PARALLEL);
+ gcc_assert (!is_gimple_omp_oacc_specifically (ctx->stmt));
ctx->default_kind = OMP_CLAUSE_DEFAULT_KIND (c);
break;
case OMP_CLAUSE_IF:
- if (gimple_code (ctx->stmt) == GIMPLE_OACC_PARALLEL)
+ if (is_gimple_omp_oacc_specifically (ctx->stmt))
{
sorry ("clause not supported yet");
break;
@@ -1633,14 +1621,14 @@ scan_sharing_clauses (tree clauses, omp_context *ctx)
case OMP_CLAUSE_SCHEDULE:
case OMP_CLAUSE_DIST_SCHEDULE:
case OMP_CLAUSE_DEPEND:
- gcc_assert (!gimple_code_is_oacc (ctx->stmt));
+ gcc_assert (!is_gimple_omp_oacc_specifically (ctx->stmt));
if (ctx->outer)
scan_omp_op (&OMP_CLAUSE_OPERAND (c, 0), ctx->outer);
break;
case OMP_CLAUSE_TO:
case OMP_CLAUSE_FROM:
- gcc_assert (!gimple_code_is_oacc (ctx->stmt));
+ gcc_assert (!is_gimple_omp_oacc_specifically (ctx->stmt));
case OMP_CLAUSE_MAP:
if (ctx->outer)
scan_omp_op (&OMP_CLAUSE_SIZE (c), ctx->outer);
@@ -1654,7 +1642,7 @@ scan_sharing_clauses (tree clauses, omp_context *ctx)
&& lookup_attribute ("omp declare target",
DECL_ATTRIBUTES (decl)))
{
- gcc_assert (gimple_code (ctx->stmt) != GIMPLE_OACC_PARALLEL);
+ gcc_assert (!is_gimple_omp_oacc_specifically (ctx->stmt));
break;
}
if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_MAP
@@ -1732,11 +1720,11 @@ scan_sharing_clauses (tree clauses, omp_context *ctx)
case OMP_CLAUSE_MERGEABLE:
case OMP_CLAUSE_PROC_BIND:
case OMP_CLAUSE_SAFELEN:
- gcc_assert (!gimple_code_is_oacc (ctx->stmt));
+ gcc_assert (!is_gimple_omp_oacc_specifically (ctx->stmt));
break;
case OMP_CLAUSE_ALIGNED:
- gcc_assert (!gimple_code_is_oacc (ctx->stmt));
+ gcc_assert (!is_gimple_omp_oacc_specifically (ctx->stmt));
decl = OMP_CLAUSE_DECL (c);
if (is_global_var (decl)
&& TREE_CODE (TREE_TYPE (decl)) == ARRAY_TYPE)
@@ -1770,7 +1758,7 @@ scan_sharing_clauses (tree clauses, omp_context *ctx)
switch (OMP_CLAUSE_CODE (c))
{
case OMP_CLAUSE_LASTPRIVATE:
- gcc_assert (!gimple_code_is_oacc (ctx->stmt));
+ gcc_assert (!is_gimple_omp_oacc_specifically (ctx->stmt));
/* Let the corresponding firstprivate clause create
the variable. */
if (OMP_CLAUSE_LASTPRIVATE_GIMPLE_SEQ (c))
@@ -1782,13 +1770,13 @@ scan_sharing_clauses (tree clauses, omp_context *ctx)
case OMP_CLAUSE_PRIVATE:
case OMP_CLAUSE_FIRSTPRIVATE:
case OMP_CLAUSE_REDUCTION:
- if (gimple_code (ctx->stmt) == GIMPLE_OACC_PARALLEL)
+ if (is_gimple_omp_oacc_specifically (ctx->stmt))
{
sorry ("clause not supported yet");
break;
}
case OMP_CLAUSE_LINEAR:
- gcc_assert (!gimple_code_is_oacc (ctx->stmt));
+ gcc_assert (!is_gimple_omp_oacc_specifically (ctx->stmt));
decl = OMP_CLAUSE_DECL (c);
if (is_variable_sized (decl))
install_var_local (decl, ctx);
@@ -1801,7 +1789,7 @@ scan_sharing_clauses (tree clauses, omp_context *ctx)
break;
case OMP_CLAUSE_SHARED:
- gcc_assert (!gimple_code_is_oacc (ctx->stmt));
+ gcc_assert (!is_gimple_omp_oacc_specifically (ctx->stmt));
/* Ignore shared directives in teams construct. */
if (gimple_code (ctx->stmt) == GIMPLE_OMP_TEAMS)
break;
@@ -1820,7 +1808,7 @@ scan_sharing_clauses (tree clauses, omp_context *ctx)
&& lookup_attribute ("omp declare target",
DECL_ATTRIBUTES (decl)))
{
- gcc_assert (!gimple_code_is_oacc (ctx->stmt));
+ gcc_assert (!is_gimple_omp_oacc_specifically (ctx->stmt));
break;
}
if (DECL_P (decl))
@@ -1849,7 +1837,7 @@ scan_sharing_clauses (tree clauses, omp_context *ctx)
break;
case OMP_CLAUSE_IF:
- if (gimple_code (ctx->stmt) == GIMPLE_OACC_PARALLEL)
+ if (is_gimple_omp_oacc_specifically (ctx->stmt))
{
sorry ("clause not supported yet");
break;
@@ -1876,7 +1864,7 @@ scan_sharing_clauses (tree clauses, omp_context *ctx)
case OMP_CLAUSE__LOOPTEMP_:
case OMP_CLAUSE_TO:
case OMP_CLAUSE_FROM:
- gcc_assert (!gimple_code_is_oacc (ctx->stmt));
+ gcc_assert (!is_gimple_omp_oacc_specifically (ctx->stmt));
break;
case OMP_CLAUSE_HOST:
@@ -1903,7 +1891,7 @@ scan_sharing_clauses (tree clauses, omp_context *ctx)
if (scan_array_reductions)
{
- gcc_assert (gimple_code (ctx->stmt) != GIMPLE_OACC_PARALLEL);
+ gcc_assert (!is_gimple_omp_oacc_specifically (ctx->stmt));
for (c = clauses; c; c = OMP_CLAUSE_CHAIN (c))
if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_REDUCTION
&& OMP_CLAUSE_REDUCTION_PLACEHOLDER (c))
@@ -1944,7 +1932,7 @@ create_omp_child_function (omp_context *ctx, bool task_copy)
decl = build_decl (gimple_location (ctx->stmt),
FUNCTION_DECL, name, type);
- gcc_assert (gimple_code (ctx->stmt) != GIMPLE_OACC_PARALLEL
+ gcc_assert (!is_gimple_omp_oacc_specifically (ctx->stmt)
|| !task_copy);
if (!task_copy)
ctx->cb.dst_fn = decl;
@@ -1977,7 +1965,7 @@ create_omp_child_function (omp_context *ctx, bool task_copy)
break;
}
}
- gcc_assert (gimple_code (ctx->stmt) != GIMPLE_OACC_PARALLEL
+ gcc_assert (!is_gimple_omp_oacc_specifically (ctx->stmt)
|| !target_p);
if (target_p)
DECL_ATTRIBUTES (decl)
@@ -2396,19 +2384,17 @@ check_omp_nesting_restrictions (gimple stmt, omp_context *ctx)
/* No nesting of STMT (which is an OpenACC or OpenMP one, or a GOMP builtin)
inside any OpenACC CTX. */
for (ctx_ = ctx; ctx_ != NULL; ctx_ = ctx_->outer)
- switch (gimple_code (ctx_->stmt))
+ if (is_gimple_omp (ctx_->stmt)
+ && is_gimple_omp_oacc_specifically (ctx_->stmt))
{
- case GIMPLE_OACC_PARALLEL:
error_at (gimple_location (stmt),
"may not be nested");
return false;
- default:
- break;
}
/* No nesting of OpenACC STMT inside any OpenACC or OpenMP CTX. */
- switch (gimple_code (stmt))
+ if (is_gimple_omp (stmt)
+ && is_gimple_omp_oacc_specifically (stmt))
{
- case GIMPLE_OACC_PARALLEL:
for (ctx_ = ctx; ctx_ != NULL; ctx_ = ctx_->outer)
if (is_gimple_omp (ctx_->stmt))
{
@@ -2416,9 +2402,6 @@ check_omp_nesting_restrictions (gimple stmt, omp_context *ctx)
"may not be nested");
return false;
}
- break;
- default:
- break;
}
if (ctx != NULL)
@@ -3138,7 +3121,7 @@ static bool
lower_rec_simd_input_clauses (tree new_var, omp_context *ctx, int &max_vf,
tree &idx, tree &lane, tree &ivar, tree &lvar)
{
- gcc_assert (gimple_code (ctx->stmt) != GIMPLE_OACC_PARALLEL);
+ gcc_assert (!is_gimple_omp_oacc_specifically (ctx->stmt));
if (max_vf == 0)
{
@@ -3189,7 +3172,7 @@ static void
lower_rec_input_clauses (tree clauses, gimple_seq *ilist, gimple_seq *dlist,
omp_context *ctx, struct omp_for_data *fd)
{
- gcc_assert (gimple_code (ctx->stmt) != GIMPLE_OACC_PARALLEL);
+ gcc_assert (!is_gimple_omp_oacc_specifically (ctx->stmt));
tree c, dtor, copyin_seq, x, ptr;
bool copyin_by_ref = false;
@@ -3892,7 +3875,7 @@ static void
lower_lastprivate_clauses (tree clauses, tree predicate, gimple_seq *stmt_list,
omp_context *ctx)
{
- gcc_assert (gimple_code (ctx->stmt) != GIMPLE_OACC_PARALLEL);
+ gcc_assert (!is_gimple_omp_oacc_specifically (ctx->stmt));
tree x, c, label = NULL, orig_clauses = clauses;
bool par_clauses = false;
@@ -4029,7 +4012,7 @@ lower_lastprivate_clauses (tree clauses, tree predicate, gimple_seq *stmt_list,
static void
lower_reduction_clauses (tree clauses, gimple_seq *stmt_seqp, omp_context *ctx)
{
- gcc_assert (gimple_code (ctx->stmt) != GIMPLE_OACC_PARALLEL);
+ gcc_assert (!is_gimple_omp_oacc_specifically (ctx->stmt));
gimple_seq sub_seq = NULL;
gimple stmt;
@@ -4132,7 +4115,7 @@ static void
lower_copyprivate_clauses (tree clauses, gimple_seq *slist, gimple_seq *rlist,
omp_context *ctx)
{
- gcc_assert (gimple_code (ctx->stmt) != GIMPLE_OACC_PARALLEL);
+ gcc_assert (!is_gimple_omp_oacc_specifically (ctx->stmt));
tree c;
@@ -4184,7 +4167,7 @@ static void
lower_send_clauses (tree clauses, gimple_seq *ilist, gimple_seq *olist,
omp_context *ctx)
{
- gcc_assert (gimple_code (ctx->stmt) != GIMPLE_OACC_PARALLEL);
+ gcc_assert (!is_gimple_omp_oacc_specifically (ctx->stmt));
tree c;
@@ -4277,7 +4260,7 @@ lower_send_clauses (tree clauses, gimple_seq *ilist, gimple_seq *olist,
static void
lower_send_shared_vars (gimple_seq *ilist, gimple_seq *olist, omp_context *ctx)
{
- gcc_assert (gimple_code (ctx->stmt) != GIMPLE_OACC_PARALLEL);
+ gcc_assert (!is_gimple_omp_oacc_specifically (ctx->stmt));
tree var, ovar, nvar, f, x, record_type;
@@ -9091,7 +9074,7 @@ lower_oacc_parallel (gimple_stmt_iterator *gsi_p, omp_context *ctx)
static void
maybe_add_implicit_barrier_cancel (omp_context *ctx, gimple_seq *body)
{
- gcc_assert (gimple_code (ctx->stmt) != GIMPLE_OACC_PARALLEL);
+ gcc_assert (!is_gimple_omp_oacc_specifically (ctx->stmt));
gimple omp_return = gimple_seq_last_stmt (*body);
gcc_assert (gimple_code (omp_return) == GIMPLE_OMP_RETURN);
@@ -9858,7 +9841,7 @@ task_copyfn_remap_type (struct omp_taskcopy_context *tcctx, tree orig_type)
static void
create_task_copyfn (gimple task_stmt, omp_context *ctx)
{
- gcc_assert (gimple_code (ctx->stmt) != GIMPLE_OACC_PARALLEL);
+ gcc_assert (!is_gimple_omp_oacc_specifically (ctx->stmt));
struct function *child_cfun;
tree child_fn, t, c, src, dst, f, sf, arg, sarg, decl;
Grüße,
Thomas
[-- Attachment #2: Type: application/pgp-signature, Size: 489 bytes --]
^ permalink raw reply [flat|nested] 89+ messages in thread
* Re: [PATCH 1/4] [GOMP4] [Fortran] OpenACC 1.0+ support in fortran front-end
2014-02-20 8:19 ` Ilmir Usmanov
@ 2014-03-04 7:56 ` Ilmir Usmanov
2014-03-04 7:57 ` Ilmir Usmanov
0 siblings, 1 reply; 89+ messages in thread
From: Ilmir Usmanov @ 2014-03-04 7:56 UTC (permalink / raw)
To: Tobias Burnus
Cc: Thomas Schwinge, Evgeny Gavrin, GarbuzovViacheslav,
Dmitri Botcharnikov, gcc-patches, jakub, fortran
Hi Tobias!
I fixed my patches. Could you review them?
>
> I'd use "integer" instead of "INTEGER" as it is not a 'reserved' word
OpenMP implementation uses capital letters, so, perhaps, we also should
do this, for consistency?
--
Ilmir.
^ permalink raw reply [flat|nested] 89+ messages in thread
* Re: [PATCH 1/4] [GOMP4] [Fortran] OpenACC 1.0+ support in fortran front-end
2014-03-04 7:56 ` [PATCH 1/4] [GOMP4] [Fortran] " Ilmir Usmanov
@ 2014-03-04 7:57 ` Ilmir Usmanov
2014-03-04 7:57 ` [PATCH 2/4] " Ilmir Usmanov
` (2 more replies)
0 siblings, 3 replies; 89+ messages in thread
From: Ilmir Usmanov @ 2014-03-04 7:57 UTC (permalink / raw)
To: Tobias Burnus
Cc: Thomas Schwinge, Evgeny Gavrin, GarbuzovViacheslav,
Dmitri Botcharnikov, gcc-patches, jakub, fortran
[-- Attachment #1: Type: text/plain, Size: 3800 bytes --]
OpenACC 1.0 support to fortran FE -- core.
gcc/fortran/
* dump-parse-tree.c
(show_omp_node): Dump also OpenACC executable statements.
(show_code_node): Call it.
(show_namespace): Dump !$ACC DECLARE directive.
* gfortran.h
(ST_OACC_PARALLEL_LOOP, ST_OACC_END_PARALLEL_LOOP, ST_OACC_PARALLEL,
ST_OACC_END_PARALLEL, ST_OACC_KERNELS, ST_OACC_END_KERNELS,
ST_OACC_DATA, ST_OACC_END_DATA, ST_OACC_HOST_DATA,
ST_OACC_END_HOST_DATA, ST_OACC_LOOP, ST_OACC_DECLARE, ST_OACC_UPDATE,
ST_OACC_WAIT, ST_OACC_CACHE, ST_OACC_KERNELS_LOOP,
ST_OACC_END_KERNELS_LOOP, ST_OACC_ENTER_DATA,
ST_OACC_EXIT_DATA, ST_OACC_END_LOOP): New statements.
(gfc_expr_list): New structure to hold list of expressions.
(OMP_LIST_COPY, OMP_LIST_DATA_CLAUSE_FIRST,
OMP_LIST_OACC_COPYIN, OMP_LIST_COPYOUT, OMP_LIST_CREATE,
OMP_LIST_DELETE,
OMP_LIST_PRESENT, OMP_LIST_PRESENT_OR_COPY,
OMP_LIST_PRESENT_OR_COPYIN, OMP_LIST_PRESENT_OR_COPYOUT,
OMP_LIST_PRESENT_OR_CREATE, OMP_LIST_DEVICEPTR,
OMP_LIST_DATA_CLAUSE_LAST, OMP_LIST_USE_DEVICE,
OMP_LIST_DEVICE_RESIDENT, OMP_LIST_HOST, OMP_LIST_DEVICE,
OMP_LIST_CACHE): New types of list, allowed in clauses.
(gfc_omp_clauses): Add OpenACC clauses.
(gfc_namespace): Add OpenACC declare directive clauses.
(EXEC_OACC_KERNELS_LOOP, EXEC_OACC_PARALLEL_LOOP, 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): New executable statements.
(gfc_free_expr_list): New function declaration.
(gfc_resolve_oacc_directive): Likewise.
(gfc_resolve_oacc_parallel_loop_blocks): Likewise.
(gfc_resolve_oacc_blocks): Likewise.
* match.c (match_exit_cycle): Add support of OpenACC regions and loops.
* match.h (gfc_match_oacc_cache): New function declaration.
(gfc_match_oacc_wait, gfc_match_oacc_update): Likewise.
(gfc_match_oacc_declare, gfc_match_oacc_loop): Likewise.
(gfc_match_oacc_host_data, gfc_match_oacc_data): Likewise.
(gfc_match_oacc_kernels, gfc_match_oacc_kernels_loop): Likewise.
(gfc_match_oacc_parallel, gfc_match_oacc_parallel_loop): Likewise.
(gfc_match_oacc_enter_data, gfc_match_oacc_exit_data): Likewise.
* parse.c (decode_oacc_directive): New function.
(verify_token_free, verify_token_fixed): New helper functions.
(next_free, next_fixed): Decode !$ACC sentinel.
(case_executable): Add ST_OACC_UPDATE, ST_OACC_WAIT, ST_OACC_CACHE,
ST_OACC_ENTER_DATA and ST_OACC_EXIT_DATA directives.
(case_exec_markers): Add ST_OACC_PARALLEL_LOOP, ST_OACC_PARALLEL,
ST_OACC_KERNELS, ST_OACC_DATA, ST_OACC_HOST_DATA, ST_OACC_LOOP and
ST_OACC_KERNELS_LOOP directives.
(push_state): Initialize OpenACC declare clauses.
(gfc_ascii_statement): Dump names of OpenACC directives.
(verify_st_order): Verify OpenACC declare directive as declarative.
(parse_spec): Push clauses to state stack when declare directive is
parsed.
(parse_oacc_structured_block, parse_oacc_loop): New functions.
(parse_executable): Call them.
(parse_progunit): Move declare clauses from state stack to namespace.
* parse.h (gfc_state_data): Add declare directive's clauses.
* resolve.c (gfc_resolve_blocks): Resolve OpenACC directives.
(resolve_code): Likewise.
* scanner.c (openacc_flag, openacc_locus): New static variables.
(skip_oacc_attribute, skip_omp_attribute): New helper functions.
(skip_free_comments, skip_fixed_comments): Don't skip !$ACC sentinel.
(gfc_next_char_literal): Support OpenACC directives.
* st.c (gfc_free_statement): Free also OpenACC directives.
[-- Attachment #2: 0001-OpenACC-Fortran-FE-part-1.patch --]
[-- Type: text/x-diff, Size: 53231 bytes --]
From bae615ad48128937125a74d4da04ae0b92a0b587 Mon Sep 17 00:00:00 2001
From: Ilmir Usmanov <i.usmanov@samsung.com>
Date: Wed, 26 Feb 2014 19:02:53 +0400
Subject: [PATCH 1/5] OpenACC Fortran FE: part 1
---
gcc/fortran/dump-parse-tree.c | 391 +++++++++++++++++++++++++-----------
gcc/fortran/gfortran.h | 68 +++++++
gcc/fortran/match.c | 27 +++
gcc/fortran/match.h | 15 ++
gcc/fortran/parse.c | 446 +++++++++++++++++++++++++++++++++++++++---
gcc/fortran/parse.h | 1 +
gcc/fortran/resolve.c | 37 ++++
gcc/fortran/scanner.c | 370 ++++++++++++++++++++++++++++-------
gcc/fortran/st.c | 12 ++
9 files changed, 1158 insertions(+), 209 deletions(-)
diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c
index b1343bc..b6679ab 100644
--- a/gcc/fortran/dump-parse-tree.c
+++ b/gcc/fortran/dump-parse-tree.c
@@ -1023,7 +1023,233 @@ show_namelist (gfc_namelist *n)
fprintf (dumpfile, "%s", n->sym->name);
}
-/* Show a single OpenMP directive node and everything underneath it
+
+/* Show OpenMP or OpenACC clauses. */
+
+static void
+show_omp_clauses (gfc_omp_clauses *omp_clauses)
+{
+ int list_type;
+
+ if (omp_clauses->if_expr)
+ {
+ fputs (" IF(", dumpfile);
+ show_expr (omp_clauses->if_expr);
+ fputc (')', dumpfile);
+ }
+ if (omp_clauses->final_expr)
+ {
+ fputs (" FINAL(", dumpfile);
+ show_expr (omp_clauses->final_expr);
+ fputc (')', dumpfile);
+ }
+ if (omp_clauses->num_threads)
+ {
+ fputs (" NUM_THREADS(", dumpfile);
+ show_expr (omp_clauses->num_threads);
+ fputc (')', dumpfile);
+ }
+ if (omp_clauses->async)
+ {
+ fputs (" ASYNC", dumpfile);
+ if (omp_clauses->async_expr)
+ {
+ fputc ('(', dumpfile);
+ show_expr (omp_clauses->async_expr);
+ fputc (')', dumpfile);
+ }
+ }
+ if (omp_clauses->num_gangs_expr)
+ {
+ fputs (" NUM_GANGS(", dumpfile);
+ show_expr (omp_clauses->num_gangs_expr);
+ fputc (')', dumpfile);
+ }
+ if (omp_clauses->num_workers_expr)
+ {
+ fputs (" NUM_WORKERS(", dumpfile);
+ show_expr (omp_clauses->num_workers_expr);
+ fputc (')', dumpfile);
+ }
+ if (omp_clauses->vector_length_expr)
+ {
+ fputs (" VECTOR_LENGTH(", dumpfile);
+ show_expr (omp_clauses->vector_length_expr);
+ fputc (')', dumpfile);
+ }
+ if (omp_clauses->gang)
+ {
+ fputs (" GANG", dumpfile);
+ if (omp_clauses->gang_expr)
+ {
+ fputc ('(', dumpfile);
+ show_expr (omp_clauses->gang_expr);
+ fputc (')', dumpfile);
+ }
+ }
+ if (omp_clauses->worker)
+ {
+ fputs (" WORKER", dumpfile);
+ if (omp_clauses->worker_expr)
+ {
+ fputc ('(', dumpfile);
+ show_expr (omp_clauses->worker_expr);
+ fputc (')', dumpfile);
+ }
+ }
+ if (omp_clauses->vector)
+ {
+ fputs (" VECTOR", dumpfile);
+ if (omp_clauses->vector_expr)
+ {
+ fputc ('(', dumpfile);
+ show_expr (omp_clauses->vector_expr);
+ fputc (')', dumpfile);
+ }
+ }
+ if (omp_clauses->non_clause_wait_expr)
+ {
+ fputc ('(', dumpfile);
+ show_expr (omp_clauses->non_clause_wait_expr);
+ fputc (')', dumpfile);
+ }
+ if (omp_clauses->sched_kind != OMP_SCHED_NONE)
+ {
+ const char *type;
+ switch (omp_clauses->sched_kind)
+ {
+ case OMP_SCHED_STATIC: type = "STATIC"; break;
+ case OMP_SCHED_DYNAMIC: type = "DYNAMIC"; break;
+ case OMP_SCHED_GUIDED: type = "GUIDED"; break;
+ case OMP_SCHED_RUNTIME: type = "RUNTIME"; break;
+ case OMP_SCHED_AUTO: type = "AUTO"; break;
+ default:
+ gcc_unreachable ();
+ }
+ fprintf (dumpfile, " SCHEDULE (%s", type);
+ if (omp_clauses->chunk_size)
+ {
+ fputc (',', dumpfile);
+ show_expr (omp_clauses->chunk_size);
+ }
+ fputc (')', dumpfile);
+ }
+ if (omp_clauses->default_sharing != OMP_DEFAULT_UNKNOWN)
+ {
+ const char *type;
+ switch (omp_clauses->default_sharing)
+ {
+ case OMP_DEFAULT_NONE: type = "NONE"; break;
+ case OMP_DEFAULT_PRIVATE: type = "PRIVATE"; break;
+ case OMP_DEFAULT_SHARED: type = "SHARED"; break;
+ case OMP_DEFAULT_FIRSTPRIVATE: type = "FIRSTPRIVATE"; break;
+ default:
+ gcc_unreachable ();
+ }
+ fprintf (dumpfile, " DEFAULT(%s)", type);
+ }
+ if (omp_clauses->tile_list)
+ {
+ gfc_expr_list *list;
+ fputs (" TILE(", dumpfile);
+ for (list = omp_clauses->tile_list; list; list = list->next)
+ {
+ show_expr (list->expr);
+ if (list->next)
+ fputs (", ", dumpfile);
+ }
+ fputc (')', dumpfile);
+ }
+ if (omp_clauses->wait_list)
+ {
+ gfc_expr_list *list;
+ fputs (" WAIT(", dumpfile);
+ for (list = omp_clauses->wait_list; list; list = list->next)
+ {
+ show_expr (list->expr);
+ if (list->next)
+ fputs (", ", dumpfile);
+ }
+ fputc (')', dumpfile);
+ }
+ if (omp_clauses->seq)
+ fputs (" SEQ", dumpfile);
+ if (omp_clauses->independent)
+ fputs (" INDEPENDENT", dumpfile);
+ if (omp_clauses->ordered)
+ fputs (" ORDERED", dumpfile);
+ if (omp_clauses->untied)
+ fputs (" UNTIED", dumpfile);
+ if (omp_clauses->mergeable)
+ fputs (" MERGEABLE", dumpfile);
+ if (omp_clauses->collapse)
+ fprintf (dumpfile, " COLLAPSE(%d)", omp_clauses->collapse);
+ for (list_type = 0; list_type < OMP_LIST_NUM; list_type++)
+ if (omp_clauses->lists[list_type] != NULL
+ && list_type != OMP_LIST_COPYPRIVATE)
+ {
+ const char *type;
+ if (list_type >= OMP_LIST_REDUCTION_FIRST)
+ {
+ switch (list_type)
+ {
+ case OMP_LIST_PLUS: type = "+"; break;
+ case OMP_LIST_MULT: type = "*"; break;
+ case OMP_LIST_SUB: type = "-"; break;
+ case OMP_LIST_AND: type = ".AND."; break;
+ case OMP_LIST_OR: type = ".OR."; break;
+ case OMP_LIST_EQV: type = ".EQV."; break;
+ case OMP_LIST_NEQV: type = ".NEQV."; break;
+ case OMP_LIST_MAX: type = "MAX"; break;
+ case OMP_LIST_MIN: type = "MIN"; break;
+ case OMP_LIST_IAND: type = "IAND"; break;
+ case OMP_LIST_IOR: type = "IOR"; break;
+ case OMP_LIST_IEOR: type = "IEOR"; break;
+ default:
+ gcc_unreachable ();
+ }
+ fprintf (dumpfile, " REDUCTION(%s:", type);
+ }
+ else
+ {
+ switch (list_type)
+ {
+ case OMP_LIST_COPY: type = "COPY"; break;
+ case OMP_LIST_OACC_COPYIN: type = "COPYIN"; break;
+ case OMP_LIST_COPYOUT: type = "COPYOUT"; break;
+ case OMP_LIST_CREATE: type = "CREATE"; break;
+ case OMP_LIST_DELETE: type = "DELETE"; break;
+ case OMP_LIST_PRESENT: type = "PRESENT"; break;
+ case OMP_LIST_PRESENT_OR_COPY:
+ type = "PRESENT_OR_COPY"; break;
+ case OMP_LIST_PRESENT_OR_COPYIN:
+ type = "PRESENT_OR_COPYIN"; break;
+ case OMP_LIST_PRESENT_OR_COPYOUT:
+ type = "PRESENT_OR_COPYOUT"; break;
+ case OMP_LIST_PRESENT_OR_CREATE:
+ type = "PRESENT_OR_CREATE"; break;
+ case OMP_LIST_DEVICEPTR: type = "DEVICEPTR"; break;
+ case OMP_LIST_USE_DEVICE: type = "USE_DEVICE"; break;
+ case OMP_LIST_DEVICE_RESIDENT: type = "USE_DEVICE"; break;
+ case OMP_LIST_HOST: type = "HOST"; break;
+ case OMP_LIST_DEVICE: type = "DEVICE"; break;
+ case OMP_LIST_CACHE: type = ""; break;
+ case OMP_LIST_PRIVATE: type = "PRIVATE"; break;
+ case OMP_LIST_FIRSTPRIVATE: type = "FIRSTPRIVATE"; break;
+ case OMP_LIST_LASTPRIVATE: type = "LASTPRIVATE"; break;
+ case OMP_LIST_SHARED: type = "SHARED"; break;
+ case OMP_LIST_COPYIN: type = "COPYIN"; break;
+ default:
+ gcc_unreachable ();
+ }
+ fprintf (dumpfile, " %s(", type);
+ }
+ show_namelist (omp_clauses->lists[list_type]);
+ fputc (')', dumpfile);
+ }
+}
+
+/* Show a single OpenMP or OpenACC directive node and everything underneath it
if necessary. */
static void
@@ -1031,9 +1257,22 @@ show_omp_node (int level, gfc_code *c)
{
gfc_omp_clauses *omp_clauses = NULL;
const char *name = NULL;
+ bool is_oacc = false;
switch (c->op)
{
+ case EXEC_OACC_PARALLEL_LOOP: name = "PARALLEL LOOP"; is_oacc = true; break;
+ case EXEC_OACC_PARALLEL: name = "PARALLEL"; is_oacc = true; break;
+ case EXEC_OACC_KERNELS_LOOP: name = "KERNELS LOOP"; is_oacc = true; break;
+ case EXEC_OACC_KERNELS: name = "KERNELS"; is_oacc = true; break;
+ case EXEC_OACC_DATA: name = "DATA"; is_oacc = true; break;
+ case EXEC_OACC_HOST_DATA: name = "HOST_DATA"; is_oacc = true; break;
+ case EXEC_OACC_LOOP: name = "LOOP"; is_oacc = true; break;
+ case EXEC_OACC_UPDATE: name = "UPDATE"; is_oacc = true; break;
+ case EXEC_OACC_WAIT: name = "WAIT"; is_oacc = true; break;
+ case EXEC_OACC_CACHE: name = "CACHE"; is_oacc = true; break;
+ case EXEC_OACC_ENTER_DATA: name = "ENTER DATA"; is_oacc = true; break;
+ case EXEC_OACC_EXIT_DATA: name = "EXIT DATA"; is_oacc = true; break;
case EXEC_OMP_ATOMIC: name = "ATOMIC"; break;
case EXEC_OMP_BARRIER: name = "BARRIER"; break;
case EXEC_OMP_CRITICAL: name = "CRITICAL"; break;
@@ -1054,9 +1293,21 @@ show_omp_node (int level, gfc_code *c)
default:
gcc_unreachable ();
}
- fprintf (dumpfile, "!$OMP %s", name);
+ fprintf (dumpfile, "!$%s %s", is_oacc ? "ACC" : "OMP", name);
switch (c->op)
{
+ case EXEC_OACC_PARALLEL_LOOP:
+ case EXEC_OACC_PARALLEL:
+ case EXEC_OACC_KERNELS_LOOP:
+ case EXEC_OACC_KERNELS:
+ case EXEC_OACC_DATA:
+ case EXEC_OACC_HOST_DATA:
+ case EXEC_OACC_LOOP:
+ case EXEC_OACC_UPDATE:
+ case EXEC_OACC_WAIT:
+ case EXEC_OACC_CACHE:
+ case EXEC_OACC_ENTER_DATA:
+ case EXEC_OACC_EXIT_DATA:
case EXEC_OMP_DO:
case EXEC_OMP_PARALLEL:
case EXEC_OMP_PARALLEL_DO:
@@ -1088,115 +1339,13 @@ show_omp_node (int level, gfc_code *c)
break;
}
if (omp_clauses)
- {
- int list_type;
-
- if (omp_clauses->if_expr)
- {
- fputs (" IF(", dumpfile);
- show_expr (omp_clauses->if_expr);
- fputc (')', dumpfile);
- }
- if (omp_clauses->final_expr)
- {
- fputs (" FINAL(", dumpfile);
- show_expr (omp_clauses->final_expr);
- fputc (')', dumpfile);
- }
- if (omp_clauses->num_threads)
- {
- fputs (" NUM_THREADS(", dumpfile);
- show_expr (omp_clauses->num_threads);
- fputc (')', dumpfile);
- }
- if (omp_clauses->sched_kind != OMP_SCHED_NONE)
- {
- const char *type;
- switch (omp_clauses->sched_kind)
- {
- case OMP_SCHED_STATIC: type = "STATIC"; break;
- case OMP_SCHED_DYNAMIC: type = "DYNAMIC"; break;
- case OMP_SCHED_GUIDED: type = "GUIDED"; break;
- case OMP_SCHED_RUNTIME: type = "RUNTIME"; break;
- case OMP_SCHED_AUTO: type = "AUTO"; break;
- default:
- gcc_unreachable ();
- }
- fprintf (dumpfile, " SCHEDULE (%s", type);
- if (omp_clauses->chunk_size)
- {
- fputc (',', dumpfile);
- show_expr (omp_clauses->chunk_size);
- }
- fputc (')', dumpfile);
- }
- if (omp_clauses->default_sharing != OMP_DEFAULT_UNKNOWN)
- {
- const char *type;
- switch (omp_clauses->default_sharing)
- {
- case OMP_DEFAULT_NONE: type = "NONE"; break;
- case OMP_DEFAULT_PRIVATE: type = "PRIVATE"; break;
- case OMP_DEFAULT_SHARED: type = "SHARED"; break;
- case OMP_DEFAULT_FIRSTPRIVATE: type = "FIRSTPRIVATE"; break;
- default:
- gcc_unreachable ();
- }
- fprintf (dumpfile, " DEFAULT(%s)", type);
- }
- if (omp_clauses->ordered)
- fputs (" ORDERED", dumpfile);
- if (omp_clauses->untied)
- fputs (" UNTIED", dumpfile);
- if (omp_clauses->mergeable)
- fputs (" MERGEABLE", dumpfile);
- if (omp_clauses->collapse)
- fprintf (dumpfile, " COLLAPSE(%d)", omp_clauses->collapse);
- for (list_type = 0; list_type < OMP_LIST_NUM; list_type++)
- if (omp_clauses->lists[list_type] != NULL
- && list_type != OMP_LIST_COPYPRIVATE)
- {
- const char *type;
- if (list_type >= OMP_LIST_REDUCTION_FIRST)
- {
- switch (list_type)
- {
- case OMP_LIST_PLUS: type = "+"; break;
- case OMP_LIST_MULT: type = "*"; break;
- case OMP_LIST_SUB: type = "-"; break;
- case OMP_LIST_AND: type = ".AND."; break;
- case OMP_LIST_OR: type = ".OR."; break;
- case OMP_LIST_EQV: type = ".EQV."; break;
- case OMP_LIST_NEQV: type = ".NEQV."; break;
- case OMP_LIST_MAX: type = "MAX"; break;
- case OMP_LIST_MIN: type = "MIN"; break;
- case OMP_LIST_IAND: type = "IAND"; break;
- case OMP_LIST_IOR: type = "IOR"; break;
- case OMP_LIST_IEOR: type = "IEOR"; break;
- default:
- gcc_unreachable ();
- }
- fprintf (dumpfile, " REDUCTION(%s:", type);
- }
- else
- {
- switch (list_type)
- {
- case OMP_LIST_PRIVATE: type = "PRIVATE"; break;
- case OMP_LIST_FIRSTPRIVATE: type = "FIRSTPRIVATE"; break;
- case OMP_LIST_LASTPRIVATE: type = "LASTPRIVATE"; break;
- case OMP_LIST_SHARED: type = "SHARED"; break;
- case OMP_LIST_COPYIN: type = "COPYIN"; break;
- default:
- gcc_unreachable ();
- }
- fprintf (dumpfile, " %s(", type);
- }
- show_namelist (omp_clauses->lists[list_type]);
- fputc (')', dumpfile);
- }
- }
+ show_omp_clauses (omp_clauses);
fputc ('\n', dumpfile);
+
+ /* OpenACC executable directives don't have associated blocks. */
+ if (c->op == EXEC_OACC_CACHE || c->op == EXEC_OACC_UPDATE
+ || c->op == EXEC_OACC_ENTER_DATA || c->op == EXEC_OACC_EXIT_DATA)
+ return;
if (c->op == EXEC_OMP_SECTIONS || c->op == EXEC_OMP_PARALLEL_SECTIONS)
{
gfc_code *d = c->block;
@@ -1215,7 +1364,7 @@ show_omp_node (int level, gfc_code *c)
if (c->op == EXEC_OMP_ATOMIC)
return;
code_indent (level, 0);
- fprintf (dumpfile, "!$OMP END %s", name);
+ fprintf (dumpfile, "!$%s END %s", is_oacc ? "ACC" : "OMP", name);
if (omp_clauses != NULL)
{
if (omp_clauses->lists[OMP_LIST_COPYPRIVATE])
@@ -2194,6 +2343,18 @@ show_code_node (int level, gfc_code *c)
fprintf (dumpfile, " EOR=%d", dt->eor->value);
break;
+ case EXEC_OACC_PARALLEL_LOOP:
+ case EXEC_OACC_PARALLEL:
+ case EXEC_OACC_KERNELS_LOOP:
+ case EXEC_OACC_KERNELS:
+ case EXEC_OACC_DATA:
+ case EXEC_OACC_HOST_DATA:
+ case EXEC_OACC_LOOP:
+ case EXEC_OACC_UPDATE:
+ case EXEC_OACC_WAIT:
+ case EXEC_OACC_CACHE:
+ case EXEC_OACC_ENTER_DATA:
+ case EXEC_OACC_EXIT_DATA:
case EXEC_OMP_ATOMIC:
case EXEC_OMP_BARRIER:
case EXEC_OMP_CRITICAL:
@@ -2309,6 +2470,14 @@ show_namespace (gfc_namespace *ns)
for (eq = ns->equiv; eq; eq = eq->next)
show_equiv (eq);
+ if (ns->oacc_declare_clauses)
+ {
+ /* Dump !$ACC DECLARE clauses. */
+ show_indent ();
+ fprintf (dumpfile, "!$ACC DECLARE");
+ show_omp_clauses (ns->oacc_declare_clauses);
+ }
+
fputc ('\n', dumpfile);
show_indent ();
fputs ("code:", dumpfile);
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index bce53a4..e09393d 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -203,6 +203,12 @@ typedef enum
ST_WRITE, ST_ASSIGNMENT, ST_POINTER_ASSIGNMENT, ST_SELECT_CASE, ST_SEQUENCE,
ST_SIMPLE_IF, ST_STATEMENT_FUNCTION, ST_DERIVED_DECL, ST_LABEL_ASSIGNMENT,
ST_ENUM, ST_ENUMERATOR, ST_END_ENUM, ST_SELECT_TYPE, ST_TYPE_IS, ST_CLASS_IS,
+ ST_OACC_PARALLEL_LOOP, ST_OACC_END_PARALLEL_LOOP, ST_OACC_PARALLEL,
+ ST_OACC_END_PARALLEL, ST_OACC_KERNELS, ST_OACC_END_KERNELS, ST_OACC_DATA,
+ ST_OACC_END_DATA, ST_OACC_HOST_DATA, ST_OACC_END_HOST_DATA, ST_OACC_LOOP,
+ ST_OACC_END_LOOP, ST_OACC_DECLARE, ST_OACC_UPDATE, ST_OACC_WAIT,
+ ST_OACC_CACHE, ST_OACC_KERNELS_LOOP, ST_OACC_END_KERNELS_LOOP,
+ ST_OACC_ENTER_DATA, ST_OACC_EXIT_DATA,
ST_OMP_ATOMIC, ST_OMP_BARRIER, ST_OMP_CRITICAL, ST_OMP_END_ATOMIC,
ST_OMP_END_CRITICAL, ST_OMP_END_DO, ST_OMP_END_MASTER, ST_OMP_END_ORDERED,
ST_OMP_END_PARALLEL, ST_OMP_END_PARALLEL_DO, ST_OMP_END_PARALLEL_SECTIONS,
@@ -1025,6 +1031,16 @@ gfc_namelist;
#define gfc_get_namelist() XCNEW (gfc_namelist)
+/* Likewise to gfc_namelist, but contains expressions. */
+typedef struct gfc_expr_list
+{
+ struct gfc_expr *expr;
+ struct gfc_expr_list *next;
+}
+gfc_expr_list;
+
+#define gfc_get_expr_list() XCNEW (gfc_expr_list)
+
enum
{
OMP_LIST_PRIVATE,
@@ -1033,6 +1049,24 @@ enum
OMP_LIST_COPYPRIVATE,
OMP_LIST_SHARED,
OMP_LIST_COPYIN,
+ OMP_LIST_COPY,
+ OMP_LIST_DATA_CLAUSE_FIRST = OMP_LIST_COPY,
+ OMP_LIST_OACC_COPYIN,
+ OMP_LIST_COPYOUT,
+ OMP_LIST_CREATE,
+ OMP_LIST_DELETE,
+ OMP_LIST_PRESENT,
+ OMP_LIST_PRESENT_OR_COPY,
+ OMP_LIST_PRESENT_OR_COPYIN,
+ OMP_LIST_PRESENT_OR_COPYOUT,
+ OMP_LIST_PRESENT_OR_CREATE,
+ OMP_LIST_DEVICEPTR,
+ OMP_LIST_DATA_CLAUSE_LAST = OMP_LIST_DEVICEPTR,
+ OMP_LIST_DEVICE_RESIDENT,
+ OMP_LIST_USE_DEVICE,
+ OMP_LIST_HOST,
+ OMP_LIST_DEVICE,
+ OMP_LIST_CACHE,
OMP_LIST_PLUS,
OMP_LIST_REDUCTION_FIRST = OMP_LIST_PLUS,
OMP_LIST_MULT,
@@ -1083,6 +1117,28 @@ typedef struct gfc_omp_clauses
enum gfc_omp_default_sharing default_sharing;
int collapse;
bool nowait, ordered, untied, mergeable;
+
+ /* OpenACC. */
+ struct gfc_expr *async_expr;
+ struct gfc_expr *gang_expr;
+ struct gfc_expr *worker_expr;
+ struct gfc_expr *vector_expr;
+ struct gfc_expr *num_gangs_expr;
+ struct gfc_expr *num_workers_expr;
+ struct gfc_expr *vector_length_expr;
+ struct gfc_expr *non_clause_wait_expr;
+ gfc_expr_list *wait_list;
+ gfc_expr_list *tile_list;
+ unsigned async:1, gang:1, worker:1, vector:1, seq:1, independent:1;
+ unsigned wait:1, par_auto:1, gang_static:1;
+
+ /* Directive specific data. */
+ union
+ {
+ /* !$ACC DECLARE locus. */
+ locus loc;
+ }
+ ext;
}
gfc_omp_clauses;
@@ -1444,6 +1500,9 @@ typedef struct gfc_namespace
this namespace. */
struct gfc_data *data;
+ /* !$ACC DECLARE clauses. */
+ gfc_omp_clauses *oacc_declare_clauses;
+
gfc_charlen *cl_list, *old_cl_list;
gfc_dt_list *derived_types;
@@ -2102,6 +2161,10 @@ typedef enum
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_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_OMP_CRITICAL, EXEC_OMP_DO, EXEC_OMP_FLUSH, EXEC_OMP_MASTER,
EXEC_OMP_ORDERED, EXEC_OMP_PARALLEL, EXEC_OMP_PARALLEL_DO,
EXEC_OMP_PARALLEL_SECTIONS, EXEC_OMP_PARALLEL_WORKSHARE,
@@ -2743,6 +2806,11 @@ void gfc_resolve_omp_parallel_blocks (gfc_code *, gfc_namespace *);
void gfc_resolve_omp_do_blocks (gfc_code *, gfc_namespace *);
void gfc_omp_save_and_clear_state (struct gfc_omp_saved_state *);
void gfc_omp_restore_state (struct gfc_omp_saved_state *);
+void gfc_free_expr_list (gfc_expr_list *);
+void gfc_resolve_oacc_directive (gfc_code *, gfc_namespace *);
+void gfc_resolve_oacc_declare (gfc_namespace *);
+void gfc_resolve_oacc_parallel_loop_blocks (gfc_code *, gfc_namespace *);
+void gfc_resolve_oacc_blocks (gfc_code *, gfc_namespace *);
/* expr.c */
void gfc_free_actual_arglist (gfc_actual_arglist *);
diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c
index eda1bf3..34d1d56 100644
--- a/gcc/fortran/match.c
+++ b/gcc/fortran/match.c
@@ -2595,6 +2595,33 @@ match_exit_cycle (gfc_statement st, gfc_exec_op op)
if (cnt > 0
&& o != NULL
&& o->state == COMP_OMP_STRUCTURED_BLOCK
+ && (o->head->op == EXEC_OACC_LOOP
+ || o->head->op == EXEC_OACC_PARALLEL_LOOP))
+ {
+ int collapse = 1;
+ gcc_assert (o->head->next != NULL
+ && (o->head->next->op == EXEC_DO
+ || o->head->next->op == EXEC_DO_WHILE)
+ && o->previous != NULL
+ && o->previous->tail->op == o->head->op);
+ if (o->previous->tail->ext.omp_clauses != NULL
+ && o->previous->tail->ext.omp_clauses->collapse > 1)
+ collapse = o->previous->tail->ext.omp_clauses->collapse;
+ if (st == ST_EXIT && cnt <= collapse)
+ {
+ gfc_error ("EXIT statement at %C terminating !$ACC LOOP loop");
+ return MATCH_ERROR;
+ }
+ if (st == ST_CYCLE && cnt < collapse)
+ {
+ gfc_error ("CYCLE statement at %C to non-innermost collapsed"
+ " !$ACC LOOP loop");
+ return MATCH_ERROR;
+ }
+ }
+ if (cnt > 0
+ && o != NULL
+ && (o->state == COMP_OMP_STRUCTURED_BLOCK)
&& (o->head->op == EXEC_OMP_DO
|| o->head->op == EXEC_OMP_PARALLEL_DO))
{
diff --git a/gcc/fortran/match.h b/gcc/fortran/match.h
index 385e840..80ba44f 100644
--- a/gcc/fortran/match.h
+++ b/gcc/fortran/match.h
@@ -122,6 +122,21 @@ gfc_common_head *gfc_get_common (const char *, int);
/* openmp.c. */
+/* OpenACC directive matchers. */
+match gfc_match_oacc_cache (void);
+match gfc_match_oacc_wait (void);
+match gfc_match_oacc_update (void);
+match gfc_match_oacc_declare (void);
+match gfc_match_oacc_loop (void);
+match gfc_match_oacc_host_data (void);
+match gfc_match_oacc_data (void);
+match gfc_match_oacc_kernels (void);
+match gfc_match_oacc_kernels_loop (void);
+match gfc_match_oacc_parallel (void);
+match gfc_match_oacc_parallel_loop (void);
+match gfc_match_oacc_enter_data (void);
+match gfc_match_oacc_exit_data (void);
+
/* OpenMP directive matchers. */
match gfc_match_omp_eos (void);
match gfc_match_omp_atomic (void);
diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index d9af60e..bda79d2 100644
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -532,6 +532,91 @@ decode_statement (void)
}
static gfc_statement
+decode_oacc_directive (void)
+{
+ locus old_locus;
+ char c;
+
+ gfc_enforce_clean_symbol_state ();
+
+ gfc_clear_error (); /* Clear any pending errors. */
+ gfc_clear_warning (); /* Clear any pending warnings. */
+
+ if (gfc_pure (NULL))
+ {
+ gfc_error_now ("OpenACC directives at %C may not appear in PURE "
+ "procedures");
+ gfc_error_recovery ();
+ return ST_NONE;
+ }
+
+ if (gfc_implicit_pure (NULL))
+ gfc_current_ns->proc_name->attr.implicit_pure = 0;
+
+ old_locus = gfc_current_locus;
+
+ /* General OpenACC directive matching: Instead of testing every possible
+ statement, we eliminate most possibilities by peeking at the
+ first character. */
+
+ c = gfc_peek_ascii_char ();
+
+ switch (c)
+ {
+ case 'c':
+ match ("cache", gfc_match_oacc_cache, ST_OACC_CACHE);
+ break;
+ case 'd':
+ match ("data", gfc_match_oacc_data, ST_OACC_DATA);
+ match ("declare", gfc_match_oacc_declare, ST_OACC_DECLARE);
+ break;
+ case 'e':
+ match ("end data", gfc_match_omp_eos, ST_OACC_END_DATA);
+ match ("end host_data", gfc_match_omp_eos, ST_OACC_END_HOST_DATA);
+ match ("end kernels loop", gfc_match_omp_eos, ST_OACC_END_KERNELS_LOOP);
+ match ("end kernels", gfc_match_omp_eos, ST_OACC_END_KERNELS);
+ match ("end loop", gfc_match_omp_eos, ST_OACC_END_LOOP);
+ match ("end parallel loop", gfc_match_omp_eos, ST_OACC_END_PARALLEL_LOOP);
+ match ("end parallel", gfc_match_omp_eos, ST_OACC_END_PARALLEL);
+ match ("enter data", gfc_match_oacc_enter_data, ST_OACC_ENTER_DATA);
+ match ("exit data", gfc_match_oacc_exit_data, ST_OACC_EXIT_DATA);
+ break;
+ case 'h':
+ match ("host_data", gfc_match_oacc_host_data, ST_OACC_HOST_DATA);
+ break;
+ case 'p':
+ match ("parallel loop", gfc_match_oacc_parallel_loop, ST_OACC_PARALLEL_LOOP);
+ match ("parallel", gfc_match_oacc_parallel, ST_OACC_PARALLEL);
+ break;
+ case 'k':
+ match ("kernels loop", gfc_match_oacc_kernels_loop, ST_OACC_KERNELS_LOOP);
+ match ("kernels", gfc_match_oacc_kernels, ST_OACC_KERNELS);
+ break;
+ case 'l':
+ match ("loop", gfc_match_oacc_loop, ST_OACC_LOOP);
+ break;
+ case 'u':
+ match ("update", gfc_match_oacc_update, ST_OACC_UPDATE);
+ break;
+ case 'w':
+ match ("wait", gfc_match_oacc_wait, ST_OACC_WAIT);
+ break;
+ }
+
+ /* Directive not found or stored an error message.
+ Check and give up. */
+
+ if (gfc_error_check () == 0)
+ gfc_error_now ("Unclassifiable OpenACC directive at %C");
+
+ reject_statement ();
+
+ gfc_error_recovery ();
+
+ return ST_NONE;
+}
+
+static gfc_statement
decode_omp_directive (void)
{
locus old_locus;
@@ -668,6 +753,23 @@ decode_gcc_attribute (void)
#undef match
+/* Assert next length characters to be equal to token in free form. */
+
+static void
+verify_token_free (const char* token, int length, bool last_was_use_stmt)
+{
+ int i;
+ char c;
+
+ c = gfc_next_ascii_char ();
+ for (i = 0; i < length; i++, c = gfc_next_ascii_char ())
+ gcc_assert (c == token[i]);
+
+ gcc_assert (gfc_is_whitespace(c));
+ gfc_gobble_whitespace ();
+ if (last_was_use_stmt)
+ use_modules ();
+}
/* Get the next statement in free form source. */
@@ -737,7 +839,7 @@ next_free (void)
else if (c == '!')
{
/* Comments have already been skipped by the time we get here,
- except for GCC attributes and OpenMP directives. */
+ except for GCC attributes and OpenMP/OpenACC directives. */
gfc_next_ascii_char (); /* Eat up the exclamation sign. */
c = gfc_peek_ascii_char ();
@@ -754,21 +856,38 @@ next_free (void)
return decode_gcc_attribute ();
}
- else if (c == '$' && gfc_option.gfc_flag_openmp)
+
+ else if (c == '$')
{
- int i;
-
- c = gfc_next_ascii_char ();
- for (i = 0; i < 4; i++, c = gfc_next_ascii_char ())
- gcc_assert (c == "$omp"[i]);
+ /* Since both OpenMP and OpenACC directives starts with
+ !$ character sequence, we must check all flags combinations */
+ if (gfc_option.gfc_flag_openmp && !gfc_option.gfc_flag_openacc)
+ {
+ verify_token_free ("$omp", 4, last_was_use_stmt);
+ return decode_omp_directive ();
+ }
+ else if (gfc_option.gfc_flag_openmp && gfc_option.gfc_flag_openacc)
+ {
+ gfc_next_ascii_char (); /* Eat up dollar character */
+ c = gfc_peek_ascii_char ();
- gcc_assert (c == ' ' || c == '\t');
- gfc_gobble_whitespace ();
- if (last_was_use_stmt)
- use_modules ();
- return decode_omp_directive ();
+ if (c == 'o')
+ {
+ verify_token_free ("omp", 3, last_was_use_stmt);
+ return decode_omp_directive ();
+ }
+ else if (c == 'a')
+ {
+ verify_token_free ("acc", 3, last_was_use_stmt);
+ return decode_oacc_directive ();
+ }
+ }
+ else if (gfc_option.gfc_flag_openacc)
+ {
+ verify_token_free ("$acc", 4, last_was_use_stmt);
+ return decode_oacc_directive ();
+ }
}
-
gcc_unreachable ();
}
@@ -784,6 +903,28 @@ next_free (void)
return decode_statement ();
}
+/* Assert next length characters to be equal to token in fixed form. */
+
+static bool
+verify_token_fixed (const char *token, int length, bool last_was_use_stmt)
+{
+ int i;
+ char c = gfc_next_char_literal (NONSTRING);
+
+ for (i = 0; i < length; i++, c = gfc_next_char_literal (NONSTRING))
+ gcc_assert ((char) gfc_wide_tolower (c) == token[i]);
+
+ if (c != ' ' && c != '0')
+ {
+ gfc_buffer_error (0);
+ gfc_error ("Bad continuation line at %C");
+ return false;
+ }
+ if (last_was_use_stmt)
+ use_modules ();
+
+ return true;
+}
/* Get the next statement in fixed-form source. */
@@ -843,21 +984,38 @@ next_fixed (void)
return decode_gcc_attribute ();
}
- else if (c == '$' && gfc_option.gfc_flag_openmp)
- {
- for (i = 0; i < 4; i++, c = gfc_next_char_literal (NONSTRING))
- gcc_assert ((char) gfc_wide_tolower (c) == "$omp"[i]);
-
- if (c != ' ' && c != '0')
- {
- gfc_buffer_error (0);
- gfc_error ("Bad continuation line at %C");
+ else if (c == '$')
+ {
+ if (gfc_option.gfc_flag_openmp && !gfc_option.gfc_flag_openacc)
+ {
+ if (!verify_token_fixed ("omp", 3, last_was_use_stmt))
+ return ST_NONE;
+ return decode_omp_directive ();
+ }
+ else if (gfc_option.gfc_flag_openmp
+ && gfc_option.gfc_flag_openacc)
+ {
+ c = gfc_next_char_literal(NONSTRING);
+ if (c == 'o' || c == 'O')
+ {
+ if (!verify_token_fixed ("mp", 2, last_was_use_stmt))
return ST_NONE;
- }
- if (last_was_use_stmt)
- use_modules ();
- return decode_omp_directive ();
- }
+ return decode_omp_directive ();
+ }
+ else if (c == 'a' || c == 'A')
+ {
+ if (!verify_token_fixed ("cc", 2, last_was_use_stmt))
+ return ST_NONE;
+ return decode_oacc_directive ();
+ }
+ }
+ else if (gfc_option.gfc_flag_openacc)
+ {
+ if (!verify_token_fixed ("acc", 3, last_was_use_stmt))
+ return ST_NONE;
+ return decode_oacc_directive ();
+ }
+ }
/* FALLTHROUGH */
/* Comments have already been skipped by the time we get
@@ -1015,7 +1173,9 @@ next_statement (void)
case ST_LABEL_ASSIGNMENT: case ST_FLUSH: case ST_OMP_FLUSH: \
case ST_OMP_BARRIER: case ST_OMP_TASKWAIT: case ST_OMP_TASKYIELD: \
case ST_ERROR_STOP: case ST_SYNC_ALL: case ST_SYNC_IMAGES: \
- case ST_SYNC_MEMORY: case ST_LOCK: case ST_UNLOCK
+ case ST_SYNC_MEMORY: case ST_LOCK: case ST_UNLOCK: case ST_OACC_UPDATE: \
+ case ST_OACC_WAIT: case ST_OACC_CACHE: case ST_OACC_ENTER_DATA: \
+ case ST_OACC_EXIT_DATA
/* Statements that mark other executable statements. */
@@ -1027,7 +1187,9 @@ next_statement (void)
case ST_OMP_CRITICAL: case ST_OMP_MASTER: case ST_OMP_SINGLE: \
case ST_OMP_DO: case ST_OMP_PARALLEL_DO: case ST_OMP_ATOMIC: \
case ST_OMP_WORKSHARE: case ST_OMP_PARALLEL_WORKSHARE: \
- case ST_OMP_TASK: case ST_CRITICAL
+ case ST_OMP_TASK: case ST_CRITICAL: \
+ case ST_OACC_PARALLEL_LOOP: case ST_OACC_PARALLEL: case ST_OACC_KERNELS: \
+ case ST_OACC_DATA: case ST_OACC_HOST_DATA: case ST_OACC_LOOP: case ST_OACC_KERNELS_LOOP
/* Declaration statements */
@@ -1054,6 +1216,8 @@ push_state (gfc_state_data *p, gfc_compile_state new_state, gfc_symbol *sym)
p->sym = sym;
p->head = p->tail = NULL;
p->do_variable = NULL;
+ if (p->state != COMP_DO && p->state != COMP_DO_CONCURRENT)
+ p->ext.oacc_declare_clauses = NULL;
/* If this the state of a construct like BLOCK, DO or IF, the corresponding
construct statement was accepted right before pushing the state. Thus,
@@ -1519,6 +1683,66 @@ gfc_ascii_statement (gfc_statement st)
case ST_END_ENUM:
p = "END ENUM";
break;
+ case ST_OACC_PARALLEL_LOOP:
+ p = "!$ACC PARALLEL LOOP";
+ break;
+ case ST_OACC_END_PARALLEL_LOOP:
+ p = "!$ACC END PARALLEL LOOP";
+ break;
+ case ST_OACC_PARALLEL:
+ p = "!$ACC PARALLEL";
+ break;
+ case ST_OACC_END_PARALLEL:
+ p = "!$ACC END PARALLEL";
+ break;
+ case ST_OACC_KERNELS:
+ p = "!$ACC KERNELS";
+ break;
+ case ST_OACC_END_KERNELS:
+ p = "!$ACC END KERNELS";
+ break;
+ case ST_OACC_KERNELS_LOOP:
+ p = "!$ACC KERNELS LOOP";
+ break;
+ case ST_OACC_END_KERNELS_LOOP:
+ p = "!$ACC END KERNELS LOOP";
+ break;
+ case ST_OACC_DATA:
+ p = "!$ACC DATA";
+ break;
+ case ST_OACC_END_DATA:
+ p = "!$ACC END DATA";
+ break;
+ case ST_OACC_HOST_DATA:
+ p = "!$ACC HOST_DATA";
+ break;
+ case ST_OACC_END_HOST_DATA:
+ p = "!$ACC END HOST_DATA";
+ break;
+ case ST_OACC_LOOP:
+ p = "!$ACC LOOP";
+ break;
+ case ST_OACC_END_LOOP:
+ p = "!$ACC END LOOP";
+ break;
+ case ST_OACC_DECLARE:
+ p = "!$ACC DECLARE";
+ break;
+ case ST_OACC_UPDATE:
+ p = "!$ACC UPDATE";
+ break;
+ case ST_OACC_WAIT:
+ p = "!$ACC WAIT";
+ break;
+ case ST_OACC_CACHE:
+ p = "!$ACC CACHE";
+ break;
+ case ST_OACC_ENTER_DATA:
+ p = "!$ACC ENTER DATA";
+ break;
+ case ST_OACC_EXIT_DATA:
+ p = "!$ACC EXIT DATA";
+ break;
case ST_OMP_ATOMIC:
p = "!$OMP ATOMIC";
break;
@@ -1883,6 +2107,7 @@ verify_st_order (st_state *p, gfc_statement st, bool silent)
case ST_PUBLIC:
case ST_PRIVATE:
case ST_DERIVED_DECL:
+ case ST_OACC_DECLARE:
case_decl:
if (p->state >= ORDER_EXEC)
goto order;
@@ -2784,6 +3009,19 @@ declSt:
st = next_statement ();
goto loop;
+ case ST_OACC_DECLARE:
+ if (!verify_st_order(&ss, st, false))
+ {
+ reject_statement ();
+ st = next_statement ();
+ goto loop;
+ }
+ if (gfc_state_stack->ext.oacc_declare_clauses == NULL)
+ gfc_state_stack->ext.oacc_declare_clauses = new_st.ext.omp_clauses;
+ accept_statement (st);
+ st = next_statement ();
+ goto loop;
+
default:
break;
}
@@ -3274,9 +3512,13 @@ static void
parse_critical_block (void)
{
gfc_code *top, *d;
- gfc_state_data s;
+ gfc_state_data s, *sd;
gfc_statement st;
+ for (sd = gfc_state_stack; sd; sd = sd->previous)
+ if (sd->state == COMP_OMP_STRUCTURED_BLOCK)
+ gfc_error_now ("CRITICAL block inside of OpenMP or OpenACC region at %C");
+
s.ext.end_do_label = new_st.label1;
accept_statement (ST_CRITICAL);
@@ -3643,6 +3885,128 @@ parse_omp_atomic (void)
}
+/* Parse the statements of an OpenACC structured block. */
+
+static void
+parse_oacc_structured_block (gfc_statement acc_st)
+{
+ gfc_statement st, acc_end_st;
+ gfc_code *cp, *np;
+ gfc_state_data s, *sd;
+
+ for (sd = gfc_state_stack; sd; sd = sd->previous)
+ if (sd->state == COMP_CRITICAL)
+ gfc_error_now ("OpenACC directive inside of CRITICAL block at %C");
+
+ accept_statement (acc_st);
+
+ cp = gfc_state_stack->tail;
+ push_state (&s, COMP_OMP_STRUCTURED_BLOCK, NULL);
+ np = new_level (cp);
+ np->op = cp->op;
+ np->block = NULL;
+ switch (acc_st)
+ {
+ case ST_OACC_PARALLEL:
+ acc_end_st = ST_OACC_END_PARALLEL;
+ break;
+ case ST_OACC_KERNELS:
+ acc_end_st = ST_OACC_END_KERNELS;
+ break;
+ case ST_OACC_DATA:
+ acc_end_st = ST_OACC_END_DATA;
+ break;
+ case ST_OACC_HOST_DATA:
+ acc_end_st = ST_OACC_END_HOST_DATA;
+ break;
+ default:
+ gcc_unreachable ();
+ }
+
+ do
+ {
+ st = parse_executable (ST_NONE);
+ if (st == ST_NONE)
+ unexpected_eof ();
+ else if (st != acc_end_st)
+ gfc_error ("Expecting %s at %C", gfc_ascii_statement (acc_end_st));
+ reject_statement ();
+ }
+ while (st != acc_end_st);
+
+ gcc_assert (new_st.op == EXEC_NOP);
+
+ gfc_clear_new_st ();
+ gfc_commit_symbols ();
+ gfc_warning_check ();
+ pop_state ();
+}
+
+/* Parse the statements of OpenACC loop/parallel loop/kernels loop. */
+
+static gfc_statement
+parse_oacc_loop (gfc_statement acc_st)
+{
+ gfc_statement st;
+ gfc_code *cp, *np;
+ gfc_state_data s, *sd;
+
+ for (sd = gfc_state_stack; sd; sd = sd->previous)
+ if (sd->state == COMP_CRITICAL)
+ gfc_error_now ("OpenACC directive inside of CRITICAL block at %C");
+
+ accept_statement (acc_st);
+
+ cp = gfc_state_stack->tail;
+ push_state (&s, COMP_OMP_STRUCTURED_BLOCK, NULL);
+ np = new_level (cp);
+ np->op = cp->op;
+ np->block = NULL;
+
+ for (;;)
+ {
+ st = next_statement ();
+ if (st == ST_NONE)
+ unexpected_eof ();
+ else if (st == ST_DO)
+ break;
+ else
+ {
+ gfc_error ("Expected DO loop at %C");
+ reject_statement ();
+ }
+ }
+
+ parse_do_block ();
+ if (gfc_statement_label != NULL
+ && gfc_state_stack->previous != NULL
+ && gfc_state_stack->previous->state == COMP_DO
+ && gfc_state_stack->previous->ext.end_do_label == gfc_statement_label)
+ {
+ pop_state ();
+ return ST_IMPLIED_ENDDO;
+ }
+
+ check_do_closure ();
+ pop_state ();
+
+ st = next_statement ();
+ if (st == ST_OACC_END_LOOP)
+ gfc_warning ("Redundant !$ACC END LOOP at %C");
+ if ((acc_st == ST_OACC_PARALLEL_LOOP && st == ST_OACC_END_PARALLEL_LOOP) ||
+ (acc_st == ST_OACC_KERNELS_LOOP && st == ST_OACC_END_KERNELS_LOOP) ||
+ (acc_st == ST_OACC_LOOP && st == ST_OACC_END_LOOP))
+ {
+ gcc_assert (new_st.op == EXEC_NOP);
+ gfc_clear_new_st ();
+ gfc_commit_symbols ();
+ gfc_warning_check ();
+ st = next_statement ();
+ }
+ return st;
+}
+
+
/* Parse the statements of an OpenMP structured block. */
static void
@@ -3910,6 +4274,21 @@ parse_executable (gfc_statement st)
parse_forall_block ();
break;
+ case ST_OACC_PARALLEL_LOOP:
+ case ST_OACC_KERNELS_LOOP:
+ case ST_OACC_LOOP:
+ st = parse_oacc_loop (st);
+ if (st == ST_IMPLIED_ENDDO)
+ return st;
+ continue;
+
+ case ST_OACC_PARALLEL:
+ case ST_OACC_KERNELS:
+ case ST_OACC_DATA:
+ case ST_OACC_HOST_DATA:
+ parse_oacc_structured_block (st);
+ break;
+
case ST_OMP_PARALLEL:
case ST_OMP_PARALLEL_SECTIONS:
case ST_OMP_SECTIONS:
@@ -4220,6 +4599,13 @@ contains:
done:
gfc_current_ns->code = gfc_state_stack->head;
+ if (gfc_state_stack->state == COMP_PROGRAM
+ || gfc_state_stack->state == COMP_MODULE
+ || gfc_state_stack->state == COMP_SUBROUTINE
+ || gfc_state_stack->state == COMP_FUNCTION
+ || gfc_state_stack->state == COMP_BLOCK)
+ gfc_current_ns->oacc_declare_clauses
+ = gfc_state_stack->ext.oacc_declare_clauses;
}
diff --git a/gcc/fortran/parse.h b/gcc/fortran/parse.h
index 44b8f8b..be09a97 100644
--- a/gcc/fortran/parse.h
+++ b/gcc/fortran/parse.h
@@ -49,6 +49,7 @@ typedef struct gfc_state_data
union
{
gfc_st_label *end_do_label;
+ gfc_omp_clauses *oacc_declare_clauses;
}
ext;
}
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 69ec7bf..f685d49 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -8982,6 +8982,18 @@ gfc_resolve_blocks (gfc_code *b, gfc_namespace *ns)
case EXEC_WAIT:
break;
+ case EXEC_OACC_PARALLEL_LOOP:
+ case EXEC_OACC_PARALLEL:
+ case EXEC_OACC_KERNELS_LOOP:
+ case EXEC_OACC_KERNELS:
+ case EXEC_OACC_DATA:
+ case EXEC_OACC_HOST_DATA:
+ case EXEC_OACC_LOOP:
+ case EXEC_OACC_UPDATE:
+ case EXEC_OACC_WAIT:
+ case EXEC_OACC_CACHE:
+ case EXEC_OACC_ENTER_DATA:
+ case EXEC_OACC_EXIT_DATA:
case EXEC_OMP_ATOMIC:
case EXEC_OMP_CRITICAL:
case EXEC_OMP_DO:
@@ -9731,6 +9743,15 @@ resolve_code (gfc_code *code, gfc_namespace *ns)
omp_workshare_save = -1;
switch (code->op)
{
+ case EXEC_OACC_PARALLEL_LOOP:
+ case EXEC_OACC_PARALLEL:
+ case EXEC_OACC_KERNELS_LOOP:
+ case EXEC_OACC_KERNELS:
+ case EXEC_OACC_DATA:
+ case EXEC_OACC_HOST_DATA:
+ case EXEC_OACC_LOOP:
+ gfc_resolve_oacc_blocks (code, ns);
+ break;
case EXEC_OMP_PARALLEL_WORKSHARE:
omp_workshare_save = omp_workshare_flag;
omp_workshare_flag = 1;
@@ -10057,6 +10078,21 @@ resolve_code (gfc_code *code, gfc_namespace *ns)
"expression", &code->expr1->where);
break;
+ case EXEC_OACC_PARALLEL_LOOP:
+ case EXEC_OACC_PARALLEL:
+ case EXEC_OACC_KERNELS_LOOP:
+ case EXEC_OACC_KERNELS:
+ case EXEC_OACC_DATA:
+ case EXEC_OACC_HOST_DATA:
+ case EXEC_OACC_LOOP:
+ case EXEC_OACC_UPDATE:
+ case EXEC_OACC_WAIT:
+ case EXEC_OACC_CACHE:
+ case EXEC_OACC_ENTER_DATA:
+ case EXEC_OACC_EXIT_DATA:
+ gfc_resolve_oacc_directive (code, ns);
+ break;
+
case EXEC_OMP_ATOMIC:
case EXEC_OMP_BARRIER:
case EXEC_OMP_CRITICAL:
@@ -14559,6 +14595,7 @@ resolve_codes (gfc_namespace *ns)
old_obstack = labels_obstack;
bitmap_obstack_initialize (&labels_obstack);
+ gfc_resolve_oacc_declare (ns);
resolve_code (ns->code, ns);
bitmap_obstack_release (&labels_obstack);
diff --git a/gcc/fortran/scanner.c b/gcc/fortran/scanner.c
index 8f51734..5e138e8 100644
--- a/gcc/fortran/scanner.c
+++ b/gcc/fortran/scanner.c
@@ -55,9 +55,11 @@ gfc_directorylist *include_dirs, *intrinsic_modules_dirs;
static gfc_file *file_head, *current_file;
-static int continue_flag, end_flag, openmp_flag, gcc_attribute_flag;
+static int continue_flag, end_flag, gcc_attribute_flag;
+static int openmp_flag, openacc_flag; /* If !$omp/!$acc occurred in current comment line */
static int continue_count, continue_line;
static locus openmp_locus;
+static locus openacc_locus;
static locus gcc_attribute_locus;
gfc_source_form gfc_current_form;
@@ -710,11 +712,89 @@ skip_gcc_attribute (locus start)
return r;
}
+/* Return true if CC was matched. */
+static bool
+skip_oacc_attribute (locus start, locus old_loc, bool continue_flag)
+{
+ bool r = false;
+ char c;
+
+ if ((c = next_char ()) == 'c' || c == 'C')
+ if ((c = next_char ()) == 'c' || c == 'C')
+ r = true;
+ if (r)
+ {
+ if ((c = next_char ()) == ' ' || c == '\t'
+ || continue_flag)
+ {
+ while (gfc_is_whitespace (c))
+ c = next_char ();
+ if (c != '\n' && c != '!')
+ {
+ openacc_flag = 1;
+ openacc_locus = old_loc;
+ gfc_current_locus = start;
+ }
+ else
+ r = false;
+ }
+ else
+ {
+ gfc_warning_now ("!$ACC at %C starts a commented "
+ "line as it neither is followed "
+ "by a space nor is a "
+ "continuation line");
+ r = false;
+ }
+ }
+
+ return r;
+}
+
+/* Return true if MP was matched. */
+static bool
+skip_omp_attribute (locus start, locus old_loc, bool continue_flag)
+{
+ bool r = false;
+ char c;
+
+ if ((c = next_char ()) == 'm' || c == 'M')
+ if ((c = next_char ()) == 'p' || c == 'P')
+ r = true;
+
+ if (r)
+ {
+ if ((c = next_char ()) == ' ' || c == '\t'
+ || continue_flag)
+ {
+ while (gfc_is_whitespace (c))
+ c = next_char ();
+ if (c != '\n' && c != '!')
+ {
+ openmp_flag = 1;
+ openmp_locus = old_loc;
+ gfc_current_locus = start;
+ }
+ else
+ r = false;
+ }
+ else
+ {
+ gfc_warning_now ("!$OMP at %C starts a commented "
+ "line as it neither is followed "
+ "by a space nor is a "
+ "continuation line");
+ r = false;
+ }
+ }
+
+ return r;
+}
/* Comment lines are null lines, lines containing only blanks or lines
on which the first nonblank line is a '!'.
- Return true if !$ openmp conditional compilation sentinel was
+ Return true if !$ openmp or openacc conditional compilation sentinel was
seen. */
static bool
@@ -747,55 +827,95 @@ skip_free_comments (void)
if (at_bol && skip_gcc_attribute (start))
return false;
- /* If -fopenmp, we need to handle here 2 things:
- 1) don't treat !$omp as comments, but directives
- 2) handle OpenMP conditional compilation, where
+ /* If -fopenmp/-fopenacc, we need to handle here 2 things:
+ 1) don't treat !$omp/!$acc as comments, but directives
+ 2) handle OpenMP/OpenACC conditional compilation, where
!$ should be treated as 2 spaces (for initial lines
only if followed by space). */
- if (gfc_option.gfc_flag_openmp && at_bol)
- {
- locus old_loc = gfc_current_locus;
- if (next_char () == '$')
- {
- c = next_char ();
- if (c == 'o' || c == 'O')
- {
- if (((c = next_char ()) == 'm' || c == 'M')
- && ((c = next_char ()) == 'p' || c == 'P'))
+ if (at_bol)
+ {
+ if (gfc_option.gfc_flag_openmp && gfc_option.gfc_flag_openacc)
+ {
+ locus old_loc = gfc_current_locus;
+ if (next_char () == '$')
+ {
+ c = next_char ();
+ if (c == 'o' || c == 'O')
+ {
+ if (skip_omp_attribute (start, old_loc, continue_flag))
+ return false;
+ gfc_current_locus = old_loc;
+ next_char ();
+ c = next_char ();
+ }
+ else if (c == 'a' || c == 'A')
+ {
+ if (skip_oacc_attribute (start, old_loc, continue_flag))
+ return false;
+ gfc_current_locus = old_loc;
+ next_char ();
+ c = next_char ();
+ }
+ if (continue_flag || c == ' ' || c == '\t')
+ {
+ gfc_current_locus = old_loc;
+ next_char ();
+ openmp_flag = openacc_flag = 0;
+ return true;
+ }
+ }
+ gfc_current_locus = old_loc;
+ }
+ else if (gfc_option.gfc_flag_openmp && !gfc_option.gfc_flag_openacc)
+ {
+ locus old_loc = gfc_current_locus;
+ if (next_char () == '$')
+ {
+ c = next_char ();
+ if (c == 'o' || c == 'O')
+ {
+ if (skip_omp_attribute (start, old_loc, continue_flag))
+ return false;
+ gfc_current_locus = old_loc;
+ next_char ();
+ c = next_char ();
+ }
+ if (continue_flag || c == ' ' || c == '\t')
+ {
+ gfc_current_locus = old_loc;
+ next_char ();
+ openmp_flag = 0;
+ return true;
+ }
+ }
+ gfc_current_locus = old_loc;
+ }
+ else if (gfc_option.gfc_flag_openacc && !gfc_option.gfc_flag_openmp)
+ {
+ locus old_loc = gfc_current_locus;
+ if (next_char() == '$')
+ {
+ c = next_char();
+ if (c == 'a' || c == 'A')
{
- if ((c = next_char ()) == ' ' || c == '\t'
- || continue_flag)
- {
- while (gfc_is_whitespace (c))
- c = next_char ();
- if (c != '\n' && c != '!')
- {
- openmp_flag = 1;
- openmp_locus = old_loc;
- gfc_current_locus = start;
- return false;
- }
- }
- else
- gfc_warning_now ("!$OMP at %C starts a commented "
- "line as it neither is followed "
- "by a space nor is a "
- "continuation line");
+ if (skip_oacc_attribute (start, old_loc,
+ continue_flag))
+ return false;
+ gfc_current_locus = old_loc;
+ next_char();
+ c = next_char();
}
- gfc_current_locus = old_loc;
- next_char ();
- c = next_char ();
- }
- if (continue_flag || c == ' ' || c == '\t')
- {
- gfc_current_locus = old_loc;
- next_char ();
- openmp_flag = 0;
- return true;
- }
- }
- gfc_current_locus = old_loc;
- }
+ if (continue_flag || c == ' ' || c == '\t')
+ {
+ gfc_current_locus = old_loc;
+ next_char();
+ openacc_flag = 0;
+ return true;
+ }
+ }
+ gfc_current_locus = old_loc;
+ }
+ }
skip_comment_line ();
continue;
}
@@ -806,6 +926,9 @@ skip_free_comments (void)
if (openmp_flag && at_bol)
openmp_flag = 0;
+ if (openacc_flag && at_bol)
+ openacc_flag = 0;
+
gcc_attribute_flag = 0;
gfc_current_locus = start;
return false;
@@ -868,9 +991,10 @@ skip_fixed_comments (void)
return;
}
- /* If -fopenmp, we need to handle here 2 things:
- 1) don't treat !$omp|c$omp|*$omp as comments, but directives
- 2) handle OpenMP conditional compilation, where
+ /* If -fopenmp/-fopenacc, we need to handle here 2 things:
+ 1) don't treat !$omp/!$acc|c$omp/c$acc|*$omp / *$acc as comments,
+ but directives
+ 2) handle OpenMP/OpenACC conditional compilation, where
!$|c$|*$ should be treated as 2 spaces if the characters
in columns 3 to 6 are valid fixed form label columns
characters. */
@@ -937,6 +1061,67 @@ skip_fixed_comments (void)
}
gfc_current_locus = start;
}
+
+ if (gfc_option.gfc_flag_openacc)
+ {
+ if (next_char () == '$')
+ {
+ c = next_char ();
+ if (c == 'a' || c == 'A')
+ {
+ if (((c = next_char ()) == 'c' || c == 'C')
+ && ((c = next_char ()) == 'c' || c == 'C'))
+ {
+ c = next_char ();
+ if (c != '\n'
+ && ((openacc_flag && continue_flag)
+ || c == ' ' || c == '\t' || c == '0'))
+ {
+ do
+ c = next_char ();
+ while (gfc_is_whitespace (c));
+ if (c != '\n' && c != '!')
+ {
+ /* Canonicalize to *$acc. */
+ *start.nextc = '*';
+ openacc_flag = 1;
+ gfc_current_locus = start;
+ return;
+ }
+ }
+ }
+ }
+ else
+ {
+ int digit_seen = 0;
+
+ for (col = 3; col < 6; col++, c = next_char ())
+ if (c == ' ')
+ continue;
+ else if (c == '\t')
+ {
+ col = 6;
+ break;
+ }
+ else if (c < '0' || c > '9')
+ break;
+ else
+ digit_seen = 1;
+
+ if (col == 6 && c != '\n'
+ && ((continue_flag && !digit_seen)
+ || c == ' ' || c == '\t' || c == '0'))
+ {
+ gfc_current_locus = start;
+ start.nextc[0] = ' ';
+ start.nextc[1] = ' ';
+ continue;
+ }
+ }
+ }
+ gfc_current_locus = start;
+ }
+
skip_comment_line ();
continue;
}
@@ -1007,10 +1192,11 @@ gfc_char_t
gfc_next_char_literal (gfc_instring in_string)
{
locus old_loc;
- int i, prev_openmp_flag;
+ int i, prev_openmp_flag, prev_openacc_flag;
gfc_char_t c;
continue_flag = 0;
+ prev_openacc_flag = prev_openmp_flag = 0;
restart:
c = next_char ();
@@ -1036,6 +1222,11 @@ restart:
sizeof (gfc_current_locus)) == 0)
goto done;
+ if (openacc_flag
+ && memcmp (&gfc_current_locus, &openacc_locus,
+ sizeof (gfc_current_locus)) == 0)
+ goto done;
+
/* This line can't be continued */
do
{
@@ -1090,7 +1281,11 @@ restart:
goto done;
}
- prev_openmp_flag = openmp_flag;
+ if (gfc_option.gfc_flag_openmp)
+ prev_openmp_flag = openmp_flag;
+ if (gfc_option.gfc_flag_openacc)
+ prev_openacc_flag = openacc_flag;
+
continue_flag = 1;
if (c == '!')
skip_comment_line ();
@@ -1120,13 +1315,23 @@ restart:
&& continue_line < gfc_linebuf_linenum (gfc_current_locus.lb))
continue_line = gfc_linebuf_linenum (gfc_current_locus.lb);
- if (prev_openmp_flag != openmp_flag)
- {
- gfc_current_locus = old_loc;
- openmp_flag = prev_openmp_flag;
- c = '&';
- goto done;
- }
+ if (gfc_option.gfc_flag_openmp)
+ if (prev_openmp_flag != openmp_flag)
+ {
+ gfc_current_locus = old_loc;
+ openmp_flag = prev_openmp_flag;
+ c = '&';
+ goto done;
+ }
+
+ if (gfc_option.gfc_flag_openacc)
+ if (prev_openacc_flag != openacc_flag)
+ {
+ gfc_current_locus = old_loc;
+ openacc_flag = prev_openacc_flag;
+ c = '&';
+ goto done;
+ }
/* Now that we have a non-comment line, probe ahead for the
first non-whitespace character. If it is another '&', then
@@ -1150,6 +1355,17 @@ restart:
while (gfc_is_whitespace (c))
c = next_char ();
}
+ if (openacc_flag)
+ {
+ for (i = 0; i < 5; i++, c = next_char ())
+ {
+ gcc_assert(gfc_wide_tolower (c) == (unsigned char) "!$acc"[i]);
+ if (i == 4)
+ old_loc = gfc_current_locus;
+ }
+ while (gfc_is_whitespace (c))
+ c = next_char ();
+ }
if (c != '&')
{
@@ -1162,7 +1378,7 @@ restart:
}
/* Both !$omp and !$ -fopenmp continuation lines have & on the
continuation line only optionally. */
- else if (openmp_flag || openmp_cond_flag)
+ else if (openmp_flag || openacc_flag || openmp_cond_flag)
gfc_current_locus.nextc--;
else
{
@@ -1199,7 +1415,11 @@ restart:
gfc_warning_now ("Line truncated at %L", &gfc_current_locus);
}
- prev_openmp_flag = openmp_flag;
+ if (gfc_option.gfc_flag_openmp)
+ prev_openmp_flag = openmp_flag;
+ if (gfc_option.gfc_flag_openacc)
+ prev_openacc_flag = openacc_flag;
+
continue_flag = 1;
old_loc = gfc_current_locus;
@@ -1207,26 +1427,40 @@ restart:
skip_fixed_comments ();
/* See if this line is a continuation line. */
- if (openmp_flag != prev_openmp_flag)
- {
- openmp_flag = prev_openmp_flag;
- goto not_continuation;
- }
+ if (gfc_option.gfc_flag_openmp)
+ if (openmp_flag != prev_openmp_flag)
+ {
+ openmp_flag = prev_openmp_flag;
+ goto not_continuation;
+ }
+ if (gfc_option.gfc_flag_openacc)
+ if (openacc_flag != prev_openacc_flag)
+ {
+ openacc_flag = prev_openacc_flag;
+ goto not_continuation;
+ }
- if (!openmp_flag)
+ if (!openmp_flag && !openacc_flag)
for (i = 0; i < 5; i++)
{
c = next_char ();
if (c != ' ')
goto not_continuation;
}
- else
+ else if (openmp_flag)
for (i = 0; i < 5; i++)
{
c = next_char ();
if (gfc_wide_tolower (c) != (unsigned char) "*$omp"[i])
goto not_continuation;
}
+ else if (openacc_flag)
+ for (i = 0; i > 5; i++)
+ {
+ c = next_char ();
+ if (gfc_wide_tolower (c) != (unsigned char) "*$omp"[i])
+ goto not_continuation;
+ }
c = next_char ();
if (c == '0' || c == ' ' || c == '\n')
diff --git a/gcc/fortran/st.c b/gcc/fortran/st.c
index 0e1cc70..b582efe 100644
--- a/gcc/fortran/st.c
+++ b/gcc/fortran/st.c
@@ -185,6 +185,18 @@ gfc_free_statement (gfc_code *p)
gfc_free_forall_iterator (p->ext.forall_iterator);
break;
+ case EXEC_OACC_PARALLEL_LOOP:
+ case EXEC_OACC_PARALLEL:
+ case EXEC_OACC_KERNELS_LOOP:
+ case EXEC_OACC_KERNELS:
+ case EXEC_OACC_DATA:
+ case EXEC_OACC_HOST_DATA:
+ case EXEC_OACC_LOOP:
+ case EXEC_OACC_UPDATE:
+ case EXEC_OACC_WAIT:
+ case EXEC_OACC_CACHE:
+ case EXEC_OACC_ENTER_DATA:
+ case EXEC_OACC_EXIT_DATA:
case EXEC_OMP_DO:
case EXEC_OMP_END_SINGLE:
case EXEC_OMP_PARALLEL:
--
1.8.3.2
^ permalink raw reply [flat|nested] 89+ messages in thread
* Re: [PATCH 2/4] [GOMP4] [Fortran] OpenACC 1.0+ support in fortran front-end
2014-03-04 7:57 ` Ilmir Usmanov
@ 2014-03-04 7:57 ` Ilmir Usmanov
2014-03-04 7:58 ` [PATCH 3/4] " Ilmir Usmanov
2014-03-04 17:20 ` [PATCH 1/4] " Tobias Burnus
2014-03-04 17:42 ` Tobias Burnus
2 siblings, 1 reply; 89+ messages in thread
From: Ilmir Usmanov @ 2014-03-04 7:57 UTC (permalink / raw)
To: Tobias Burnus
Cc: Thomas Schwinge, Evgeny Gavrin, GarbuzovViacheslav,
Dmitri Botcharnikov, gcc-patches, jakub, fortran
[-- Attachment #1: Type: text/plain, Size: 2450 bytes --]
OpenACC 1.0 fortran FE support -- matching and resolving.
* gcc/fortran/openmp.c
(gfc_free_omp_clauses): Remove also OpenACC clauses.
(gfc_free_expr_list): New function to clear expression list.
(match_oacc_expr_list): New function to match expression list.
(match_oacc_clause_gang): New function to match OpenACC 2.0 gang
clauses.
(OMP_CLAUSE_ASYNC, OMP_CLAUSE_NUM_GANGS,
OMP_CLAUSE_NUM_WORKERS, OMP_CLAUSE_VECTOR_LENGTH,
OMP_CLAUSE_COPY, OMP_CLAUSE_OACC_COPYIN,
OMP_CLAUSE_COPYOUT, OMP_CLAUSE_CREATE, OMP_CLAUSE_PRESENT,
OMP_CLAUSE_PRESENT_OR_COPY, OMP_CLAUSE_PRESENT_OR_COPYIN,
OMP_CLAUSE_PRESENT_OR_COPYOUT, OMP_CLAUSE_PRESENT_OR_CREATE,
OMP_CLAUSE_DEVICEPTR, OMP_CLAUSE_GANG, OMP_CLAUSE_WORKER,
OMP_CLAUSE_VECTOR, OMP_CLAUSE_SEQ, OMP_CLAUSE_INDEPENDENT,
OMP_CLAUSE_USE_DEVICE, OMP_CLAUSE_HOST, OMP_CLAUSE_DEVICE_RESIDENT,
OMP_CLAUSE_DEVICE, OMP_CLAUSE_DEFAULT, OMP_CLAUSE_WAIT,
OMP_CLAUSE_DELETE, OMP_CLAUSE_AUTO, OMP_CLAUSE_TILE): New clauses.
(OACC_PARALLEL_CLAUSES, OACC_KERNELS_CLAUSES, OACC_DATA_CLAUSES,
OACC_LOOP_CLAUSES, OACC_PARALLEL_LOOP_CLAUSES,
OACC_KERNELS_LOOP_CLAUSES, OACC_HOST_DATA_CLAUSES,
OACC_DECLARE_CLAUSES,
OACC_UPDATE_CLAUSES, OACC_ENTER_DATA_CLAUSES,
OACC_EXIT_DATA_CLAUSES): New defines.
(gfc_match_oacc_parallel_loop, gfc_match_oacc_parallel,
gfc_match_oacc_kernels_loop, gfc_match_oacc_kernels,
gfc_match_oacc_data, gfc_match_oacc_host_data, gfc_match_oacc_loop,
gfc_match_oacc_declare, gfc_match_oacc_update,
gfc_match_oacc_enter_data, gfc_match_oacc_exit_data,
gfc_match_oacc_wait, gfc_match_oacc_cache, oacc_is_loop,
check_symbol_not_pointer, resolve_oacc_scalar_int_expr,
resolve_oacc_positive_int_expr, check_array_not_assumed,
resolve_oacc_data_clauses, resolve_oacc_deviceptr_clause,
oacc_is_parallel, oacc_is_kernels, omp_code_to_statement,
oacc_code_to_statement, resolve_oacc_directive_inside_omp_region,
resolve_omp_directive_inside_oacc_region, resolve_oacc_nested_loops,
resolve_oacc_params_in_parallel, resolve_oacc_loop_blocks,
gfc_resolve_oacc_blocks, resolve_oacc_loop, resolve_oacc_cache,
resolve_oacc_wait, gfc_resolve_oacc_declare,
gfc_resolve_oacc_directive): New functions.
(resolve_omp_clauses): Resolve also OpenACC clauses.
(gfc_resolve_omp_directive): Check for enclosing OpenACC region.
[-- Attachment #2: 0002-OpenACC-Fortran-FE-part-2.patch --]
[-- Type: text/x-diff, Size: 41612 bytes --]
From 11beca16743c66a112ec44717eaf9ed61f203d1e Mon Sep 17 00:00:00 2001
From: Ilmir Usmanov <i.usmanov@samsung.com>
Date: Wed, 26 Feb 2014 19:03:12 +0400
Subject: [PATCH 2/5] OpenACC Fortran FE: part 2
---
gcc/fortran/openmp.c | 1221 +++++++++++++++++++++++++++++++++++++++++++++++++-
1 file changed, 1199 insertions(+), 22 deletions(-)
diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index dff3ab1..c582d51 100644
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -69,11 +69,37 @@ gfc_free_omp_clauses (gfc_omp_clauses *c)
gfc_free_expr (c->final_expr);
gfc_free_expr (c->num_threads);
gfc_free_expr (c->chunk_size);
+ gfc_free_expr (c->async_expr);
+ gfc_free_expr (c->gang_expr);
+ gfc_free_expr (c->worker_expr);
+ gfc_free_expr (c->vector_expr);
+ gfc_free_expr (c->num_gangs_expr);
+ gfc_free_expr (c->num_workers_expr);
+ gfc_free_expr (c->vector_length_expr);
+ gfc_free_expr (c->non_clause_wait_expr);
+
for (i = 0; i < OMP_LIST_NUM; i++)
gfc_free_namelist (c->lists[i]);
+
+ gfc_free_expr_list (c->wait_list);
+ gfc_free_expr_list (c->tile_list);
+
free (c);
}
+/* Free expression list. */
+void
+gfc_free_expr_list (gfc_expr_list *list)
+{
+ gfc_expr_list *n;
+
+ for (; list; list = n)
+ {
+ n = list->next;
+ free (list);
+ }
+}
+
/* Match a variable/common block list and construct a namelist from it. */
static match
@@ -169,6 +195,87 @@ cleanup:
return MATCH_ERROR;
}
+static match
+match_oacc_expr_list (const char *str, gfc_expr_list **list, bool allow_asterisk)
+{
+ gfc_expr_list *head, *tail, *p;
+ locus old_loc;
+ gfc_expr *expr;
+ match m;
+
+ head = tail = NULL;
+
+ old_loc = gfc_current_locus;
+
+ m = gfc_match (str);
+ if (m != MATCH_YES)
+ return m;
+
+ for (;;)
+ {
+ m = gfc_match_expr (&expr);
+ if (m == MATCH_YES || allow_asterisk)
+ {
+ p = gfc_get_expr_list ();
+ if (head == NULL)
+ head = tail = p;
+ else
+ {
+ tail->next = p;
+ tail = tail->next;
+ }
+ if (m == MATCH_YES)
+ tail->expr = expr;
+ else if (gfc_match (" *") != MATCH_YES)
+ goto syntax;
+ goto next_item;
+ }
+ if (m == MATCH_ERROR)
+ goto cleanup;
+ goto syntax;
+
+ next_item:
+ if (gfc_match_char (')') == MATCH_YES)
+ break;
+ if (gfc_match_char (',') != MATCH_YES)
+ goto syntax;
+ }
+
+ while (*list)
+ list = &(*list)->next;
+
+ *list = head;
+ return MATCH_YES;
+
+syntax:
+ gfc_error ("Syntax error in OpenACC expression list at %C");
+
+cleanup:
+ gfc_free_expr_list (head);
+ gfc_current_locus = old_loc;
+ return MATCH_ERROR;
+}
+
+static match
+match_oacc_clause_gang (gfc_omp_clauses *cp)
+{
+ if (gfc_match_char ('(') != 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)
+ {
+ cp->gang_static = true;
+ if (gfc_match (" * )") != MATCH_YES)
+ return gfc_match (" %e )", &cp->gang_expr);
+ return MATCH_YES;
+ }
+ return gfc_match (" %e )", &cp->gang_expr);
+}
+
#define OMP_CLAUSE_PRIVATE (1 << 0)
#define OMP_CLAUSE_FIRSTPRIVATE (1 << 1)
#define OMP_CLAUSE_LASTPRIVATE (1 << 2)
@@ -186,11 +293,40 @@ cleanup:
#define OMP_CLAUSE_FINAL (1 << 14)
#define OMP_CLAUSE_MERGEABLE (1 << 15)
-/* Match OpenMP directive clauses. MASK is a bitmask of
+/* OpenACC 2.0 clauses. */
+#define OMP_CLAUSE_ASYNC (1 << 16)
+#define OMP_CLAUSE_NUM_GANGS (1 << 17)
+#define OMP_CLAUSE_NUM_WORKERS (1 << 18)
+#define OMP_CLAUSE_VECTOR_LENGTH (1 << 19)
+#define OMP_CLAUSE_COPY (1 << 20)
+#define OMP_CLAUSE_COPYOUT (1 << 21)
+#define OMP_CLAUSE_CREATE (1 << 22)
+#define OMP_CLAUSE_PRESENT (1 << 23)
+#define OMP_CLAUSE_PRESENT_OR_COPY (1 << 24)
+#define OMP_CLAUSE_PRESENT_OR_COPYIN (1 << 25)
+#define OMP_CLAUSE_PRESENT_OR_COPYOUT (1 << 26)
+#define OMP_CLAUSE_PRESENT_OR_CREATE (1 << 27)
+#define OMP_CLAUSE_DEVICEPTR (1 << 28)
+#define OMP_CLAUSE_GANG (1 << 29)
+#define OMP_CLAUSE_WORKER (1 << 30)
+#define OMP_CLAUSE_VECTOR (1 << 31)
+#define OMP_CLAUSE_SEQ (1LL << 32)
+#define OMP_CLAUSE_INDEPENDENT (1LL << 33)
+#define OMP_CLAUSE_USE_DEVICE (1LL << 34)
+#define OMP_CLAUSE_DEVICE_RESIDENT (1LL << 35)
+#define OMP_CLAUSE_HOST (1LL << 36)
+#define OMP_CLAUSE_DEVICE (1LL << 37)
+#define OMP_CLAUSE_OACC_COPYIN (1LL << 38)
+#define OMP_CLAUSE_WAIT (1LL << 39)
+#define OMP_CLAUSE_DELETE (1LL << 40)
+#define OMP_CLAUSE_AUTO (1LL << 41)
+#define OMP_CLAUSE_TILE (1LL << 42)
+
+/* Match OpenMP and OpenACC directive clauses. MASK is a bitmask of
clauses that are allowed for a particular directive. */
static match
-gfc_match_omp_clauses (gfc_omp_clauses **cp, int mask)
+gfc_match_omp_clauses (gfc_omp_clauses **cp, long long mask)
{
gfc_omp_clauses *c = gfc_get_omp_clauses ();
locus old_loc;
@@ -205,6 +341,52 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, int mask)
needs_space = false;
first = false;
gfc_gobble_whitespace ();
+ if ((mask & OMP_CLAUSE_ASYNC) && !c->async)
+ if (gfc_match ("async") == MATCH_YES)
+ {
+ c->async = true;
+ if (gfc_match (" ( %e )", &c->async_expr) == MATCH_YES)
+ needs_space = false;
+ else
+ needs_space = true;
+ continue;
+ }
+ if ((mask & OMP_CLAUSE_GANG) && !c->gang)
+ if (gfc_match ("gang") == MATCH_YES)
+ {
+ c->gang = true;
+ if (match_oacc_clause_gang(c) == MATCH_YES)
+ needs_space = false;
+ else
+ needs_space = true;
+ continue;
+ }
+ if ((mask & OMP_CLAUSE_WORKER) && !c->worker)
+ if (gfc_match ("worker") == MATCH_YES)
+ {
+ c->worker = true;
+ if (gfc_match (" ( num : %e )", &c->worker_expr) == MATCH_YES
+ || gfc_match (" ( %e )", &c->worker_expr) == MATCH_YES)
+ needs_space = false;
+ else
+ needs_space = true;
+ continue;
+ }
+ if ((mask & OMP_CLAUSE_VECTOR_LENGTH) && c->vector_length_expr == NULL
+ && gfc_match ("vector_length ( %e )", &c->vector_length_expr)
+ == MATCH_YES)
+ continue;
+ if ((mask & OMP_CLAUSE_VECTOR) && !c->vector)
+ if (gfc_match ("vector") == MATCH_YES)
+ {
+ c->vector = true;
+ if (gfc_match (" ( length : %e )", &c->vector_expr) == MATCH_YES
+ || gfc_match (" ( %e )", &c->vector_expr) == MATCH_YES)
+ needs_space = false;
+ else
+ needs_space = true;
+ continue;
+ }
if ((mask & OMP_CLAUSE_IF) && c->if_expr == NULL
&& gfc_match ("if ( %e )", &c->if_expr) == MATCH_YES)
continue;
@@ -247,6 +429,148 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, int mask)
&c->lists[OMP_LIST_COPYIN], true)
== MATCH_YES)
continue;
+ if ((mask & OMP_CLAUSE_NUM_GANGS) && c->num_gangs_expr == NULL
+ && gfc_match ("num_gangs ( %e )", &c->num_gangs_expr) == MATCH_YES)
+ continue;
+ if ((mask & OMP_CLAUSE_NUM_WORKERS) && c->num_workers_expr == NULL
+ && gfc_match ("num_workers ( %e )", &c->num_workers_expr)
+ == MATCH_YES)
+ continue;
+ if ((mask & OMP_CLAUSE_COPY)
+ && gfc_match_omp_variable_list ("copy (",
+ &c->lists[OMP_LIST_COPY], true)
+ == MATCH_YES)
+ continue;
+ if ((mask & OMP_CLAUSE_OACC_COPYIN)
+ && gfc_match_omp_variable_list ("copyin (",
+ &c->lists[OMP_LIST_OACC_COPYIN], true)
+ == MATCH_YES)
+ continue;
+ if ((mask & OMP_CLAUSE_COPYOUT)
+ && gfc_match_omp_variable_list ("copyout (",
+ &c->lists[OMP_LIST_COPYOUT], true)
+ == MATCH_YES)
+ continue;
+ if ((mask & OMP_CLAUSE_CREATE)
+ && gfc_match_omp_variable_list ("create (",
+ &c->lists[OMP_LIST_CREATE], true)
+ == MATCH_YES)
+ continue;
+ if ((mask & OMP_CLAUSE_DELETE)
+ && gfc_match_omp_variable_list ("delete (",
+ &c->lists[OMP_LIST_DELETE], true)
+ == MATCH_YES)
+ continue;
+ if ((mask & OMP_CLAUSE_PRESENT)
+ && gfc_match_omp_variable_list ("present (",
+ &c->lists[OMP_LIST_PRESENT], true)
+ == MATCH_YES)
+ continue;
+ if ((mask & OMP_CLAUSE_PRESENT_OR_COPY)
+ && gfc_match_omp_variable_list ("present_or_copy (",
+ &c->lists[OMP_LIST_PRESENT_OR_COPY],
+ true)
+ == MATCH_YES)
+ continue;
+ if ((mask & OMP_CLAUSE_PRESENT_OR_COPY)
+ && gfc_match_omp_variable_list ("pcopy (",
+ &c->lists[OMP_LIST_PRESENT_OR_COPY],
+ true)
+ == MATCH_YES)
+ continue;
+ if ((mask & OMP_CLAUSE_PRESENT_OR_COPYIN)
+ && gfc_match_omp_variable_list ("present_or_copyin (",
+ &c->lists[OMP_LIST_PRESENT_OR_COPYIN],
+ true)
+ == MATCH_YES)
+ continue;
+ if ((mask & OMP_CLAUSE_PRESENT_OR_COPYIN)
+ && gfc_match_omp_variable_list ("pcopyin (",
+ &c->lists[OMP_LIST_PRESENT_OR_COPYIN],
+ true)
+ == MATCH_YES)
+ continue;
+ if ((mask & OMP_CLAUSE_PRESENT_OR_COPYOUT)
+ && gfc_match_omp_variable_list ("present_or_copyout (",
+ &c->lists[OMP_LIST_PRESENT_OR_COPYOUT],
+ true)
+ == MATCH_YES)
+ continue;
+ if ((mask & OMP_CLAUSE_PRESENT_OR_COPYOUT)
+ && gfc_match_omp_variable_list ("pcopyout (",
+ &c->lists[OMP_LIST_PRESENT_OR_COPYOUT],
+ true)
+ == MATCH_YES)
+ continue;
+ if ((mask & OMP_CLAUSE_PRESENT_OR_CREATE)
+ && gfc_match_omp_variable_list ("present_or_create (",
+ &c->lists[OMP_LIST_PRESENT_OR_CREATE],
+ true)
+ == MATCH_YES)
+ continue;
+ if ((mask & OMP_CLAUSE_PRESENT_OR_CREATE)
+ && gfc_match_omp_variable_list ("pcreate (",
+ &c->lists[OMP_LIST_PRESENT_OR_CREATE],
+ true)
+ == MATCH_YES)
+ continue;
+ if ((mask & OMP_CLAUSE_DEVICEPTR)
+ && gfc_match_omp_variable_list ("deviceptr (",
+ &c->lists[OMP_LIST_DEVICEPTR], true)
+ == MATCH_YES)
+ continue;
+ if ((mask & OMP_CLAUSE_USE_DEVICE)
+ && gfc_match_omp_variable_list ("use_device (",
+ &c->lists[OMP_LIST_USE_DEVICE], true)
+ == MATCH_YES)
+ continue;
+ if ((mask & OMP_CLAUSE_DEVICE_RESIDENT)
+ && gfc_match_omp_variable_list ("device_resident (",
+ &c->lists[OMP_LIST_DEVICE_RESIDENT],
+ true)
+ == MATCH_YES)
+ continue;
+ if ((mask & OMP_CLAUSE_HOST)
+ && gfc_match_omp_variable_list ("host (",
+ &c->lists[OMP_LIST_HOST], true)
+ == MATCH_YES)
+ continue;
+ if ((mask & OMP_CLAUSE_DEVICE)
+ && gfc_match_omp_variable_list ("device (",
+ &c->lists[OMP_LIST_DEVICE], true)
+ == MATCH_YES)
+ continue;
+ if ((mask & OMP_CLAUSE_TILE)
+ && match_oacc_expr_list ("tile (", &c->tile_list, true) == MATCH_YES)
+ continue;
+ if ((mask & OMP_CLAUSE_SEQ) && !c->seq
+ && gfc_match ("seq") == MATCH_YES)
+ {
+ c->seq = true;
+ needs_space = true;
+ continue;
+ }
+ if ((mask & OMP_CLAUSE_INDEPENDENT) && !c->independent
+ && gfc_match ("independent") == MATCH_YES)
+ {
+ c->independent = true;
+ needs_space = true;
+ continue;
+ }
+ if ((mask & OMP_CLAUSE_AUTO) && !c->par_auto
+ && gfc_match ("auto") == MATCH_YES)
+ {
+ c->par_auto = true;
+ needs_space = true;
+ continue;
+ }
+ if ((mask & OMP_CLAUSE_WAIT) && !c->wait
+ && gfc_match ("wait") == MATCH_YES)
+ {
+ c->wait = true;
+ match_oacc_expr_list (" (", &c->wait_list, false);
+ continue;
+ }
old_loc = gfc_current_locus;
if ((mask & OMP_CLAUSE_REDUCTION)
&& gfc_match ("reduction ( ") == MATCH_YES)
@@ -423,31 +747,257 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, int mask)
break;
}
- if (gfc_match_omp_eos () != MATCH_YES)
+ if (gfc_match_omp_eos () != MATCH_YES)
+ {
+ gfc_free_omp_clauses (c);
+ return MATCH_ERROR;
+ }
+
+ *cp = c;
+ return MATCH_YES;
+}
+
+#define OACC_PARALLEL_CLAUSES \
+ (OMP_CLAUSE_IF | OMP_CLAUSE_ASYNC | OMP_CLAUSE_NUM_GANGS \
+ | OMP_CLAUSE_NUM_WORKERS | OMP_CLAUSE_VECTOR_LENGTH | OMP_CLAUSE_REDUCTION \
+ | OMP_CLAUSE_COPY | OMP_CLAUSE_OACC_COPYIN | OMP_CLAUSE_COPYOUT \
+ | OMP_CLAUSE_CREATE | OMP_CLAUSE_PRESENT | OMP_CLAUSE_PRESENT_OR_COPY \
+ | OMP_CLAUSE_PRESENT_OR_COPYIN | OMP_CLAUSE_PRESENT_OR_COPYOUT \
+ | OMP_CLAUSE_PRESENT_OR_CREATE | OMP_CLAUSE_DEVICEPTR | OMP_CLAUSE_PRIVATE \
+ | OMP_CLAUSE_FIRSTPRIVATE | OMP_CLAUSE_DEFAULT | OMP_CLAUSE_WAIT)
+#define OACC_KERNELS_CLAUSES \
+ (OMP_CLAUSE_IF | OMP_CLAUSE_ASYNC | OMP_CLAUSE_DEVICEPTR \
+ | OMP_CLAUSE_COPY | OMP_CLAUSE_OACC_COPYIN | OMP_CLAUSE_COPYOUT \
+ | OMP_CLAUSE_CREATE | OMP_CLAUSE_PRESENT | OMP_CLAUSE_PRESENT_OR_COPY \
+ | OMP_CLAUSE_PRESENT_OR_COPYIN | OMP_CLAUSE_PRESENT_OR_COPYOUT \
+ | OMP_CLAUSE_PRESENT_OR_CREATE | OMP_CLAUSE_DEFAULT | OMP_CLAUSE_WAIT)
+#define OACC_DATA_CLAUSES \
+ (OMP_CLAUSE_IF | OMP_CLAUSE_DEVICEPTR | OMP_CLAUSE_COPY \
+ | OMP_CLAUSE_OACC_COPYIN | OMP_CLAUSE_COPYOUT | OMP_CLAUSE_CREATE \
+ | OMP_CLAUSE_PRESENT | OMP_CLAUSE_PRESENT_OR_COPY \
+ | OMP_CLAUSE_PRESENT_OR_COPYIN | OMP_CLAUSE_PRESENT_OR_COPYOUT \
+ | OMP_CLAUSE_PRESENT_OR_CREATE)
+#define OACC_LOOP_CLAUSES \
+ (OMP_CLAUSE_COLLAPSE | OMP_CLAUSE_GANG | OMP_CLAUSE_WORKER \
+ | OMP_CLAUSE_VECTOR | OMP_CLAUSE_SEQ | OMP_CLAUSE_INDEPENDENT \
+ | OMP_CLAUSE_PRIVATE | OMP_CLAUSE_REDUCTION | OMP_CLAUSE_AUTO \
+ | OMP_CLAUSE_TILE)
+#define OACC_PARALLEL_LOOP_CLAUSES \
+ (OACC_LOOP_CLAUSES | OACC_PARALLEL_CLAUSES)
+#define OACC_KERNELS_LOOP_CLAUSES \
+ (OACC_LOOP_CLAUSES | OACC_KERNELS_CLAUSES)
+#define OACC_HOST_DATA_CLAUSES OMP_CLAUSE_USE_DEVICE
+#define OACC_DECLARE_CLAUSES \
+ (OMP_CLAUSE_COPY | OMP_CLAUSE_OACC_COPYIN | OMP_CLAUSE_COPYOUT \
+ | OMP_CLAUSE_CREATE | OMP_CLAUSE_DEVICEPTR | OMP_CLAUSE_DEVICE_RESIDENT \
+ | OMP_CLAUSE_PRESENT | OMP_CLAUSE_PRESENT_OR_COPY \
+ | OMP_CLAUSE_PRESENT_OR_COPYIN | OMP_CLAUSE_PRESENT_OR_COPYOUT \
+ | OMP_CLAUSE_PRESENT_OR_CREATE)
+#define OACC_UPDATE_CLAUSES \
+ (OMP_CLAUSE_IF | OMP_CLAUSE_ASYNC | OMP_CLAUSE_HOST | OMP_CLAUSE_DEVICE)
+#define OACC_ENTER_DATA_CLAUSES \
+ (OMP_CLAUSE_IF | OMP_CLAUSE_ASYNC | OMP_CLAUSE_WAIT | OMP_CLAUSE_OACC_COPYIN \
+ | OMP_CLAUSE_CREATE | OMP_CLAUSE_PRESENT_OR_COPYIN \
+ | OMP_CLAUSE_PRESENT_OR_CREATE)
+#define OACC_EXIT_DATA_CLAUSES \
+ (OMP_CLAUSE_IF | OMP_CLAUSE_ASYNC | OMP_CLAUSE_WAIT | OMP_CLAUSE_COPYOUT \
+ | OMP_CLAUSE_DELETE)
+
+#define OMP_PARALLEL_CLAUSES \
+ (OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE | OMP_CLAUSE_SHARED \
+ | OMP_CLAUSE_COPYIN | OMP_CLAUSE_REDUCTION | OMP_CLAUSE_IF \
+ | OMP_CLAUSE_NUM_THREADS | OMP_CLAUSE_DEFAULT)
+#define OMP_DO_CLAUSES \
+ (OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE \
+ | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_REDUCTION \
+ | OMP_CLAUSE_SCHEDULE | OMP_CLAUSE_ORDERED | OMP_CLAUSE_COLLAPSE)
+#define OMP_SECTIONS_CLAUSES \
+ (OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE \
+ | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_REDUCTION)
+#define OMP_TASK_CLAUSES \
+ (OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE | OMP_CLAUSE_SHARED \
+ | OMP_CLAUSE_IF | OMP_CLAUSE_DEFAULT | OMP_CLAUSE_UNTIED \
+ | OMP_CLAUSE_FINAL | OMP_CLAUSE_MERGEABLE)
+
+
+match
+gfc_match_oacc_parallel_loop (void)
+{
+ gfc_omp_clauses *c;
+ if (gfc_match_omp_clauses (&c, OACC_PARALLEL_LOOP_CLAUSES) != MATCH_YES)
+ return MATCH_ERROR;
+
+ new_st.op = EXEC_OACC_PARALLEL_LOOP;
+ new_st.ext.omp_clauses = c;
+ return MATCH_YES;
+}
+
+
+match
+gfc_match_oacc_parallel (void)
+{
+ gfc_omp_clauses *c;
+ if (gfc_match_omp_clauses (&c, OACC_PARALLEL_CLAUSES) != MATCH_YES)
+ return MATCH_ERROR;
+
+ new_st.op = EXEC_OACC_PARALLEL;
+ new_st.ext.omp_clauses = c;
+ return MATCH_YES;
+}
+
+
+match
+gfc_match_oacc_kernels_loop (void)
+{
+ gfc_omp_clauses *c;
+ if (gfc_match_omp_clauses (&c, OACC_KERNELS_LOOP_CLAUSES) != MATCH_YES)
+ return MATCH_ERROR;
+
+ new_st.op = EXEC_OACC_KERNELS_LOOP;
+ new_st.ext.omp_clauses = c;
+ return MATCH_YES;
+}
+
+
+match
+gfc_match_oacc_kernels (void)
+{
+ gfc_omp_clauses *c;
+ if (gfc_match_omp_clauses (&c, OACC_KERNELS_CLAUSES) != MATCH_YES)
+ return MATCH_ERROR;
+
+ new_st.op = EXEC_OACC_KERNELS;
+ new_st.ext.omp_clauses = c;
+ return MATCH_YES;
+}
+
+
+match
+gfc_match_oacc_data (void)
+{
+ gfc_omp_clauses *c;
+ if (gfc_match_omp_clauses (&c, OACC_DATA_CLAUSES) != MATCH_YES)
+ return MATCH_ERROR;
+
+ new_st.op = EXEC_OACC_DATA;
+ new_st.ext.omp_clauses = c;
+ return MATCH_YES;
+}
+
+
+match
+gfc_match_oacc_host_data (void)
+{
+ gfc_omp_clauses *c;
+ if (gfc_match_omp_clauses (&c, OACC_HOST_DATA_CLAUSES) != MATCH_YES)
+ return MATCH_ERROR;
+
+ new_st.op = EXEC_OACC_HOST_DATA;
+ new_st.ext.omp_clauses = c;
+ return MATCH_YES;
+}
+
+
+match
+gfc_match_oacc_loop (void)
+{
+ gfc_omp_clauses *c;
+ if (gfc_match_omp_clauses (&c, OACC_LOOP_CLAUSES) != MATCH_YES)
+ return MATCH_ERROR;
+
+ new_st.op = EXEC_OACC_LOOP;
+ new_st.ext.omp_clauses = c;
+ return MATCH_YES;
+}
+
+
+match
+gfc_match_oacc_declare (void)
+{
+ gfc_omp_clauses *c;
+ if (gfc_match_omp_clauses (&c, OACC_DECLARE_CLAUSES) != MATCH_YES)
+ return MATCH_ERROR;
+
+ new_st.ext.omp_clauses = c;
+ new_st.ext.omp_clauses->ext.loc = gfc_current_locus;
+ return MATCH_YES;
+}
+
+
+match
+gfc_match_oacc_update (void)
+{
+ gfc_omp_clauses *c;
+ if (gfc_match_omp_clauses (&c, OACC_UPDATE_CLAUSES) != MATCH_YES)
+ return MATCH_ERROR;
+
+ new_st.op = EXEC_OACC_UPDATE;
+ new_st.ext.omp_clauses = c;
+ return MATCH_YES;
+}
+
+
+match
+gfc_match_oacc_enter_data (void)
+{
+ gfc_omp_clauses *c;
+ if (gfc_match_omp_clauses (&c, OACC_ENTER_DATA_CLAUSES) != MATCH_YES)
+ return MATCH_ERROR;
+
+ new_st.op = EXEC_OACC_ENTER_DATA;
+ new_st.ext.omp_clauses = c;
+ return MATCH_YES;
+}
+
+
+match
+gfc_match_oacc_exit_data (void)
+{
+ gfc_omp_clauses *c;
+ if (gfc_match_omp_clauses (&c, OACC_EXIT_DATA_CLAUSES) != MATCH_YES)
+ return MATCH_ERROR;
+
+ new_st.op = EXEC_OACC_EXIT_DATA;
+ new_st.ext.omp_clauses = c;
+ return MATCH_YES;
+}
+
+
+match
+gfc_match_oacc_wait (void)
+{
+ gfc_omp_clauses *c = gfc_get_omp_clauses ();
+ gfc_match (" ( %e )", &c->non_clause_wait_expr);
+
+ new_st.op = EXEC_OACC_WAIT;
+ new_st.ext.omp_clauses = c;
+ return MATCH_YES;
+}
+
+
+match
+gfc_match_oacc_cache (void)
+{
+ gfc_omp_clauses *c = gfc_get_omp_clauses ();
+ match m = gfc_match_omp_variable_list (" (",&c->lists[OMP_LIST_CACHE], true);
+ if (m != MATCH_YES)
+ {
+ gfc_free_omp_clauses(c);
+ return m;
+ }
+
+ if (gfc_current_state() != COMP_DO)
{
- gfc_free_omp_clauses (c);
+ gfc_error ("ACC CACHE directive must be inside of loop %C");
+ gfc_free_omp_clauses(c);
return MATCH_ERROR;
}
- *cp = c;
+ new_st.op = EXEC_OACC_CACHE;
+ new_st.ext.omp_clauses = c;
return MATCH_YES;
}
-#define OMP_PARALLEL_CLAUSES \
- (OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE | OMP_CLAUSE_SHARED \
- | OMP_CLAUSE_COPYIN | OMP_CLAUSE_REDUCTION | OMP_CLAUSE_IF \
- | OMP_CLAUSE_NUM_THREADS | OMP_CLAUSE_DEFAULT)
-#define OMP_DO_CLAUSES \
- (OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE \
- | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_REDUCTION \
- | OMP_CLAUSE_SCHEDULE | OMP_CLAUSE_ORDERED | OMP_CLAUSE_COLLAPSE)
-#define OMP_SECTIONS_CLAUSES \
- (OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE \
- | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_REDUCTION)
-#define OMP_TASK_CLAUSES \
- (OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE | OMP_CLAUSE_SHARED \
- | OMP_CLAUSE_IF | OMP_CLAUSE_DEFAULT | OMP_CLAUSE_UNTIED \
- | OMP_CLAUSE_FINAL | OMP_CLAUSE_MERGEABLE)
match
gfc_match_omp_parallel (void)
@@ -793,6 +1343,126 @@ gfc_match_omp_end_single (void)
}
+static bool
+oacc_is_loop (gfc_code *code)
+{
+ return code->op == EXEC_OACC_PARALLEL_LOOP
+ || code->op == EXEC_OACC_KERNELS_LOOP
+ || code->op == EXEC_OACC_LOOP;
+}
+
+static void
+resolve_oacc_scalar_int_expr (gfc_expr *expr, const char *clause)
+{
+ if (!gfc_resolve_expr (expr)
+ || expr->ts.type != BT_INTEGER || expr->rank != 0)
+ gfc_error ("%s clause at %L requires a scalar INTEGER expression",
+ clause, &expr->where);
+}
+
+
+static void
+resolve_oacc_positive_int_expr (gfc_expr *expr, const char *clause)
+{
+ resolve_oacc_scalar_int_expr (expr, clause);
+ if (expr->expr_type == EXPR_CONSTANT && expr->ts.type == BT_INTEGER
+ && expr->value.integer->_mp_size <= 0)
+ gfc_warning ("INTEGER expression of %s clause at %L must be positive",
+ clause, &expr->where);
+}
+
+/* Emits error when symbol is pointer, cray pointer or cray pointee
+ of derived of polymorphic type. */
+
+static void
+check_symbol_not_pointer (gfc_symbol *sym, locus loc, const char *name)
+{
+ if (sym->ts.type == BT_DERIVED
+ && sym->attr.pointer)
+ gfc_error ("POINTER object '%s' of derived type in %s clause at %L",
+ sym->name, name, &loc);
+ if (sym->ts.type == BT_DERIVED
+ && sym->attr.cray_pointer)
+ gfc_error ("Cray pointer object of derived type '%s' in %s clause at %L",
+ sym->name, name, &loc);
+ if (sym->ts.type == BT_DERIVED
+ && sym->attr.cray_pointee)
+ gfc_error ("Cray pointee object of derived type '%s' in %s clause at %L",
+ sym->name, name, &loc);
+ if ((sym->ts.type == BT_CLASS || sym->ts.type == BT_ASSUMED)
+ && sym->attr.pointer)
+ gfc_error ("POINTER object '%s' of polymorphic type in %s clause at %L",
+ sym->name, name, &loc);
+ if ((sym->ts.type == BT_CLASS || sym->ts.type == BT_ASSUMED)
+ && sym->attr.cray_pointer)
+ gfc_error ("Cray pointer object of polymorphic type '%s' in %s clause at %L",
+ sym->name, name, &loc);
+ if ((sym->ts.type == BT_CLASS || sym->ts.type == BT_ASSUMED)
+ && sym->attr.cray_pointee)
+ gfc_error ("Cray pointee object of polymorphic type '%s' in %s clause at %L",
+ sym->name, name, &loc);
+}
+
+/* Emits error when symbol represents assumed size/shape/rank array. */
+
+static void
+check_array_not_assumed (gfc_symbol *sym, locus loc, const char *name)
+{
+ if (sym->as && sym->as->type == AS_ASSUMED_SIZE)
+ gfc_error ("Assumed size array '%s' in %s clause at %L",
+ sym->name, name, &loc);
+ if (sym->as && sym->as->type == AS_ASSUMED_SHAPE)
+ gfc_error ("Assumed shape array '%s' in %s clause at %L",
+ sym->name, name, &loc);
+ if (sym->as && sym->as->type == AS_ASSUMED_RANK)
+ gfc_error ("Assumed rank array '%s' in %s clause at %L",
+ sym->name, name, &loc);
+}
+
+static void
+resolve_oacc_data_clauses (gfc_symbol *sym, locus loc, const char *name)
+{
+ if (sym->ts.type == BT_DERIVED
+ && sym->attr.allocatable)
+ gfc_error ("ALLOCATABLE object '%s' of derived type in %s clause at %L",
+ sym->name, name, &loc);
+ if ((sym->ts.type == BT_CLASS || sym->ts.type == BT_ASSUMED)
+ && sym->attr.allocatable)
+ gfc_error ("ALLOCATABLE object '%s' of polymorphic type "
+ "in %s clause at %L", sym->name, name, &loc);
+ check_symbol_not_pointer (sym, loc, name);
+ check_array_not_assumed (sym, loc, name);
+}
+
+static void
+resolve_oacc_deviceptr_clause (gfc_symbol *sym, locus loc, const char *name)
+{
+ if (sym->ts.type == BT_DERIVED
+ && sym->attr.allocatable)
+ gfc_error ("ALLOCATABLE object '%s' of derived type in %s clause at %L",
+ sym->name, name, &loc);
+ if ((sym->ts.type == BT_CLASS || sym->ts.type == BT_ASSUMED)
+ && sym->attr.allocatable)
+ gfc_error ("ALLOCATABLE object '%s' of polymorphic type "
+ "in %s clause at %L", sym->name, name, &loc);
+ if (sym->attr.pointer)
+ gfc_error ("POINTER object '%s' in %s clause at %L",
+ sym->name, name, &loc);
+ if (sym->attr.cray_pointer)
+ gfc_error ("Cray pointer object '%s' in %s clause at %L",
+ sym->name, name, &loc);
+ if (sym->attr.cray_pointee)
+ gfc_error ("Cray pointee object '%s' in %s clause at %L",
+ sym->name, name, &loc);
+ if (sym->attr.allocatable)
+ gfc_error ("ALLOCATABLE object '%s' in %s clause at %L",
+ sym->name, name, &loc);
+ if (sym->attr.value)
+ gfc_error ("VALUE object '%s' in %s clause at %L",
+ sym->name, name, &loc);
+ check_array_not_assumed (sym, loc, name);
+}
+
/* OpenMP directive resolving routines. */
static void
@@ -800,10 +1470,14 @@ resolve_omp_clauses (gfc_code *code)
{
gfc_omp_clauses *omp_clauses = code->ext.omp_clauses;
gfc_namelist *n;
+ gfc_expr_list *el;
int list;
static const char *clause_names[]
= { "PRIVATE", "FIRSTPRIVATE", "LASTPRIVATE", "COPYPRIVATE", "SHARED",
- "COPYIN", "REDUCTION" };
+ "COPYIN", "COPY", "COPYIN", "COPYOUT", "CREATE", "DELETE",
+ "PRESENT", "PRESENT_OR_COPY", "PRESENT_OR_COPYIN", "PRESENT_OR_COPYOUT",
+ "PRESENT_OR_CREATE", "DEVICEPTR", "DEVICE_RESIDENT", "USE_DEVICE",
+ "HOST", "DEVICE", "CACHE", "REDUCTION"};
if (omp_clauses == NULL)
return;
@@ -933,8 +1607,36 @@ resolve_omp_clauses (gfc_code *code)
else
gcc_unreachable ();
+ if (list >= OMP_LIST_DATA_CLAUSE_FIRST
+ && list < OMP_LIST_DATA_CLAUSE_LAST)
+ resolve_oacc_data_clauses (n->sym, code->loc, name);
+
+ if (list > OMP_LIST_DATA_CLAUSE_LAST
+ && list < OMP_LIST_REDUCTION_FIRST)
+ {
+ check_symbol_not_pointer (n->sym, code->loc, name);
+ check_array_not_assumed (n->sym, code->loc, name);
+ }
+
switch (list)
{
+ case OMP_LIST_DEVICEPTR:
+ resolve_oacc_deviceptr_clause (n->sym, code->loc, name);
+ break;
+ case OMP_LIST_USE_DEVICE:
+ if (n->sym->attr.allocatable)
+ gfc_error ("ALLOCATABLE object '%s' of polymorphic type "
+ "in %s clause at %L", n->sym->name, name, &code->loc);
+ if (n->sym->attr.pointer)
+ gfc_error ("POINTER object '%s' in %s clause at %L",
+ n->sym->name, name, &code->loc);
+ if (n->sym->attr.cray_pointer)
+ gfc_error ("Cray pointer object '%s' in %s clause at %L",
+ n->sym->name, name, &code->loc);
+ if (n->sym->attr.cray_pointee)
+ gfc_error ("Cray pointee object '%s' in %s clause at %L",
+ n->sym->name, name, &code->loc);
+ break;
case OMP_LIST_COPYIN:
for (; n != NULL; n = n->next)
{
@@ -996,7 +1698,9 @@ resolve_omp_clauses (gfc_code *code)
gfc_error ("Cray pointer '%s' in %s clause at %L",
n->sym->name, name, &code->loc);
}
- if (n->sym->as && n->sym->as->type == AS_ASSUMED_SIZE)
+ if (oacc_is_loop (code) || code->op == EXEC_OACC_PARALLEL)
+ check_array_not_assumed (n->sym, code->loc, name);
+ else if (n->sym->as && n->sym->as->type == AS_ASSUMED_SIZE)
gfc_error ("Assumed size array '%s' in %s clause at %L",
n->sym->name, name, &code->loc);
if (n->sym->attr.in_namelist
@@ -1059,6 +1763,25 @@ resolve_omp_clauses (gfc_code *code)
break;
}
}
+ if (omp_clauses->async)
+ if (omp_clauses->async_expr)
+ resolve_oacc_scalar_int_expr (omp_clauses->async_expr, "ASYNC");
+ 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");
+ 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");
+ if (omp_clauses->worker_expr)
+ resolve_oacc_positive_int_expr (omp_clauses->worker_expr, "WORKER");
+ if (omp_clauses->vector_expr)
+ resolve_oacc_positive_int_expr (omp_clauses->vector_expr, "VECTOR");
+ if (omp_clauses->wait)
+ if (omp_clauses->wait_list)
+ for (el = omp_clauses->wait_list; el; el = el->next)
+ resolve_oacc_positive_int_expr (el->expr, "WAIT");
}
@@ -1727,6 +2450,458 @@ resolve_omp_do (gfc_code *code)
}
}
+typedef struct omp_context oacc_context;
+oacc_context *oacc_current_ctx;
+
+static bool
+oacc_is_parallel (gfc_code *code)
+{
+ return code->op == EXEC_OACC_PARALLEL || code->op == EXEC_OACC_PARALLEL_LOOP;
+}
+
+static bool
+oacc_is_kernels (gfc_code *code)
+{
+ return code->op == EXEC_OACC_KERNELS || code->op == EXEC_OACC_KERNELS_LOOP;
+}
+
+static gfc_statement
+omp_code_to_statement (gfc_code *code)
+{
+switch (code->op)
+ {
+ case EXEC_OMP_PARALLEL:
+ return ST_OMP_PARALLEL;
+ case EXEC_OMP_PARALLEL_SECTIONS:
+ return ST_OMP_PARALLEL_SECTIONS;
+ case EXEC_OMP_SECTIONS:
+ return ST_OMP_SECTIONS;
+ case EXEC_OMP_ORDERED:
+ return ST_OMP_ORDERED;
+ case EXEC_OMP_CRITICAL:
+ return ST_OMP_CRITICAL;
+ case EXEC_OMP_MASTER:
+ return ST_OMP_MASTER;
+ case EXEC_OMP_SINGLE:
+ return ST_OMP_SINGLE;
+ case EXEC_OMP_TASK:
+ return ST_OMP_TASK;
+ case EXEC_OMP_WORKSHARE:
+ return ST_OMP_WORKSHARE;
+ case EXEC_OMP_PARALLEL_WORKSHARE:
+ return ST_OMP_PARALLEL_WORKSHARE;
+ case EXEC_OMP_DO:
+ return ST_OMP_DO;
+ default:
+ gcc_unreachable ();
+ }
+}
+
+static gfc_statement
+oacc_code_to_statement (gfc_code *code)
+{
+switch (code->op)
+ {
+ case EXEC_OACC_PARALLEL:
+ return ST_OACC_PARALLEL;
+ case EXEC_OACC_KERNELS:
+ return ST_OACC_KERNELS;
+ case EXEC_OACC_DATA:
+ return ST_OACC_DATA;
+ case EXEC_OACC_HOST_DATA:
+ return ST_OACC_HOST_DATA;
+ case EXEC_OACC_PARALLEL_LOOP:
+ return ST_OACC_PARALLEL_LOOP;
+ case EXEC_OACC_KERNELS_LOOP:
+ return ST_OACC_KERNELS_LOOP;
+ case EXEC_OACC_LOOP:
+ return ST_OACC_LOOP;
+ default:
+ gcc_unreachable ();
+ }
+}
+
+static void
+resolve_oacc_directive_inside_omp_region (gfc_code *code)
+{
+ if (omp_current_ctx != NULL)
+ {
+ gfc_statement st = omp_code_to_statement (omp_current_ctx->code);
+ gfc_statement oacc_st = oacc_code_to_statement (code);
+ gfc_error ("The %s directive cannot be specified within "
+ "a %s region at %L", gfc_ascii_statement (oacc_st),
+ gfc_ascii_statement (st), &code->loc);
+ }
+}
+
+static void
+resolve_omp_directive_inside_oacc_region (gfc_code *code)
+{
+ if (oacc_current_ctx != NULL)
+ {
+ gfc_statement st = oacc_code_to_statement (oacc_current_ctx->code);
+ gfc_statement omp_st = omp_code_to_statement (code);
+ gfc_error ("The %s directive cannot be specified within "
+ "a %s region at %L", gfc_ascii_statement (omp_st),
+ gfc_ascii_statement (st), &code->loc);
+ }
+}
+
+
+static void
+resolve_oacc_nested_loops (gfc_code *code, gfc_code* do_code, int collapse,
+ const char *clause)
+{
+ gfc_symbol *dovar;
+ gfc_code *c;
+ int i;
+
+ for (i = 1; i <= collapse; i++)
+ {
+ if (do_code->op == EXEC_DO_WHILE)
+ {
+ gfc_error ("!$ACC LOOP cannot be a DO WHILE or DO without loop control "
+ "at %L", &do_code->loc);
+ break;
+ }
+ gcc_assert (do_code->op == EXEC_DO || do_code->op == EXEC_DO_CONCURRENT);
+ if (do_code->ext.iterator->var->ts.type != BT_INTEGER)
+ gfc_error ("!$ACC LOOP iteration variable must be of type integer at %L",
+ &do_code->loc);
+ dovar = do_code->ext.iterator->var->symtree->n.sym;
+ if (i > 1)
+ {
+ gfc_code *do_code2 = code->block->next;
+ int j;
+
+ for (j = 1; j < i; j++)
+ {
+ gfc_symbol *ivar = do_code2->ext.iterator->var->symtree->n.sym;
+ if (dovar == ivar
+ || gfc_find_sym_in_expr (ivar, do_code->ext.iterator->start)
+ || gfc_find_sym_in_expr (ivar, do_code->ext.iterator->end)
+ || gfc_find_sym_in_expr (ivar, do_code->ext.iterator->step))
+ {
+ gfc_error ("!$ACC LOOP %s loops don't form rectangular iteration space at %L",
+ clause, &do_code->loc);
+ break;
+ }
+ if (j < i)
+ break;
+ do_code2 = do_code2->block->next;
+ }
+ }
+ if (i == collapse)
+ break;
+ for (c = do_code->next; c; c = c->next)
+ if (c->op != EXEC_NOP && c->op != EXEC_CONTINUE)
+ {
+ gfc_error ("%s !$ACC LOOP loops not perfectly nested at %L",
+ clause, &c->loc);
+ break;
+ }
+ if (c)
+ break;
+ do_code = do_code->block;
+ if (do_code->op != EXEC_DO && do_code->op != EXEC_DO_WHILE
+ && do_code->op != EXEC_DO_CONCURRENT)
+ {
+ gfc_error ("not enough DO loops for %s !$ACC LOOP at %L",
+ clause, &code->loc);
+ break;
+ }
+ do_code = do_code->next;
+ if (do_code == NULL
+ || (do_code->op != EXEC_DO && do_code->op != EXEC_DO_WHILE
+ && do_code->op != EXEC_DO_CONCURRENT))
+ {
+ gfc_error ("not enough DO loops for %s !$ACC LOOP at %L",
+ clause, &code->loc);
+ break;
+ }
+ }
+}
+
+
+static void
+resolve_oacc_params_in_parallel (gfc_code *code, const char *clause)
+{
+ oacc_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);
+ for (c = oacc_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);
+ }
+}
+
+
+static void
+resolve_oacc_loop_blocks (gfc_code *code)
+{
+ oacc_context *c;
+
+ if (!oacc_is_loop (code))
+ return;
+
+ if (code->op == EXEC_OACC_LOOP)
+ for (c = oacc_current_ctx; c; c = c->previous)
+ {
+ if (oacc_is_loop (c->code))
+ {
+ if (code->ext.omp_clauses->gang)
+ {
+ if (c->code->ext.omp_clauses->gang)
+ gfc_error ("Loop parallelized across gangs is not allowed "
+ "inside another loop parallelized across gangs at %L",
+ &code->loc);
+ 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",
+ &code->loc);
+ }
+ if (code->ext.omp_clauses->worker)
+ {
+ if (c->code->ext.omp_clauses->worker)
+ gfc_error ("Loop parallelized across workers is not allowed "
+ "inside another loop parallelized across workers at %L",
+ &code->loc);
+ if (c->code->ext.omp_clauses->vector)
+ gfc_error ("Loop parallelized across workers is not allowed "
+ "inside another loop parallelized across vectors at %L",
+ &code->loc);
+ }
+ if (code->ext.omp_clauses->vector)
+ if (c->code->ext.omp_clauses->vector)
+ gfc_error ("Loop parallelized across vectors is not allowed "
+ "inside another loop parallelized across vectors at %L",
+ &code->loc);
+ }
+
+ if (oacc_is_parallel (c->code) || oacc_is_kernels (c->code))
+ break;
+ }
+
+ if (code->ext.omp_clauses->seq)
+ {
+ if (code->ext.omp_clauses->independent)
+ gfc_error ("Clause SEQ conflicts with INDEPENDENT at %L", &code->loc);
+ if (code->ext.omp_clauses->gang)
+ gfc_error ("Clause SEQ conflicts with GANG at %L", &code->loc);
+ if (code->ext.omp_clauses->worker)
+ gfc_error ("Clause SEQ conflicts with WORKER at %L", &code->loc);
+ if (code->ext.omp_clauses->vector)
+ gfc_error ("Clause SEQ conflicts with VECTOR at %L", &code->loc);
+ if (code->ext.omp_clauses->par_auto)
+ gfc_error ("Clause SEQ conflicts with AUTO at %L", &code->loc);
+ }
+ if (code->ext.omp_clauses->par_auto)
+ {
+ if (code->ext.omp_clauses->gang)
+ gfc_error ("Clause AUTO conflicts with GANG at %L", &code->loc);
+ if (code->ext.omp_clauses->worker)
+ gfc_error ("Clause AUTO conflicts with WORKER at %L", &code->loc);
+ if (code->ext.omp_clauses->vector)
+ gfc_error ("Clause AUTO conflicts with VECTOR at %L", &code->loc);
+ }
+ if (!code->ext.omp_clauses->tile_list)
+ {
+ if (code->ext.omp_clauses->gang)
+ {
+ if (code->ext.omp_clauses->worker)
+ gfc_error ("Clause GANG conflicts with WORKER at %L", &code->loc);
+ if (code->ext.omp_clauses->vector)
+ gfc_error ("Clause GANG conflicts with VECTOR at %L", &code->loc);
+ }
+ if (code->ext.omp_clauses->worker)
+ if (code->ext.omp_clauses->vector)
+ gfc_error ("Clause WORKER conflicts with VECTOR at %L", &code->loc);
+ }
+ else if (code->ext.omp_clauses->gang
+ && code->ext.omp_clauses->worker
+ && code->ext.omp_clauses->vector)
+ gfc_error ("Tiled loop cannot be parallelized across gangs, workers and "
+ "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");
+
+ if (code->ext.omp_clauses->worker
+ && code->ext.omp_clauses->worker_expr)
+ resolve_oacc_params_in_parallel (code, "WORKER");
+
+ if (code->ext.omp_clauses->tile_list)
+ {
+ gfc_expr_list *el;
+ int num = 0;
+ for (el = code->ext.omp_clauses->tile_list; el; el = el->next)
+ {
+ num++;
+ if (el->expr == NULL)
+ continue;
+ resolve_oacc_positive_int_expr (el->expr, "TILE");
+ if (el->expr->expr_type != EXPR_CONSTANT)
+ gfc_error ("TILE requires constant expression at %L", &code->loc);
+ }
+ resolve_oacc_nested_loops (code, code->block->next, num, "tiled");
+ }
+}
+
+
+void
+gfc_resolve_oacc_blocks (gfc_code *code, gfc_namespace *ns)
+{
+ oacc_context ctx;
+
+ resolve_oacc_loop_blocks (code);
+
+ ctx.code = code;
+ ctx.previous = oacc_current_ctx;
+ oacc_current_ctx = &ctx;
+
+ gfc_resolve_blocks (code->block, ns);
+
+ oacc_current_ctx = ctx.previous;
+}
+
+
+static void
+resolve_oacc_loop(gfc_code *code)
+{
+ gfc_code *do_code;
+ int collapse;
+
+ if (code->ext.omp_clauses)
+ resolve_omp_clauses (code);
+
+ do_code = code->block->next;
+ collapse = code->ext.omp_clauses->collapse;
+
+ if (collapse <= 0)
+ collapse = 1;
+ resolve_oacc_nested_loops (code, do_code, collapse, "collapsed");
+}
+
+
+static void
+resolve_oacc_cache (gfc_code *)
+{
+ // Nothing to do yet
+}
+
+
+static void
+resolve_oacc_wait (gfc_code *code)
+{
+ gfc_expr_list* el;
+
+ for (el = code->ext.omp_clauses->wait_list; el; el = el->next)
+ resolve_oacc_positive_int_expr (el->expr, "WAIT");
+}
+
+
+void
+gfc_resolve_oacc_declare (gfc_namespace *ns)
+{
+ int list;
+ gfc_namelist *n;
+ locus loc;
+ static const char *clause_names[] = {"COPY", "COPYIN", "COPYOUT", "CREATE",
+ "DELETE", "PRESENT", "PRESENT_OR_COPY", "PRESENT_OR_COPYIN",
+ "PRESENT_OR_COPYOUT", "PRESENT_OR_CREATE", "DEVICEPTR",
+ "DEVICE_RESIDENT"};
+
+ if (ns->oacc_declare_clauses == NULL)
+ return;
+
+ loc = ns->oacc_declare_clauses->ext.loc;
+
+ for (list = OMP_LIST_DATA_CLAUSE_FIRST;
+ list <= OMP_LIST_DEVICE_RESIDENT; list++)
+ for (n = ns->oacc_declare_clauses->lists[list]; n; n = n->next)
+ {
+ n->sym->mark = 0;
+ if (n->sym->attr.flavor == FL_PARAMETER)
+ gfc_error ("PARAMETER object '%s' is not allowed at %L", n->sym->name, &loc);
+ }
+
+ for (list = OMP_LIST_DATA_CLAUSE_FIRST;
+ list <= OMP_LIST_DEVICE_RESIDENT; list++)
+ for (n = ns->oacc_declare_clauses->lists[list]; n; n = n->next)
+ {
+ if (n->sym->mark)
+ gfc_error ("Symbol '%s' present on multiple clauses at %L",
+ n->sym->name, &loc);
+ else
+ n->sym->mark = 1;
+ }
+
+ for (list = OMP_LIST_DATA_CLAUSE_FIRST;
+ list < OMP_LIST_DATA_CLAUSE_LAST; /* Skip deviceptr clause. */
+ list++)
+ {
+ const char *name = clause_names[list - OMP_LIST_DATA_CLAUSE_FIRST];
+ for (n = ns->oacc_declare_clauses->lists[list]; n; n = n->next)
+ resolve_oacc_data_clauses (n->sym, loc, name);
+ }
+
+ for (n = ns->oacc_declare_clauses->lists[OMP_LIST_DEVICEPTR]; n; n = n->next)
+ resolve_oacc_deviceptr_clause (n->sym, loc,
+ clause_names[OMP_LIST_DEVICEPTR -
+ OMP_LIST_DATA_CLAUSE_FIRST]);
+
+ for (n = ns->oacc_declare_clauses->lists[OMP_LIST_DEVICE_RESIDENT]; n;
+ n = n->next)
+ check_array_not_assumed (n->sym, loc,
+ clause_names[OMP_LIST_DEVICE_RESIDENT -
+ OMP_LIST_DATA_CLAUSE_FIRST]);
+}
+
+
+void
+gfc_resolve_oacc_directive (gfc_code *code, gfc_namespace *ns ATTRIBUTE_UNUSED)
+{
+ resolve_oacc_directive_inside_omp_region (code);
+
+ switch (code->op)
+ {
+ case EXEC_OACC_PARALLEL:
+ case EXEC_OACC_KERNELS:
+ case EXEC_OACC_DATA:
+ case EXEC_OACC_HOST_DATA:
+ case EXEC_OACC_UPDATE:
+ case EXEC_OACC_ENTER_DATA:
+ case EXEC_OACC_EXIT_DATA:
+ resolve_omp_clauses (code);
+ break;
+ case EXEC_OACC_PARALLEL_LOOP:
+ case EXEC_OACC_KERNELS_LOOP:
+ case EXEC_OACC_LOOP:
+ resolve_oacc_loop (code);
+ break;
+ case EXEC_OACC_CACHE:
+ resolve_oacc_cache (code);
+ break;
+ case EXEC_OACC_WAIT:
+ resolve_oacc_wait (code);
+ break;
+ default:
+ break;
+ }
+}
+
/* Resolve OpenMP directive clauses and check various requirements
of each directive. */
@@ -1734,6 +2909,8 @@ resolve_omp_do (gfc_code *code)
void
gfc_resolve_omp_directive (gfc_code *code, gfc_namespace *ns ATTRIBUTE_UNUSED)
{
+ resolve_omp_directive_inside_oacc_region (code);
+
if (code->op != EXEC_OMP_ATOMIC)
gfc_maybe_initialize_eh ();
--
1.8.3.2
^ permalink raw reply [flat|nested] 89+ messages in thread
* Re: [PATCH 3/4] [GOMP4] [Fortran] OpenACC 1.0+ support in fortran front-end
2014-03-04 7:57 ` [PATCH 2/4] " Ilmir Usmanov
@ 2014-03-04 7:58 ` Ilmir Usmanov
2014-03-04 7:59 ` [PATCH 4/4] " Ilmir Usmanov
2014-03-04 22:52 ` [PATCH 3/4] " Tobias Burnus
0 siblings, 2 replies; 89+ messages in thread
From: Ilmir Usmanov @ 2014-03-04 7:58 UTC (permalink / raw)
To: Tobias Burnus
Cc: Thomas Schwinge, Evgeny Gavrin, GarbuzovViacheslav,
Dmitri Botcharnikov, gcc-patches, jakub, fortran
[-- Attachment #1: Type: text/plain, Size: 909 bytes --]
OpenACC 1.0 fortran FE support -- translation to GENERIC.
gcc/fortran/
* trans-decl.c
(gfc_generate_function_code): Insert OACC_DECLARE GENERIC node.
* trans-openmp.c (gfc_convert_expr_to_tree): New helper function.
(gfc_trans_omp_array_reduction): Support also OpenACC. Add parameter.
(gfc_trans_omp_reduction_list): Update.
(gfc_trans_oacc_construct): New transform function.
(gfc_trans_omp_map_clause_list): Likewise.
(gfc_trans_oacc_executable_directive): Likewise.
(gfc_trans_oacc_combined_directive, gfc_trans_oacc_declare): Likewise.
(gfc_trans_oacc_directive): Use them.
(gfc_trans_oacc_loop): Stub.
(gfc_trans_omp_clauses): Transform OpenACC clauses.
* trans-stmt.h (gfc_trans_oacc_directive): New function prototype.
(gfc_trans_oacc_declare): Likewise.
* trans.c (trans_code): Transform also OpenACC directives.
[-- Attachment #2: 0003-OpenACC-Fortran-FE-part-3.patch --]
[-- Type: text/x-diff, Size: 15192 bytes --]
From b5010b30cc9fe6495cb9b9df356c044d267210c9 Mon Sep 17 00:00:00 2001
From: Ilmir Usmanov <i.usmanov@samsung.com>
Date: Wed, 26 Feb 2014 19:03:24 +0400
Subject: [PATCH 3/5] OpenACC Fortran FE: part 3
---
gcc/fortran/trans-decl.c | 7 +
gcc/fortran/trans-openmp.c | 357 +++++++++++++++++++++++++++++++++++++++++++++
gcc/fortran/trans-stmt.c | 8 +
gcc/fortran/trans-stmt.h | 4 +
gcc/fortran/trans.c | 15 ++
5 files changed, 391 insertions(+)
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 9c86653..ad26ef8 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -5606,6 +5606,13 @@ gfc_generate_function_code (gfc_namespace * ns)
if ((gfc_option.rtcheck & GFC_RTCHECK_BOUNDS) && !sym->attr.is_bind_c)
add_argument_checking (&body, sym);
+ /* Generate !$ACC DECLARE directive. */
+ if (ns->oacc_declare_clauses)
+ {
+ tree tmp = gfc_trans_oacc_declare (&body, ns);
+ gfc_add_expr_to_block (&body, tmp);
+ }
+
tmp = gfc_trans_code (ns->code);
gfc_add_expr_to_block (&body, tmp);
diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
index 41020a8..a1abd66 100644
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -767,6 +767,40 @@ gfc_trans_omp_reduction_list (gfc_namelist *namelist, tree list,
}
static tree
+gfc_trans_omp_map_clause_list (enum omp_clause_map_kind kind,
+ gfc_namelist *namelist, tree list)
+{
+ for (; namelist != NULL; namelist = namelist->next)
+ if (namelist->sym->attr.referenced)
+ {
+ tree t = gfc_trans_omp_variable (namelist->sym);
+ if (t != error_mark_node)
+ {
+ tree node = build_omp_clause (input_location, OMP_CLAUSE_MAP);
+ OMP_CLAUSE_DECL (node) = t;
+ OMP_CLAUSE_MAP_KIND (node) = kind;
+ list = gfc_trans_add_clause (node, list);
+ }
+ }
+ return list;
+}
+
+static inline tree
+gfc_convert_expr_to_tree (stmtblock_t *block, gfc_expr *expr)
+{
+ gfc_se se;
+ tree result;
+
+ gfc_init_se (&se, NULL );
+ gfc_conv_expr (&se, expr);
+ gfc_add_block_to_block (block, &se.pre);
+ result = gfc_evaluate_now (se.expr, block);
+ gfc_add_block_to_block (block, &se.post);
+
+ return result;
+}
+
+static tree
gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
locus where)
{
@@ -834,6 +868,51 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
where);
continue;
}
+ if (list >= OMP_LIST_DATA_CLAUSE_FIRST
+ && list <= OMP_LIST_DATA_CLAUSE_LAST)
+ {
+ enum omp_clause_map_kind kind;
+ switch (list)
+ {
+ case OMP_LIST_COPY:
+ kind = OMP_CLAUSE_MAP_FORCE_TOFROM;
+ break;
+ case OMP_LIST_OACC_COPYIN:
+ kind = OMP_CLAUSE_MAP_FORCE_TO;
+ break;
+ case OMP_LIST_COPYOUT:
+ kind = OMP_CLAUSE_MAP_FORCE_FROM;
+ break;
+ case OMP_LIST_CREATE:
+ kind = OMP_CLAUSE_MAP_FORCE_ALLOC;
+ break;
+ case OMP_LIST_DELETE:
+ kind = OMP_CLAUSE_MAP_FORCE_DEALLOC;
+ break;
+ case OMP_LIST_PRESENT:
+ kind = OMP_CLAUSE_MAP_FORCE_PRESENT;
+ break;
+ case OMP_LIST_PRESENT_OR_COPY:
+ kind = OMP_CLAUSE_MAP_TOFROM;
+ break;
+ case OMP_LIST_PRESENT_OR_COPYIN:
+ kind = OMP_CLAUSE_MAP_TO;
+ break;
+ case OMP_LIST_PRESENT_OR_COPYOUT:
+ kind = OMP_CLAUSE_MAP_FROM;
+ break;
+ case OMP_LIST_PRESENT_OR_CREATE:
+ kind = OMP_CLAUSE_MAP_ALLOC;
+ break;
+ case OMP_LIST_DEVICEPTR:
+ kind = OMP_CLAUSE_MAP_FORCE_DEVICEPTR;
+ break;
+ default:
+ gcc_unreachable ();
+ }
+ omp_clauses = gfc_trans_omp_map_clause_list (kind, n, omp_clauses);
+ continue;
+ }
switch (list)
{
case OMP_LIST_PRIVATE:
@@ -853,6 +932,21 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
goto add_clause;
case OMP_LIST_COPYPRIVATE:
clause_code = OMP_CLAUSE_COPYPRIVATE;
+ goto add_clause;
+ case OMP_LIST_USE_DEVICE:
+ clause_code = OMP_CLAUSE_USE_DEVICE;
+ goto add_clause;
+ case OMP_LIST_DEVICE_RESIDENT:
+ clause_code = OMP_CLAUSE_DEVICE_RESIDENT;
+ goto add_clause;
+ case OMP_LIST_HOST:
+ clause_code = OMP_CLAUSE_HOST;
+ goto add_clause;
+ case OMP_LIST_DEVICE:
+ clause_code = OMP_CLAUSE_OACC_DEVICE;
+ goto add_clause;
+ case OMP_LIST_CACHE:
+ clause_code = OMP_NO_CLAUSE_CACHE;
/* FALLTHROUGH */
add_clause:
omp_clauses
@@ -1000,6 +1094,107 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
omp_clauses = gfc_trans_add_clause (c, omp_clauses);
}
+ if (clauses->async)
+ {
+ c = build_omp_clause (where.lb->location, OMP_CLAUSE_ASYNC);
+ if (clauses->async_expr)
+ OMP_CLAUSE_ASYNC_EXPR (c) =
+ gfc_convert_expr_to_tree (block, clauses->async_expr);
+ else
+ OMP_CLAUSE_ASYNC_EXPR (c) = NULL;
+ omp_clauses = gfc_trans_add_clause (c, omp_clauses);
+ }
+ if (clauses->seq)
+ {
+ c = build_omp_clause (where.lb->location, OMP_CLAUSE_ORDERED);
+ omp_clauses = gfc_trans_add_clause (c, omp_clauses);
+ }
+ if (clauses->independent)
+ {
+ c = build_omp_clause (where.lb->location, OMP_CLAUSE_INDEPENDENT);
+ omp_clauses = gfc_trans_add_clause (c, omp_clauses);
+ }
+ if (clauses->num_gangs_expr)
+ {
+ tree num_gangs_var =
+ gfc_convert_expr_to_tree (block, clauses->num_gangs_expr);
+ c = build_omp_clause (where.lb->location, OMP_CLAUSE_NUM_GANGS);
+ OMP_CLAUSE_NUM_GANGS_EXPR (c) = num_gangs_var;
+ omp_clauses = gfc_trans_add_clause (c, omp_clauses);
+ }
+ if (clauses->num_workers_expr)
+ {
+ tree num_workers_var =
+ gfc_convert_expr_to_tree (block, clauses->num_workers_expr);
+ c = build_omp_clause (where.lb->location, OMP_CLAUSE_NUM_WORKERS);
+ OMP_CLAUSE_NUM_WORKERS_EXPR (c)= num_workers_var;
+ omp_clauses = gfc_trans_add_clause (c, omp_clauses);
+ }
+ if (clauses->vector_length_expr)
+ {
+ tree vector_length_var =
+ gfc_convert_expr_to_tree (block, clauses->vector_length_expr);
+ c = build_omp_clause (where.lb->location, OMP_CLAUSE_VECTOR_LENGTH);
+ OMP_CLAUSE_VECTOR_LENGTH_EXPR (c)= vector_length_var;
+ omp_clauses = gfc_trans_add_clause (c, omp_clauses);
+ }
+ if (clauses->vector)
+ {
+ if (clauses->vector_expr)
+ {
+ tree vector_var =
+ gfc_convert_expr_to_tree (block, clauses->vector_expr);
+ c = build_omp_clause (where.lb->location, OMP_CLAUSE_VECTOR);
+ OMP_CLAUSE_VECTOR_EXPR (c)= vector_var;
+ omp_clauses = gfc_trans_add_clause (c, omp_clauses);
+ }
+ else
+ {
+ c = build_omp_clause (where.lb->location, OMP_CLAUSE_VECTOR);
+ omp_clauses = gfc_trans_add_clause (c, omp_clauses);
+ }
+ }
+ if (clauses->worker)
+ {
+ if (clauses->worker_expr)
+ {
+ tree worker_var =
+ gfc_convert_expr_to_tree (block, clauses->worker_expr);
+ c = build_omp_clause (where.lb->location, OMP_CLAUSE_WORKER);
+ OMP_CLAUSE_WORKER_EXPR (c)= worker_var;
+ omp_clauses = gfc_trans_add_clause (c, omp_clauses);
+ }
+ else
+ {
+ c = build_omp_clause (where.lb->location, OMP_CLAUSE_WORKER);
+ omp_clauses = gfc_trans_add_clause (c, omp_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);
+ OMP_CLAUSE_GANG_EXPR (c)= gang_var;
+ omp_clauses = gfc_trans_add_clause (c, omp_clauses);
+ }
+ else
+ {
+ c = build_omp_clause (where.lb->location, OMP_CLAUSE_GANG);
+ omp_clauses = gfc_trans_add_clause (c, omp_clauses);
+ }
+ }
+ if (clauses->non_clause_wait_expr)
+ {
+ tree wait_var =
+ gfc_convert_expr_to_tree (block, clauses->non_clause_wait_expr);
+ c = build_omp_clause (where.lb->location, OMP_CLAUSE_WAIT);
+ OMP_WAIT_EXPR (c)= wait_var;
+ omp_clauses = gfc_trans_add_clause (c, omp_clauses);
+ }
+
return omp_clauses;
}
@@ -1027,6 +1222,80 @@ gfc_trans_omp_code (gfc_code *code, bool force_empty)
return stmt;
}
+/* Trans OpenACC directives. */
+/* parallel, kernels, data and host_data. */
+static tree
+gfc_trans_oacc_construct (gfc_code *code)
+{
+ stmtblock_t block;
+ tree stmt, oacc_clauses;
+ enum tree_code construct_code;
+
+ switch (code->op)
+ {
+ case EXEC_OACC_PARALLEL:
+ construct_code = OACC_PARALLEL;
+ break;
+ case EXEC_OACC_KERNELS:
+ construct_code = OACC_KERNELS;
+ break;
+ case EXEC_OACC_DATA:
+ construct_code = OACC_DATA;
+ break;
+ case EXEC_OACC_HOST_DATA:
+ construct_code = OACC_HOST_DATA;
+ break;
+ default:
+ gcc_unreachable ();
+ }
+
+ gfc_start_block (&block);
+ oacc_clauses = gfc_trans_omp_clauses (&block, code->ext.omp_clauses,
+ code->loc);
+ stmt = gfc_trans_omp_code (code->block->next, true);
+ stmt = build2_loc (input_location, construct_code, void_type_node, stmt,
+ oacc_clauses);
+ gfc_add_expr_to_block (&block, stmt);
+ return gfc_finish_block (&block);
+}
+
+/* update, enter_data, exit_data, wait, cache. */
+static tree
+gfc_trans_oacc_executable_directive (gfc_code *code)
+{
+ stmtblock_t block;
+ tree stmt, oacc_clauses;
+ enum tree_code construct_code;
+
+ switch (code->op)
+ {
+ case EXEC_OACC_UPDATE:
+ construct_code = OACC_UPDATE;
+ break;
+ case EXEC_OACC_ENTER_DATA:
+ construct_code = OACC_ENTER_DATA;
+ break;
+ case EXEC_OACC_EXIT_DATA:
+ construct_code = OACC_EXIT_DATA;
+ break;
+ case EXEC_OACC_WAIT:
+ construct_code = OACC_WAIT;
+ break;
+ case EXEC_OACC_CACHE:
+ construct_code = OACC_CACHE;
+ break;
+ default:
+ gcc_unreachable ();
+ }
+
+ gfc_start_block (&block);
+ oacc_clauses = gfc_trans_omp_clauses (&block, code->ext.omp_clauses,
+ code->loc);
+ stmt = build1_loc (input_location, construct_code, void_type_node,
+ oacc_clauses);
+ gfc_add_expr_to_block (&block, stmt);
+ return gfc_finish_block (&block);
+}
static tree gfc_trans_omp_sections (gfc_code *, gfc_omp_clauses *);
static tree gfc_trans_omp_workshare (gfc_code *, gfc_omp_clauses *);
@@ -1302,6 +1571,57 @@ typedef struct dovar_init_d {
tree init;
} dovar_init;
+/* parallel loop and kernels loop. */
+static tree
+gfc_trans_oacc_combined_directive (gfc_code *code)
+{
+ stmtblock_t block;
+ gfc_omp_clauses construct_clauses, loop_clauses;
+ tree stmt, oacc_clauses = NULL_TREE;
+ enum tree_code construct_code;
+
+ switch (code->op)
+ {
+ case EXEC_OACC_PARALLEL_LOOP:
+ construct_code = OACC_PARALLEL;
+ break;
+ case EXEC_OACC_KERNELS_LOOP:
+ construct_code = OACC_KERNELS;
+ break;
+ default:
+ gcc_unreachable ();
+ }
+
+ gfc_start_block (&block);
+
+ memset (&loop_clauses, 0, sizeof (loop_clauses));
+ if (code->ext.omp_clauses != NULL)
+ {
+ memcpy (&construct_clauses, code->ext.omp_clauses,
+ sizeof (construct_clauses));
+ loop_clauses.collapse = construct_clauses.collapse;
+ loop_clauses.gang = construct_clauses.gang;
+ loop_clauses.vector = construct_clauses.vector;
+ loop_clauses.worker = construct_clauses.worker;
+ loop_clauses.seq = construct_clauses.seq;
+ loop_clauses.independent = construct_clauses.independent;
+ construct_clauses.collapse = 0;
+ construct_clauses.gang = false;
+ construct_clauses.vector = false;
+ construct_clauses.worker = false;
+ construct_clauses.seq = false;
+ construct_clauses.independent = false;
+ oacc_clauses = gfc_trans_omp_clauses (&block, &construct_clauses,
+ code->loc);
+ }
+
+ gfc_error ("!$ACC LOOP directive not implemented yet %L", &code->loc);
+ stmt = gfc_trans_omp_code (code->block->next, true);
+ stmt = build2_loc (input_location, construct_code, void_type_node, stmt,
+ oacc_clauses);
+ gfc_add_expr_to_block (&block, stmt);
+ return gfc_finish_block (&block);
+}
static tree
gfc_trans_omp_do (gfc_code *code, stmtblock_t *pblock,
@@ -1915,6 +2235,43 @@ gfc_trans_omp_workshare (gfc_code *code, gfc_omp_clauses *clauses)
}
tree
+gfc_trans_oacc_declare (stmtblock_t *block, gfc_namespace *ns)
+{
+ tree oacc_clauses;
+ oacc_clauses = gfc_trans_omp_clauses (block, ns->oacc_declare_clauses,
+ ns->oacc_declare_clauses->ext.loc);
+ return build1_loc (ns->oacc_declare_clauses->ext.loc.lb->location,
+ OACC_DECLARE, void_type_node, oacc_clauses);
+}
+
+tree
+gfc_trans_oacc_directive (gfc_code *code)
+{
+ switch (code->op)
+ {
+ case EXEC_OACC_PARALLEL_LOOP:
+ case EXEC_OACC_KERNELS_LOOP:
+ return gfc_trans_oacc_combined_directive (code);
+ case EXEC_OACC_PARALLEL:
+ case EXEC_OACC_KERNELS:
+ case EXEC_OACC_DATA:
+ case EXEC_OACC_HOST_DATA:
+ return gfc_trans_oacc_construct (code);
+ case EXEC_OACC_LOOP:
+ gfc_error ("!$ACC LOOP directive not implemented yet %L", &code->loc);
+ return NULL_TREE;
+ case EXEC_OACC_UPDATE:
+ case EXEC_OACC_WAIT:
+ case EXEC_OACC_CACHE:
+ case EXEC_OACC_ENTER_DATA:
+ case EXEC_OACC_EXIT_DATA:
+ return gfc_trans_oacc_executable_directive (code);
+ default:
+ gcc_unreachable ();
+ }
+}
+
+tree
gfc_trans_omp_directive (gfc_code *code)
{
switch (code->op)
diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index 19e29a7..9b3113a 100644
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -1352,6 +1352,14 @@ gfc_trans_block_construct (gfc_code* code)
gfc_init_block (&body);
exit_label = gfc_build_label_decl (NULL_TREE);
code->exit_label = exit_label;
+
+ /* Generate !$ACC DECLARE directive. */
+ if (ns->oacc_declare_clauses)
+ {
+ tree tmp = gfc_trans_oacc_declare (&body, ns);
+ gfc_add_expr_to_block (&body, tmp);
+ }
+
gfc_add_expr_to_block (&body, gfc_trans_code (ns->code));
gfc_add_expr_to_block (&body, build1_v (LABEL_EXPR, exit_label));
diff --git a/gcc/fortran/trans-stmt.h b/gcc/fortran/trans-stmt.h
index 8a57be4..ad3a5e6 100644
--- a/gcc/fortran/trans-stmt.h
+++ b/gcc/fortran/trans-stmt.h
@@ -64,6 +64,10 @@ tree gfc_trans_deallocate_array (tree);
/* trans-openmp.c */
tree gfc_trans_omp_directive (gfc_code *);
+/* trans-openacc.c */
+tree gfc_trans_oacc_directive (gfc_code *);
+tree gfc_trans_oacc_declare (stmtblock_t *block, gfc_namespace *);
+
/* trans-io.c */
tree gfc_trans_open (gfc_code *);
tree gfc_trans_close (gfc_code *);
diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c
index c5b3b9e..54686f5 100644
--- a/gcc/fortran/trans.c
+++ b/gcc/fortran/trans.c
@@ -1850,6 +1850,21 @@ trans_code (gfc_code * code, tree cond)
res = gfc_trans_omp_directive (code);
break;
+ case EXEC_OACC_CACHE:
+ case EXEC_OACC_WAIT:
+ case EXEC_OACC_UPDATE:
+ case EXEC_OACC_LOOP:
+ case EXEC_OACC_HOST_DATA:
+ case EXEC_OACC_DATA:
+ case EXEC_OACC_KERNELS:
+ case EXEC_OACC_KERNELS_LOOP:
+ case EXEC_OACC_PARALLEL:
+ case EXEC_OACC_PARALLEL_LOOP:
+ case EXEC_OACC_ENTER_DATA:
+ case EXEC_OACC_EXIT_DATA:
+ res = gfc_trans_oacc_directive (code);
+ break;
+
default:
internal_error ("gfc_trans_code(): Bad statement code");
}
--
1.8.3.2
^ permalink raw reply [flat|nested] 89+ messages in thread
* Re: [PATCH 4/4] [GOMP4] [Fortran] OpenACC 1.0+ support in fortran front-end
2014-03-04 7:58 ` [PATCH 3/4] " Ilmir Usmanov
@ 2014-03-04 7:59 ` Ilmir Usmanov
2014-03-04 22:56 ` Tobias Burnus
2014-03-04 22:52 ` [PATCH 3/4] " Tobias Burnus
1 sibling, 1 reply; 89+ messages in thread
From: Ilmir Usmanov @ 2014-03-04 7:59 UTC (permalink / raw)
To: Tobias Burnus
Cc: Thomas Schwinge, Evgeny Gavrin, GarbuzovViacheslav,
Dmitri Botcharnikov, gcc-patches, jakub, fortran
[-- Attachment #1: Type: text/plain, Size: 1030 bytes --]
OpenACC 1.0 fortran FE support -- tests.
gcc/testsuite/gfortran.dg/goacc/
* assumed.f95: New test
* branch.f95: Likewise
* coarray.f95: Likewise
* continuation-free-form.f95: Likewise
* cray.f95: Likewise
* critical.f95: Likewise
* data-clauses.f95: Likewise
* data-tree.f95: Likewise
* declare-1.f95: Likewise
* enter-exit-data.f95: Likewise
* goacc.exp: Likewise
* host_data-tree.f95: Likewise
* if.f95: Likewise
* kernels-tree.f95: Likewise
* list.f95: Likewise
* literal.f95: Likewise
* loop-1.f95: Likewise
* loop-2.f95: Likewise
* loop-3.f95: Likewise
* omp.f95: Likewise
* parallel-kernels-clauses.f95: Likewise
* parallel-kernels-regions.f95: Likewise
* parallel-tree.f95: Likewise
* parameter.f95: Likewise
* pure-elemental-procedures.f95: Likewise
* reduction.f95: Likewise
* sentinel-free-form.f95: Likewise
* several-directives.f95: Likewise
* sie.f95: Likewise
[-- Attachment #2: 0005-OpenACC-Fortran-FE-Tests.patch --]
[-- Type: text/x-diff, Size: 84075 bytes --]
From fa7d9b00f3a9134282ee70ab34543c87fea06a82 Mon Sep 17 00:00:00 2001
From: Ilmir Usmanov <i.usmanov@samsung.com>
Date: Wed, 26 Feb 2014 19:05:23 +0400
Subject: [PATCH 5/5] OpenACC Fortran FE: Tests
---
gcc/testsuite/gfortran.dg/goacc/assumed.f95 | 66 +++
gcc/testsuite/gfortran.dg/goacc/branch.f95 | 53 ++
gcc/testsuite/gfortran.dg/goacc/coarray.f95 | 35 ++
.../gfortran.dg/goacc/continuation-free-form.f95 | 23 +
gcc/testsuite/gfortran.dg/goacc/cray.f95 | 53 ++
gcc/testsuite/gfortran.dg/goacc/critical.f95 | 27 +
gcc/testsuite/gfortran.dg/goacc/data-clauses.f95 | 259 ++++++++
gcc/testsuite/gfortran.dg/goacc/data-tree.f95 | 31 +
gcc/testsuite/gfortran.dg/goacc/declare-1.f95 | 20 +
.../gfortran.dg/goacc/enter-exit-data.f95 | 88 +++
gcc/testsuite/gfortran.dg/goacc/goacc.exp | 36 ++
gcc/testsuite/gfortran.dg/goacc/host_data-tree.f95 | 13 +
gcc/testsuite/gfortran.dg/goacc/if.f95 | 52 ++
gcc/testsuite/gfortran.dg/goacc/kernels-tree.f95 | 33 ++
gcc/testsuite/gfortran.dg/goacc/list.f95 | 111 ++++
gcc/testsuite/gfortran.dg/goacc/literal.f95 | 29 +
gcc/testsuite/gfortran.dg/goacc/loop-1.f95 | 170 ++++++
gcc/testsuite/gfortran.dg/goacc/loop-2.f95 | 649 +++++++++++++++++++++
gcc/testsuite/gfortran.dg/goacc/loop-3.f95 | 31 +
gcc/testsuite/gfortran.dg/goacc/omp.f95 | 66 +++
.../gfortran.dg/goacc/parallel-kernels-clauses.f95 | 98 ++++
.../gfortran.dg/goacc/parallel-kernels-regions.f95 | 56 ++
gcc/testsuite/gfortran.dg/goacc/parallel-tree.f95 | 42 ++
gcc/testsuite/gfortran.dg/goacc/parameter.f95 | 30 +
.../goacc/pure-elemental-procedures.f95 | 78 +++
gcc/testsuite/gfortran.dg/goacc/reduction.f95 | 138 +++++
.../gfortran.dg/goacc/sentinel-free-form.f95 | 21 +
.../gfortran.dg/goacc/several-directives.f95 | 6 +
gcc/testsuite/gfortran.dg/goacc/sie.f95 | 252 ++++++++
29 files changed, 2566 insertions(+)
create mode 100644 gcc/testsuite/gfortran.dg/goacc/assumed.f95
create mode 100644 gcc/testsuite/gfortran.dg/goacc/branch.f95
create mode 100644 gcc/testsuite/gfortran.dg/goacc/coarray.f95
create mode 100644 gcc/testsuite/gfortran.dg/goacc/continuation-free-form.f95
create mode 100644 gcc/testsuite/gfortran.dg/goacc/cray.f95
create mode 100644 gcc/testsuite/gfortran.dg/goacc/critical.f95
create mode 100644 gcc/testsuite/gfortran.dg/goacc/data-clauses.f95
create mode 100644 gcc/testsuite/gfortran.dg/goacc/data-tree.f95
create mode 100644 gcc/testsuite/gfortran.dg/goacc/declare-1.f95
create mode 100644 gcc/testsuite/gfortran.dg/goacc/enter-exit-data.f95
create mode 100644 gcc/testsuite/gfortran.dg/goacc/goacc.exp
create mode 100644 gcc/testsuite/gfortran.dg/goacc/host_data-tree.f95
create mode 100644 gcc/testsuite/gfortran.dg/goacc/if.f95
create mode 100644 gcc/testsuite/gfortran.dg/goacc/kernels-tree.f95
create mode 100644 gcc/testsuite/gfortran.dg/goacc/list.f95
create mode 100644 gcc/testsuite/gfortran.dg/goacc/literal.f95
create mode 100644 gcc/testsuite/gfortran.dg/goacc/loop-1.f95
create mode 100644 gcc/testsuite/gfortran.dg/goacc/loop-2.f95
create mode 100644 gcc/testsuite/gfortran.dg/goacc/loop-3.f95
create mode 100644 gcc/testsuite/gfortran.dg/goacc/omp.f95
create mode 100644 gcc/testsuite/gfortran.dg/goacc/parallel-kernels-clauses.f95
create mode 100644 gcc/testsuite/gfortran.dg/goacc/parallel-kernels-regions.f95
create mode 100644 gcc/testsuite/gfortran.dg/goacc/parallel-tree.f95
create mode 100644 gcc/testsuite/gfortran.dg/goacc/parameter.f95
create mode 100644 gcc/testsuite/gfortran.dg/goacc/pure-elemental-procedures.f95
create mode 100644 gcc/testsuite/gfortran.dg/goacc/reduction.f95
create mode 100644 gcc/testsuite/gfortran.dg/goacc/sentinel-free-form.f95
create mode 100644 gcc/testsuite/gfortran.dg/goacc/several-directives.f95
create mode 100644 gcc/testsuite/gfortran.dg/goacc/sie.f95
diff --git a/gcc/testsuite/gfortran.dg/goacc/assumed.f95 b/gcc/testsuite/gfortran.dg/goacc/assumed.f95
new file mode 100644
index 0000000..4f6c23f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/assumed.f95
@@ -0,0 +1,66 @@
+! { dg-do compile }
+! { dg-additional-options "-fmax-errors=100" }
+
+module test
+contains
+ subroutine assumed_size(a)
+ implicit none
+ integer :: a(*), i
+ !$acc declare device_resident (a) ! { dg-error "Assumed size" }
+ !$acc data copy (a) ! { dg-error "Assumed size" }
+ !$acc end data
+ !$acc data deviceptr (a) ! { dg-error "Assumed size" }
+ !$acc end data
+ !$acc parallel private (a) ! { dg-error "Assumed size" }
+ !$acc end parallel
+ !$acc host_data use_device (a) ! { dg-error "Assumed size" }
+ !$acc end host_data
+ !$acc parallel loop reduction(+:a) ! { dg-error "Assumed size" }
+ do i = 1,5
+ enddo
+ !$acc end parallel loop
+ !$acc update host (a) ! { dg-error "Assumed size" }
+ !$acc update device (a) ! { dg-error "Assumed size" }
+ end subroutine assumed_size
+
+ subroutine assumed_shape(a)
+ implicit none
+ integer :: a(:), i
+ !$acc declare device_resident (a) ! { dg-error "Assumed shape" }
+ !$acc data copy (a) ! { dg-error "Assumed shape" }
+ !$acc end data
+ !$acc data deviceptr (a) ! { dg-error "Assumed shape" }
+ !$acc end data
+ !$acc parallel private (a) ! { dg-error "Assumed shape" }
+ !$acc end parallel
+ !$acc host_data use_device (a) ! { dg-error "Assumed shape" }
+ !$acc end host_data
+ !$acc parallel loop reduction(+:a) ! { dg-error "Assumed shape" }
+ do i = 1,5
+ enddo
+ !$acc end parallel loop
+ !$acc update host (a) ! { dg-error "Assumed shape" }
+ !$acc update device (a) ! { dg-error "Assumed shape" }
+ end subroutine assumed_shape
+
+ subroutine assumed_rank(a)
+ implicit none
+ integer, intent(in) :: a(..)
+ integer :: i
+ !$acc declare device_resident (a) ! { dg-error "Assumed rank" }
+ !$acc data copy (a) ! { dg-error "Assumed rank" }
+ !$acc end data
+ !$acc data deviceptr (a) ! { dg-error "Assumed rank" }
+ !$acc end data
+ !$acc parallel private (a) ! { dg-error "Assumed rank" }
+ !$acc end parallel
+ !$acc host_data use_device (a) ! { dg-error "Assumed rank" }
+ !$acc end host_data
+ !$acc parallel loop reduction(+:a) ! { dg-error "Assumed rank" }
+ do i = 1,5
+ enddo
+ !$acc end parallel loop
+ !$acc update host (a) ! { dg-error "Assumed rank" }
+ !$acc update device (a) ! { dg-error "Assumed rank" }
+ end subroutine assumed_rank
+end module test
\ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/goacc/branch.f95 b/gcc/testsuite/gfortran.dg/goacc/branch.f95
new file mode 100644
index 0000000..7eed3e2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/branch.f95
@@ -0,0 +1,53 @@
+! { dg-do compile }
+
+program test
+ implicit none
+
+ integer :: i
+
+ if (.true.) then
+ !$acc parallel
+ end if ! { dg-error "Unexpected" }
+ !$acc end parallel
+ end if
+
+ if (.true.) then
+ !$acc kernels
+ end if ! { dg-error "Unexpected" }
+ !$acc end kernels
+ end if
+
+ !$acc parallel
+ if (.true.) then
+ !$acc end parallel ! { dg-error "Unexpected" }
+ end if
+ !$acc end parallel
+
+ !$acc kernels
+ if (.true.) then
+ !$acc end kernels ! { dg-error "Unexpected" }
+ end if
+ !$acc end kernels
+
+ !$acc parallel
+ if (.true.) then
+ end if
+ !$acc end parallel
+
+ !$acc kernels
+ if (.true.) then
+ end if
+ !$acc end kernels
+
+ if (.true.) then
+ !$acc parallel
+ !$acc end parallel
+ end if
+
+ if (.true.) then
+ !$acc kernels
+ !$acc end kernels
+ end if
+
+
+end program test
\ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/goacc/coarray.f95 b/gcc/testsuite/gfortran.dg/goacc/coarray.f95
new file mode 100644
index 0000000..7afb4bc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/coarray.f95
@@ -0,0 +1,35 @@
+! { dg-do compile }
+! { dg-additional-options "-fcoarray=single" }
+
+! TODO: These cases must fail
+
+module test
+contains
+ subroutine oacc1(a)
+ implicit none
+ integer :: i
+ integer, codimension[*] :: a
+ !$acc declare device_resident (a)
+ !$acc data copy (a)
+ !$acc end data
+ !$acc data deviceptr (a)
+ !$acc end data
+ !$acc parallel private (a)
+ !$acc end parallel
+ !$acc host_data use_device (a)
+ !$acc end host_data
+ !$acc parallel loop reduction(+:a)
+ do i = 1,5
+ enddo
+ !$acc end parallel loop
+ !$acc parallel loop
+ do i = 1,5
+ !$acc cache (a)
+ enddo
+ !$acc end parallel loop
+ !$acc update host (a)
+ !$acc update device (a)
+ end subroutine oacc1
+end module test
+! { dg-excess-errors "Unimplemented" }
+! { dg-excess-errors "ACC LOOP" }
\ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/goacc/continuation-free-form.f95 b/gcc/testsuite/gfortran.dg/goacc/continuation-free-form.f95
new file mode 100644
index 0000000..1c9a3f3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/continuation-free-form.f95
@@ -0,0 +1,23 @@
+! { dg-do compile }
+
+program test
+ implicit none
+
+ integer :: i
+ real :: x
+
+ !$acc parallel &
+ !$acc loop & ! continuation
+ !$acc & reduction(+:x)
+
+ ! this line must be ignored
+ !$acc ! kernels
+ do i = 1,10
+ x = x + 0.3
+ enddo
+ ! continuation must begin with sentinel
+ !$acc end parallel & ! { dg-error "Unclassifiable OpenACC directive" }
+ ! loop
+
+ print *, x
+end
\ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/goacc/cray.f95 b/gcc/testsuite/gfortran.dg/goacc/cray.f95
new file mode 100644
index 0000000..b4d6a9d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/cray.f95
@@ -0,0 +1,53 @@
+! { dg-do compile }
+! { dg-additional-options "-fcray-pointer" }
+
+module test
+contains
+ subroutine oacc1
+ implicit none
+ integer :: i
+ real :: pointee
+ pointer (ptr, pointee)
+ !$acc declare device_resident (pointee)
+ !$acc declare device_resident (ptr)
+ !$acc data copy (pointee) ! { dg-error "Cray pointee" }
+ !$acc end data
+ !$acc data deviceptr (pointee) ! { dg-error "Cray pointee" }
+ !$acc end data
+ !$acc parallel private (pointee) ! { dg-error "Cray pointee" }
+ !$acc end parallel
+ !$acc host_data use_device (pointee) ! { dg-error "Cray pointee" }
+ !$acc end host_data
+ !$acc parallel loop reduction(+:pointee) ! { dg-error "Cray pointee" }
+ do i = 1,5
+ enddo
+ !$acc end parallel loop
+ !$acc parallel loop
+ do i = 1,5
+ ! Subarrays are not implemented yet
+ !$acc cache (pointee) ! TODO: This must fail, as in openacc-1_0-branch
+ enddo
+ !$acc end parallel loop
+ !$acc update host (pointee) ! { dg-error "Cray pointee" }
+ !$acc update device (pointee) ! { dg-error "Cray pointee" }
+ !$acc data copy (ptr)
+ !$acc end data
+ !$acc data deviceptr (ptr) ! { dg-error "Cray pointer" }
+ !$acc end data
+ !$acc parallel private (ptr)
+ !$acc end parallel
+ !$acc host_data use_device (ptr) ! { dg-error "Cray pointer" }
+ !$acc end host_data
+ !$acc parallel loop reduction(+:ptr) ! { dg-error "Cray pointer" }
+ do i = 1,5
+ enddo
+ !$acc end parallel loop
+ !$acc parallel loop
+ do i = 1,5
+ !$acc cache (ptr) ! TODO: This must fail, as in openacc-1_0-branch
+ enddo
+ !$acc end parallel loop
+ !$acc update host (ptr)
+ !$acc update device (ptr)
+ end subroutine oacc1
+end module test
\ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/goacc/critical.f95 b/gcc/testsuite/gfortran.dg/goacc/critical.f95
new file mode 100644
index 0000000..510ea18
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/critical.f95
@@ -0,0 +1,27 @@
+! { dg-do compile }
+! { dg-additional-options "-fcoarray=single" }
+
+module test
+contains
+ subroutine oacc1
+ implicit none
+ integer :: i, j
+ j = 0
+ !$acc parallel
+ critical ! { dg-error "CRITICAL block inside of" }
+ j = j + 1
+ end critical
+ !$acc end parallel
+ end subroutine oacc1
+
+ subroutine oacc2
+ implicit none
+ integer :: i, j
+ j = 0
+ critical
+ !$acc parallel ! { dg-error "OpenACC directive inside of" }
+ j = j + 1
+ !$acc end parallel
+ end critical
+ end subroutine oacc2
+end module test
\ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/goacc/data-clauses.f95 b/gcc/testsuite/gfortran.dg/goacc/data-clauses.f95
new file mode 100644
index 0000000..b65d61d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/data-clauses.f95
@@ -0,0 +1,259 @@
+! { dg-do compile }
+! { dg-additional-options "-fmax-errors=100" }
+
+module test
+ implicit none
+contains
+
+ subroutine foo (vi)
+ integer, value :: vi
+ integer :: i, ia(10)
+ complex :: c, ca(10)
+ real, target:: r
+ real :: ra(10)
+ real, pointer :: rp
+ real, dimension(:), allocatable :: aa
+ type t
+ integer :: i
+ end type
+ type(t) :: ti
+ type(t), allocatable :: tia
+ type(t), target :: tit
+ type(t), pointer :: tip
+ rp => r
+ tip => tit
+
+ !$acc parallel deviceptr (rp) ! { dg-error "POINTER" }
+ !$acc end parallel
+ !$acc parallel deviceptr (vi) ! { dg-error "VALUE" }
+ !$acc end parallel
+ !$acc parallel deviceptr (aa) ! { dg-error "ALLOCATABLE" }
+ !$acc end parallel
+
+ !$acc parallel deviceptr (i, c, r, ia, ca, ra, ti)
+ !$acc end parallel
+ !$acc kernels deviceptr (i, c, r, ia, ca, ra, ti)
+ !$acc end kernels
+ !$acc data deviceptr (i, c, r, ia, ca, ra, ti)
+ !$acc end data
+
+
+ !$acc parallel copy (tip) ! { dg-error "POINTER" }
+ !$acc end parallel
+ !$acc parallel copy (tia) ! { dg-error "ALLOCATABLE" }
+ !$acc end parallel
+ !$acc parallel deviceptr (i) copy (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+
+ !$acc parallel copy (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end parallel
+ !$acc kernels copy (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end kernels
+ !$acc data copy (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end data
+
+
+ !$acc parallel copyin (tip) ! { dg-error "POINTER" }
+ !$acc end parallel
+ !$acc parallel copyin (tia) ! { dg-error "ALLOCATABLE" }
+ !$acc end parallel
+ !$acc parallel deviceptr (i) copyin (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel copy (i) copyin (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+
+ !$acc parallel copyin (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end parallel
+ !$acc kernels copyin (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end kernels
+ !$acc data copyin (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end data
+
+
+ !$acc parallel copyout (tip) ! { dg-error "POINTER" }
+ !$acc end parallel
+ !$acc parallel copyout (tia) ! { dg-error "ALLOCATABLE" }
+ !$acc end parallel
+ !$acc parallel deviceptr (i) copyout (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel copy (i) copyout (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel copyin (i) copyout (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+
+ !$acc parallel copyout (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end parallel
+ !$acc kernels copyout (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end kernels
+ !$acc data copyout (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end data
+
+
+ !$acc parallel create (tip) ! { dg-error "POINTER" }
+ !$acc end parallel
+ !$acc parallel create (tia) ! { dg-error "ALLOCATABLE" }
+ !$acc end parallel
+ !$acc parallel deviceptr (i) create (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel copy (i) create (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel copyin (i) create (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel copyout (i) create (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+
+ !$acc parallel create (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end parallel
+ !$acc kernels create (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end kernels
+ !$acc data create (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end data
+
+
+ !$acc parallel present (tip) ! { dg-error "POINTER" }
+ !$acc end parallel
+ !$acc parallel present (tia) ! { dg-error "ALLOCATABLE" }
+ !$acc end parallel
+ !$acc parallel deviceptr (i) present (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel copy (i) present (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel copyin (i) present (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel copyout (i) present (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel create (i) present (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+
+ !$acc parallel present (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end parallel
+ !$acc kernels present (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end kernels
+ !$acc data present (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end data
+
+
+ !$acc parallel pcopy (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end parallel
+ !$acc parallel pcopyin (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end parallel
+ !$acc parallel pcopyout (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end parallel
+ !$acc parallel pcreate (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end parallel
+
+
+ !$acc parallel present_or_copy (tip) ! { dg-error "POINTER" }
+ !$acc end parallel
+ !$acc parallel present_or_copy (tia) ! { dg-error "ALLOCATABLE" }
+ !$acc end parallel
+ !$acc parallel deviceptr (i) present_or_copy (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel copy (i) present_or_copy (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel copyin (i) present_or_copy (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel copyout (i) present_or_copy (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel create (i) present_or_copy (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel present (i) present_or_copy (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+
+ !$acc parallel present_or_copy (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end parallel
+ !$acc kernels present_or_copy (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end kernels
+ !$acc data present_or_copy (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end data
+
+
+ !$acc parallel present_or_copyin (tip) ! { dg-error "POINTER" }
+ !$acc end parallel
+ !$acc parallel present_or_copyin (tia) ! { dg-error "ALLOCATABLE" }
+ !$acc end parallel
+ !$acc parallel deviceptr (i) present_or_copyin (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel copy (i) present_or_copyin (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel copyin (i) present_or_copyin (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel copyout (i) present_or_copyin (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel create (i) present_or_copyin (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel present (i) present_or_copyin (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel present_or_copy (i) present_or_copyin (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+
+ !$acc parallel present_or_copyin (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end parallel
+ !$acc kernels present_or_copyin (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end kernels
+ !$acc data present_or_copyin (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end data
+
+
+ !$acc parallel present_or_copyout (tip) ! { dg-error "POINTER" }
+ !$acc end parallel
+ !$acc parallel present_or_copyout (tia) ! { dg-error "ALLOCATABLE" }
+ !$acc end parallel
+ !$acc parallel deviceptr (i) present_or_copyout (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel copy (i) present_or_copyout (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel copyin (i) present_or_copyout (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel copyout (i) present_or_copyout (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel create (i) present_or_copyout (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel present (i) present_or_copyout (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel present_or_copy (i) present_or_copyout (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel present_or_copyin (i) present_or_copyout (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+
+ !$acc parallel present_or_copyout (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end parallel
+ !$acc kernels present_or_copyout (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end kernels
+ !$acc data present_or_copyout (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end data
+
+
+ !$acc parallel present_or_create (tip) ! { dg-error "POINTER" }
+ !$acc end parallel
+ !$acc parallel present_or_create (tia) ! { dg-error "ALLOCATABLE" }
+ !$acc end parallel
+ !$acc parallel deviceptr (i) present_or_create (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel copy (i) present_or_create (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel copyin (i) present_or_create (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel copyout (i) present_or_create (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel create (i) present_or_create (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel present (i) present_or_create (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel present_or_copy (i) present_or_create (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel present_or_copyin (i) present_or_create (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel present_or_copyout (i) present_or_create (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+
+ !$acc parallel present_or_create (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end parallel
+ !$acc kernels present_or_create (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end kernels
+ !$acc data present_or_create (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end data
+
+ end subroutine foo
+
+end module test
\ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/goacc/data-tree.f95 b/gcc/testsuite/gfortran.dg/goacc/data-tree.f95
new file mode 100644
index 0000000..d29c060
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/data-tree.f95
@@ -0,0 +1,31 @@
+! { dg-do compile }
+! { dg-additional-options "-fdump-tree-original" }
+
+program test
+ implicit none
+ integer :: q, i, j, k, m, n, o, p, r, s, t, u, v, w
+ logical :: l
+
+ !$acc data if(l) copy(i), copyin(j), copyout(k), create(m) &
+ !$acc present(o), pcopy(p), pcopyin(r), pcopyout(s), pcreate(t) &
+ !$acc deviceptr(u)
+ !$acc end data
+
+end program test
+! { dg-excess-errors "unimplemented" }
+! { dg-final { scan-tree-dump-times "pragma acc data" 1 "original" } }
+
+! { dg-final { scan-tree-dump-times "if" 1 "original" } }
+! { dg-final { scan-tree-dump-times "map\\(force_tofrom:i\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "map\\(force_to:j\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "map\\(force_from:k\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "map\\(force_alloc:m\\)" 1 "original" } }
+
+! { dg-final { scan-tree-dump-times "map\\(force_present:o\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "map\\(tofrom:p\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "map\\(to:r\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "map\\(from:s\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "map\\(alloc:t\\)" 1 "original" } }
+
+! { dg-final { scan-tree-dump-times "map\\(force_deviceptr:u\\)" 1 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
\ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/goacc/declare-1.f95 b/gcc/testsuite/gfortran.dg/goacc/declare-1.f95
new file mode 100644
index 0000000..aec3ae8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/declare-1.f95
@@ -0,0 +1,20 @@
+! { dg-do compile }
+! { dg-additional-options "-fdump-tree-original" }
+
+program test
+ implicit none
+ integer :: i
+
+ !$acc declare copy(i)
+contains
+ real function foo(n)
+ integer, value :: n
+ BLOCK
+ integer i
+ !$acc declare copy(i)
+ END BLOCK
+ end function foo
+end program test
+! { dg-excess-errors "unimplemented" }
+! { dg-final { scan-tree-dump-times "pragma acc declare map\\(force_tofrom:i\\)" 2 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
diff --git a/gcc/testsuite/gfortran.dg/goacc/enter-exit-data.f95 b/gcc/testsuite/gfortran.dg/goacc/enter-exit-data.f95
new file mode 100644
index 0000000..8f1715e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/enter-exit-data.f95
@@ -0,0 +1,88 @@
+! { dg-do compile }
+! { dg-additional-options "-fmax-errors=100" }
+
+module test
+ implicit none
+contains
+
+ subroutine foo (vi)
+ logical :: l
+ integer, value :: vi
+ integer :: i, ia(10), a(10), b(2:8)
+ complex :: c, ca(10)
+ real, target:: r
+ real :: ra(10)
+ real, pointer :: rp
+ real, dimension(:), allocatable :: aa
+ type t
+ integer :: i
+ end type
+ type(t) :: ti
+ type(t), allocatable :: tia
+ type(t), target :: tit
+ type(t), pointer :: tip
+ rp => r
+ tip => tit
+
+ ! enter data
+ !$acc enter data
+ !$acc enter data if (.false.)
+ !$acc enter data if (l)
+ !$acc enter data if (.false.) if (l) ! { dg-error "Unclassifiable" }
+ !$acc enter data if (i) ! { dg-error "LOGICAL" }
+ !$acc enter data if (1) ! { dg-error "LOGICAL" }
+ !$acc enter data if (a) ! { dg-error "LOGICAL" }
+ !$acc enter data if (b(5:6)) ! { dg-error "LOGICAL" }
+ !$acc enter data async (l) ! { dg-error "INTEGER" }
+ !$acc enter data async (.true.) ! { dg-error "INTEGER" }
+ !$acc enter data async (1)
+ !$acc enter data async (i)
+ !$acc enter data async (a) ! { dg-error "INTEGER" }
+ !$acc enter data async (b(5:6)) ! { dg-error "INTEGER" }
+ !$acc enter data wait (l) ! { dg-error "INTEGER" }
+ !$acc enter data wait (.true.) ! { dg-error "INTEGER" }
+ !$acc enter data wait (i, 1)
+ !$acc enter data wait (a) ! { dg-error "INTEGER" }
+ !$acc enter data wait (b(5:6)) ! { dg-error "INTEGER" }
+ !$acc enter data copyin (tip) ! { dg-error "POINTER" }
+ !$acc enter data copyin (tia) ! { dg-error "ALLOCATABLE" }
+ !$acc enter data create (tip) ! { dg-error "POINTER" }
+ !$acc enter data create (tia) ! { dg-error "ALLOCATABLE" }
+ !$acc enter data present_or_copyin (tip) ! { dg-error "POINTER" }
+ !$acc enter data present_or_copyin (tia) ! { dg-error "ALLOCATABLE" }
+ !$acc enter data present_or_create (tip) ! { dg-error "POINTER" }
+ !$acc enter data present_or_create (tia) ! { dg-error "ALLOCATABLE" }
+ !$acc enter data copyin (i) create (i) ! { dg-error "multiple clauses" }
+ !$acc enter data copyin (i) present_or_copyin (i) ! { dg-error "multiple clauses" }
+ !$acc enter data create (i) present_or_copyin (i) ! { dg-error "multiple clauses" }
+ !$acc enter data copyin (i) present_or_create (i) ! { dg-error "multiple clauses" }
+ !$acc enter data create (i) present_or_create (i) ! { dg-error "multiple clauses" }
+ !$acc enter data present_or_copyin (i) present_or_create (i) ! { dg-error "multiple clauses" }
+
+ ! exit data
+ !$acc exit data
+ !$acc exit data if (.false.)
+ !$acc exit data if (l)
+ !$acc exit data if (.false.) if (l) ! { dg-error "Unclassifiable" }
+ !$acc exit data if (i) ! { dg-error "LOGICAL" }
+ !$acc exit data if (1) ! { dg-error "LOGICAL" }
+ !$acc exit data if (a) ! { dg-error "LOGICAL" }
+ !$acc exit data if (b(5:6)) ! { dg-error "LOGICAL" }
+ !$acc exit data async (l) ! { dg-error "INTEGER" }
+ !$acc exit data async (.true.) ! { dg-error "INTEGER" }
+ !$acc exit data async (1)
+ !$acc exit data async (i)
+ !$acc exit data async (a) ! { dg-error "INTEGER" }
+ !$acc exit data async (b(5:6)) ! { dg-error "INTEGER" }
+ !$acc exit data wait (l) ! { dg-error "INTEGER" }
+ !$acc exit data wait (.true.) ! { dg-error "INTEGER" }
+ !$acc exit data wait (i, 1)
+ !$acc exit data wait (a) ! { dg-error "INTEGER" }
+ !$acc exit data wait (b(5:6)) ! { dg-error "INTEGER" }
+ !$acc exit data copyout (tip) ! { dg-error "POINTER" }
+ !$acc exit data copyout (tia) ! { dg-error "ALLOCATABLE" }
+ !$acc exit data delete (tip) ! { dg-error "POINTER" }
+ !$acc exit data delete (tia) ! { dg-error "ALLOCATABLE" }
+ !$acc exit data copyout (i) delete (i) ! { dg-error "multiple clauses" }
+ end subroutine foo
+end module test
diff --git a/gcc/testsuite/gfortran.dg/goacc/goacc.exp b/gcc/testsuite/gfortran.dg/goacc/goacc.exp
new file mode 100644
index 0000000..96530d2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/goacc.exp
@@ -0,0 +1,36 @@
+# Copyright (C) 2005-2013 Free Software Foundation, Inc.
+#
+# This file is part of GCC.
+#
+# GCC is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3, or (at your option)
+# any later version.
+#
+# GCC is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with GCC; see the file COPYING3. If not see
+# <http://www.gnu.org/licenses/>.
+
+# GCC testsuite that uses the `dg.exp' driver.
+
+# Load support procs.
+load_lib gfortran-dg.exp
+
+if ![check_effective_target_fopenacc] {
+ return
+}
+
+# Initialize `dg'.
+dg-init
+
+# Main loop.
+gfortran-dg-runtest [lsort \
+ [find $srcdir/$subdir *.\[fF\]{,90,95,03,08} ] ] " -fopenacc"
+
+# All done.
+dg-finish
diff --git a/gcc/testsuite/gfortran.dg/goacc/host_data-tree.f95 b/gcc/testsuite/gfortran.dg/goacc/host_data-tree.f95
new file mode 100644
index 0000000..1c24fe7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/host_data-tree.f95
@@ -0,0 +1,13 @@
+! { dg-do compile }
+! { dg-additional-options "-fdump-tree-original" }
+
+program test
+ implicit none
+ integer :: i
+
+ !$acc host_data use_device(i)
+ !$acc end host_data
+end program test
+! { dg-excess-errors "unimplemented" }
+! { dg-final { scan-tree-dump-times "pragma acc host_data use_device\\(i\\)" 1 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
diff --git a/gcc/testsuite/gfortran.dg/goacc/if.f95 b/gcc/testsuite/gfortran.dg/goacc/if.f95
new file mode 100644
index 0000000..a45035d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/if.f95
@@ -0,0 +1,52 @@
+! { dg-do compile }
+
+program test
+ implicit none
+
+ logical :: x
+ integer :: i
+
+ !$acc parallel if ! { dg-error "Unclassifiable OpenACC directive" }
+ !$acc parallel if () ! { dg-error "Invalid character" }
+ !$acc parallel if (i) ! { dg-error "scalar LOGICAL expression" }
+ !$acc end parallel
+ !$acc parallel if (1) ! { dg-error "scalar LOGICAL expression" }
+ !$acc end parallel
+ !$acc kernels if (i) ! { dg-error "scalar LOGICAL expression" }
+ !$acc end kernels
+ !$acc kernels if ! { dg-error "Unclassifiable OpenACC directive" }
+ !$acc kernels if () ! { dg-error "Invalid character" }
+ !$acc kernels if (1) ! { dg-error "scalar LOGICAL expression" }
+ !$acc end kernels
+ !$acc data if ! { dg-error "Unclassifiable OpenACC directive" }
+ !$acc data if () ! { dg-error "Invalid character" }
+ !$acc data if (i) ! { dg-error "scalar LOGICAL expression" }
+ !$acc end data
+ !$acc data if (1) ! { dg-error "scalar LOGICAL expression" }
+ !$acc end data
+
+ ! at most one if clause may appear
+ !$acc parallel if (.false.) if (.false.) { dg-error "Unclassifiable OpenACC directive" }
+ !$acc kernels if (.false.) if (.false.) { dg-error "Unclassifiable OpenACC directive" }
+ !$acc data if (.false.) if (.false.) { dg-error "Unclassifiable OpenACC directive" }
+
+ !$acc parallel if (x)
+ !$acc end parallel
+ !$acc parallel if (.true.)
+ !$acc end parallel
+ !$acc parallel if (i.gt.1)
+ !$acc end parallel
+ !$acc kernels if (x)
+ !$acc end kernels
+ !$acc kernels if (.true.)
+ !$acc end kernels
+ !$acc kernels if (i.gt.1)
+ !$acc end kernels
+ !$acc data if (x)
+ !$acc end data
+ !$acc data if (.true.)
+ !$acc end data
+ !$acc data if (i.gt.1)
+ !$acc end data
+
+end program test
\ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/goacc/kernels-tree.f95 b/gcc/testsuite/gfortran.dg/goacc/kernels-tree.f95
new file mode 100644
index 0000000..5c65d2a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/kernels-tree.f95
@@ -0,0 +1,33 @@
+! { dg-do compile }
+! { dg-additional-options "-fdump-tree-original" }
+
+program test
+ implicit none
+ integer :: q, i, j, k, m, n, o, p, r, s, t, u, v, w
+ logical :: l
+
+ !$acc kernels if(l) async copy(i), copyin(j), copyout(k), create(m) &
+ !$acc present(o), pcopy(p), pcopyin(r), pcopyout(s), pcreate(t) &
+ !$acc deviceptr(u)
+ !$acc end kernels
+
+end program test
+! { dg-excess-errors "unimplemented" }
+! { dg-final { scan-tree-dump-times "pragma acc kernels" 1 "original" } }
+
+! { dg-final { scan-tree-dump-times "if" 1 "original" } }
+! { dg-final { scan-tree-dump-times "async" 1 "original" } }
+
+! { dg-final { scan-tree-dump-times "map\\(force_tofrom:i\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "map\\(force_to:j\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "map\\(force_from:k\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "map\\(force_alloc:m\\)" 1 "original" } }
+
+! { dg-final { scan-tree-dump-times "map\\(force_present:o\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "map\\(tofrom:p\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "map\\(to:r\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "map\\(from:s\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "map\\(alloc:t\\)" 1 "original" } }
+
+! { dg-final { scan-tree-dump-times "map\\(force_deviceptr:u\\)" 1 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
diff --git a/gcc/testsuite/gfortran.dg/goacc/list.f95 b/gcc/testsuite/gfortran.dg/goacc/list.f95
new file mode 100644
index 0000000..94fdadd
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/list.f95
@@ -0,0 +1,111 @@
+! { dg-do compile }
+! { dg-additional-options "-fmax-errors=100" }
+
+program test
+ implicit none
+
+ integer :: i, j, k, l, a(10)
+ common /b/ j, k
+ real, pointer :: p1 => NULL()
+ complex :: c, d(10)
+
+ !$acc parallel private(i)
+ !$acc end parallel
+
+ !$acc parallel private(a)
+ !$acc end parallel
+
+ !$acc parallel private(c, d)
+ !$acc end parallel
+
+ !$acc parallel private(i, j, k, l, a)
+ !$acc end parallel
+
+ !$acc parallel private (i) private (j)
+ !$acc end parallel
+
+ !$acc parallel private ! { dg-error "Unclassifiable OpenACC directive" }
+
+ !$acc parallel private() ! { dg-error "Syntax error" }
+
+ !$acc parallel private(a(1:3)) ! { dg-error "Syntax error" }
+
+ !$acc parallel private(10) ! { dg-error "Syntax error" }
+
+ !$acc parallel private(/b/, /b/) ! { dg-error "present on multiple clauses" }
+ !$acc end parallel
+
+ !$acc parallel private(i, j, i) ! { dg-error "present on multiple clauses" }
+ !$acc end parallel
+
+ !$acc parallel private(p1)
+ !$acc end parallel
+
+ !$acc parallel firstprivate(i)
+ !$acc end parallel
+
+ !$acc parallel firstprivate(c, d)
+ !$acc end parallel
+
+ !$acc parallel firstprivate(a)
+ !$acc end parallel
+
+ !$acc parallel firstprivate(i, j, k, l, a)
+ !$acc end parallel
+
+ !$acc parallel firstprivate (i) firstprivate (j)
+ !$acc end parallel
+
+ !$acc parallel firstprivate ! { dg-error "Unclassifiable OpenACC directive" }
+
+ !$acc parallel firstprivate() ! { dg-error "Syntax error" }
+
+ !$acc parallel firstprivate(a(1:3)) ! { dg-error "Syntax error" }
+
+ !$acc parallel firstprivate(10) ! { dg-error "Syntax error" }
+
+ !$acc parallel firstprivate (/b/, /b/) ! { dg-error "present on multiple clauses" }
+ !$acc end parallel
+
+ !$acc parallel firstprivate (i, j, i) ! { dg-error "present on multiple clauses" }
+ !$acc end parallel
+
+ !$acc parallel firstprivate(p1)
+ !$acc end parallel
+
+ !$acc parallel private (i) firstprivate (i) ! { dg-error "present on multiple clauses" }
+ !$acc end parallel
+
+ !$acc host_data use_device(i)
+ !$acc end host_data
+
+ !$acc host_data use_device(c, d)
+ !$acc end host_data
+
+ !$acc host_data use_device(a)
+ !$acc end host_data
+
+ !$acc host_data use_device(i, j, k, l, a)
+ !$acc end host_data
+
+ !$acc host_data use_device (i) use_device (j)
+ !$acc end host_data
+
+ !$acc host_data use_device ! { dg-error "Unclassifiable OpenACC directive" }
+
+ !$acc host_data use_device() ! { dg-error "Syntax error" }
+
+ !$acc host_data use_device(a(1:3)) ! { dg-error "Syntax error" }
+
+ !$acc host_data use_device(10) ! { dg-error "Syntax error" }
+
+ !$acc host_data use_device(/b/, /b/) ! { dg-error "present on multiple clauses" }
+ !$acc end host_data
+
+ !$acc host_data use_device(i, j, i) ! { dg-error "present on multiple clauses" }
+ !$acc end host_data
+
+ !$acc host_data use_device(p1) ! { dg-error "POINTER" }
+ !$acc end host_data
+
+end program test
\ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/goacc/literal.f95 b/gcc/testsuite/gfortran.dg/goacc/literal.f95
new file mode 100644
index 0000000..bdbf66d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/literal.f95
@@ -0,0 +1,29 @@
+! { dg-do compile }
+
+module test
+contains
+ subroutine oacc1
+ implicit none
+ integer :: i
+ !$acc declare device_resident (10) ! { dg-error "Syntax error" }
+ !$acc data copy (10) ! { dg-error "Syntax error" }
+ !$acc end data ! { dg-error "Unexpected" }
+ !$acc data deviceptr (10) ! { dg-error "Syntax error" }
+ !$acc end data ! { dg-error "Unexpected" }
+ !$acc data private (10) ! { dg-error "Unclassifiable" }
+ !$acc end data ! { dg-error "Unexpected" }
+ !$acc host_data use_device (10) ! { dg-error "Syntax error" }
+ !$acc end host_data ! { dg-error "Unexpected" }
+ !$acc parallel loop reduction(+:10) ! { dg-error "Syntax error" }
+ do i = 1,5
+ enddo
+ !$acc end parallel loop ! { dg-error "Unexpected" }
+ !$acc parallel loop
+ do i = 1,5
+ !$acc cache (10) ! { dg-error "Syntax error" }
+ enddo
+ !$acc end parallel loop
+ !$acc update host (10) ! { dg-error "Syntax error" }
+ !$acc update device (10) ! { dg-error "Syntax error" }
+ end subroutine oacc1
+end module test
\ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/goacc/loop-1.f95 b/gcc/testsuite/gfortran.dg/goacc/loop-1.f95
new file mode 100644
index 0000000..af4f537
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/loop-1.f95
@@ -0,0 +1,170 @@
+! { dg-do compile }
+! { dg-additional-options "-fmax-errors=100" }
+module test
+ implicit none
+contains
+
+subroutine test1
+ integer :: i, j, k, b(10)
+ integer, dimension (30) :: a
+ double precision :: d
+ real :: r
+ i = 0
+ !$acc loop
+ do 100 ! { dg-error "cannot be a DO WHILE or DO without loop control" }
+ if (i .gt. 0) exit ! { dg-error "EXIT statement" }
+ 100 i = i + 1
+ i = 0
+ !$acc loop
+ do ! { dg-error "cannot be a DO WHILE or DO without loop control" }
+ if (i .gt. 0) exit ! { dg-error "EXIT statement" }
+ i = i + 1
+ end do
+ i = 0
+ !$acc loop
+ do 200 while (i .lt. 4) ! { dg-error "cannot be a DO WHILE or DO without loop control" }
+ 200 i = i + 1
+ !$acc loop
+ do while (i .lt. 8) ! { dg-error "cannot be a DO WHILE or DO without loop control" }
+ i = i + 1
+ end do
+ !$acc loop
+ do 300 d = 1, 30, 6 ! { dg-error "integer" }
+ i = d
+ 300 a(i) = 1
+ !$acc loop
+ do d = 1, 30, 5 ! { dg-error "integer" }
+ i = d
+ a(i) = 2
+ end do
+ !$acc loop
+ do i = 1, 30
+ if (i .eq. 16) exit ! { dg-error "EXIT statement" }
+ end do
+ !$acc loop
+ outer: do i = 1, 30
+ do j = 5, 10
+ if (i .eq. 6 .and. j .eq. 7) exit outer ! { dg-error "EXIT statement" }
+ end do
+ end do outer
+ last: do i = 1, 30
+ end do last
+
+ ! different types of loop are allowed
+ !$acc loop
+ do i = 1,10
+ end do
+ !$acc loop
+ do 400, i = 1,10
+400 a(i) = i
+
+ ! after loop directive must be loop
+ !$acc loop
+ a(1) = 1 ! { dg-error "Expected DO loop" }
+ do i = 1,10
+ enddo
+
+ ! combined directives may be used with/without end
+ !$acc parallel loop
+ do i = 1,10
+ enddo
+ !$acc parallel loop
+ do i = 1,10
+ enddo
+ !$acc end parallel loop
+ !$acc kernels loop
+ do i = 1,10
+ enddo
+ !$acc kernels loop
+ do i = 1,10
+ enddo
+ !$acc end kernels loop
+
+ !$acc kernels loop reduction(max:i)
+ do i = 1,10
+ enddo
+ !$acc kernels
+ !$acc loop reduction(max:i)
+ do i = 1,10
+ enddo
+ !$acc end kernels
+
+ !$acc parallel loop collapse(0) ! { dg-error "constant positive integer" }
+ do i = 1,10
+ enddo
+
+ !$acc parallel loop collapse(-1) ! { dg-error "constant positive integer" }
+ do i = 1,10
+ enddo
+
+ !$acc parallel loop collapse(i) ! { dg-error "Constant expression required" }
+ do i = 1,10
+ enddo
+
+ !$acc parallel loop collapse(4) ! { dg-error "not enough DO loops for collapsed" }
+ do i = 1, 3
+ do j = 4, 6
+ do k = 5, 7
+ a(i+j-k) = i + j + k
+ end do
+ end do
+ end do
+ !$acc parallel loop collapse(2)
+ do i = 1, 5, 2
+ do j = i + 1, 7, i ! { dg-error "collapsed loops don.t form rectangular iteration space" }
+ end do
+ end do
+ !$acc parallel loop collapse(2)
+ do i = 1, 3
+ do j = 4, 6
+ end do
+ end do
+ !$acc parallel loop collapse(2)
+ do i = 1, 3
+ do j = 4, 6
+ end do
+ k = 4
+ end do
+ !$acc parallel loop collapse(3-1)
+ do i = 1, 3
+ do j = 4, 6
+ end do
+ k = 4
+ end do
+ !$acc parallel loop collapse(1+1)
+ do i = 1, 3
+ do j = 4, 6
+ end do
+ k = 4
+ end do
+ !$acc parallel loop collapse(2)
+ do i = 1, 3
+ do ! { dg-error "cannot be a DO WHILE or DO without loop control" }
+ end do
+ end do
+ !$acc parallel loop collapse(2)
+ do i = 1, 3
+ do r = 4, 6 ! { dg-error "integer" }
+ end do
+ end do
+
+ ! Both seq and independent are not allowed
+ !$acc loop independent seq ! { dg-error "SEQ conflicts with INDEPENDENT" }
+ do i = 1,10
+ enddo
+
+
+ !$acc cache (a) ! { dg-error "inside of loop" }
+
+ do i = 1,10
+ !$acc cache(a)
+ enddo
+
+ do i = 1,10
+ a(i) = i
+ !$acc cache(a)
+ enddo
+
+end subroutine test1
+end module test
+! { dg-excess-errors "Deleted" }
diff --git a/gcc/testsuite/gfortran.dg/goacc/loop-2.f95 b/gcc/testsuite/gfortran.dg/goacc/loop-2.f95
new file mode 100644
index 0000000..f85691e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/loop-2.f95
@@ -0,0 +1,649 @@
+! { dg-do compile }
+! { dg-additional-options "-fmax-errors=100" }
+
+! TODO: nested kernels are allowed in 2.0
+
+program test
+ implicit none
+ integer :: i, j
+
+ !$acc kernels
+ !$acc loop auto
+ DO i = 1,10
+ ENDDO
+ !$acc loop gang
+ DO i = 1,10
+ ENDDO
+ !$acc loop gang(5)
+ DO i = 1,10
+ ENDDO
+ !$acc loop gang(num:5)
+ DO i = 1,10
+ ENDDO
+ !$acc loop gang(static:5)
+ DO i = 1,10
+ ENDDO
+ !$acc loop gang(static:*)
+ DO i = 1,10
+ ENDDO
+ !$acc loop gang
+ DO i = 1,10
+ !$acc loop vector
+ DO j = 1,10
+ ENDDO
+ !$acc loop worker
+ DO j = 1,10
+ ENDDO
+ !$acc loop gang ! { dg-error "not allowed" }
+ DO j = 1,10
+ ENDDO
+ ENDDO
+ !$acc loop seq gang ! { dg-error "conflicts with" }
+ 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:5)
+ DO i = 1,10
+ ENDDO
+ !$acc loop worker
+ DO i = 1,10
+ !$acc loop vector
+ DO j = 1,10
+ ENDDO
+ !$acc loop worker ! { dg-error "not allowed" }
+ DO j = 1,10
+ ENDDO
+ !$acc loop gang ! { dg-error "not allowed" }
+ DO j = 1,10
+ ENDDO
+ ENDDO
+ !$acc loop seq worker ! { dg-error "conflicts with" }
+ DO i = 1,10
+ ENDDO
+ !$acc loop gang worker ! { dg-error "conflicts with" }
+ DO i = 1,10
+ ENDDO
+
+ !$acc loop vector
+ DO i = 1,10
+ ENDDO
+ !$acc loop vector(5)
+ DO i = 1,10
+ ENDDO
+ !$acc loop vector(length:5)
+ DO i = 1,10
+ ENDDO
+ !$acc loop vector
+ DO i = 1,10
+ !$acc loop vector ! { dg-error "not allowed" }
+ DO j = 1,10
+ ENDDO
+ !$acc loop worker ! { dg-error "not allowed" }
+ DO j = 1,10
+ ENDDO
+ !$acc loop gang ! { dg-error "not allowed" }
+ DO j = 1,10
+ ENDDO
+ ENDDO
+ !$acc loop seq vector ! { dg-error "conflicts with" }
+ DO i = 1,10
+ ENDDO
+ !$acc loop gang vector ! { dg-error "conflicts with" }
+ DO i = 1,10
+ ENDDO
+ !$acc loop worker vector ! { dg-error "conflicts with" }
+ DO i = 1,10
+ ENDDO
+
+ !$acc loop auto
+ DO i = 1,10
+ ENDDO
+ !$acc loop seq auto ! { dg-error "conflicts with" }
+ DO i = 1,10
+ ENDDO
+ !$acc loop gang auto ! { dg-error "conflicts with" }
+ DO i = 1,10
+ ENDDO
+ !$acc loop worker auto ! { dg-error "conflicts with" }
+ DO i = 1,10
+ ENDDO
+ !$acc loop vector auto ! { dg-error "conflicts with" }
+ DO i = 1,10
+ ENDDO
+
+ !$acc loop tile ! { dg-error "Unclassifiable" }
+ DO i = 1,10
+ ENDDO
+ !$acc loop tile() ! { dg-error "Syntax error" }
+ DO i = 1,10
+ ENDDO
+ !$acc loop tile(1)
+ DO i = 1,10
+ ENDDO
+ !$acc loop tile(2)
+ DO i = 1,10
+ ENDDO
+ !$acc loop tile(6-2)
+ DO i = 1,10
+ ENDDO
+ !$acc loop tile(6+2)
+ DO i = 1,10
+ ENDDO
+ !$acc loop tile(*)
+ DO i = 1,10
+ ENDDO
+ !$acc loop tile(*, 1)
+ DO i = 1,10
+ DO j = 1,10
+ ENDDO
+ ENDDO
+ !$acc loop tile(-1) ! { dg-warning "must be positive" }
+ do i = 1,10
+ enddo
+ !$acc loop tile(i) ! { dg-error "constant expression" }
+ do i = 1,10
+ enddo
+ !$acc loop tile(2, 2, 1) ! { dg-error "not enough DO loops for tiled" }
+ do i = 1, 3
+ do j = 4, 6
+ end do
+ end do
+ !$acc loop tile(2, 2)
+ do i = 1, 5, 2
+ do j = i + 1, 7, i ! { dg-error "tiled loops don.t form rectangular iteration space" }
+ end do
+ end do
+ !$acc loop vector tile(*)
+ DO i = 1,10
+ ENDDO
+ !$acc loop worker tile(*)
+ DO i = 1,10
+ ENDDO
+ !$acc loop gang tile(*)
+ DO i = 1,10
+ ENDDO
+ !$acc loop vector gang tile(*)
+ DO i = 1,10
+ ENDDO
+ !$acc loop vector worker tile(*)
+ DO i = 1,10
+ ENDDO
+ !$acc loop gang worker tile(*)
+ DO i = 1,10
+ ENDDO
+ !$acc end kernels
+
+
+ !$acc parallel
+ !$acc loop auto
+ DO i = 1,10
+ ENDDO
+ !$acc loop gang
+ DO i = 1,10
+ ENDDO
+ !$acc loop gang(5) ! { dg-error "non-static" }
+ DO i = 1,10
+ ENDDO
+ !$acc loop gang(num:5) ! { dg-error "non-static" }
+ DO i = 1,10
+ ENDDO
+ !$acc loop gang(static:5)
+ DO i = 1,10
+ ENDDO
+ !$acc loop gang(static:*)
+ DO i = 1,10
+ ENDDO
+ !$acc loop gang
+ DO i = 1,10
+ !$acc loop vector
+ DO j = 1,10
+ ENDDO
+ !$acc loop worker
+ DO j = 1,10
+ ENDDO
+ !$acc loop gang ! { dg-error "not allowed" }
+ DO j = 1,10
+ ENDDO
+ ENDDO
+ !$acc loop seq gang ! { dg-error "conflicts with" }
+ DO i = 1,10
+ ENDDO
+
+ !$acc loop worker
+ DO i = 1,10
+ ENDDO
+ !$acc loop worker(5) ! { dg-error "non-static" }
+ DO i = 1,10
+ ENDDO
+ !$acc loop worker(num:5) ! { dg-error "non-static" }
+ DO i = 1,10
+ ENDDO
+ !$acc loop worker
+ DO i = 1,10
+ !$acc loop vector
+ DO j = 1,10
+ ENDDO
+ !$acc loop worker ! { dg-error "not allowed" }
+ DO j = 1,10
+ ENDDO
+ !$acc loop gang ! { dg-error "not allowed" }
+ DO j = 1,10
+ ENDDO
+ ENDDO
+ !$acc loop seq worker ! { dg-error "conflicts with" }
+ DO i = 1,10
+ ENDDO
+ !$acc loop gang worker ! { dg-error "conflicts with" }
+ DO i = 1,10
+ ENDDO
+
+ !$acc loop vector
+ DO i = 1,10
+ ENDDO
+ !$acc loop vector(5)
+ DO i = 1,10
+ ENDDO
+ !$acc loop vector(length:5)
+ DO i = 1,10
+ ENDDO
+ !$acc loop vector
+ DO i = 1,10
+ !$acc loop vector ! { dg-error "not allowed" }
+ DO j = 1,10
+ ENDDO
+ !$acc loop worker ! { dg-error "not allowed" }
+ DO j = 1,10
+ ENDDO
+ !$acc loop gang ! { dg-error "not allowed" }
+ DO j = 1,10
+ ENDDO
+ ENDDO
+ !$acc loop seq vector ! { dg-error "conflicts with" }
+ DO i = 1,10
+ ENDDO
+ !$acc loop gang vector ! { dg-error "conflicts with" }
+ DO i = 1,10
+ ENDDO
+ !$acc loop worker vector ! { dg-error "conflicts with" }
+ DO i = 1,10
+ ENDDO
+
+ !$acc loop auto
+ DO i = 1,10
+ ENDDO
+ !$acc loop seq auto ! { dg-error "conflicts with" }
+ DO i = 1,10
+ ENDDO
+ !$acc loop gang auto ! { dg-error "conflicts with" }
+ DO i = 1,10
+ ENDDO
+ !$acc loop worker auto ! { dg-error "conflicts with" }
+ DO i = 1,10
+ ENDDO
+ !$acc loop vector auto ! { dg-error "conflicts with" }
+ DO i = 1,10
+ ENDDO
+
+ !$acc loop tile ! { dg-error "Unclassifiable" }
+ DO i = 1,10
+ ENDDO
+ !$acc loop tile() ! { dg-error "Syntax error" }
+ DO i = 1,10
+ ENDDO
+ !$acc loop tile(1)
+ DO i = 1,10
+ ENDDO
+ !$acc loop tile(*)
+ DO i = 1,10
+ ENDDO
+ !$acc loop tile(2)
+ DO i = 1,10
+ DO j = 1,10
+ ENDDO
+ ENDDO
+ !$acc loop tile(-1) ! { dg-warning "must be positive" }
+ do i = 1,10
+ enddo
+ !$acc loop tile(i) ! { dg-error "constant expression" }
+ do i = 1,10
+ enddo
+ !$acc loop tile(2, 2, 1) ! { dg-error "not enough DO loops for tiled" }
+ do i = 1, 3
+ do j = 4, 6
+ end do
+ end do
+ !$acc loop tile(2, 2)
+ do i = 1, 5, 2
+ do j = i + 1, 7, i ! { dg-error "tiled loops don.t form rectangular iteration space" }
+ end do
+ end do
+ !$acc loop vector tile(*)
+ DO i = 1,10
+ ENDDO
+ !$acc loop worker tile(*)
+ DO i = 1,10
+ ENDDO
+ !$acc loop gang tile(*)
+ DO i = 1,10
+ ENDDO
+ !$acc loop vector gang tile(*)
+ DO i = 1,10
+ ENDDO
+ !$acc loop vector worker tile(*)
+ DO i = 1,10
+ ENDDO
+ !$acc loop gang worker tile(*)
+ DO i = 1,10
+ ENDDO
+ !$acc end parallel
+
+ !$acc kernels loop auto
+ DO i = 1,10
+ ENDDO
+ !$acc kernels loop gang
+ DO i = 1,10
+ ENDDO
+ !$acc kernels loop gang(5)
+ DO i = 1,10
+ ENDDO
+ !$acc kernels loop gang(num:5)
+ DO i = 1,10
+ ENDDO
+ !$acc kernels loop gang(static:5)
+ DO i = 1,10
+ ENDDO
+ !$acc kernels loop gang(static:*)
+ DO i = 1,10
+ ENDDO
+ !$acc kernels loop gang
+ DO i = 1,10
+ !$acc kernels loop gang
+ DO j = 1,10
+ ENDDO
+ ENDDO
+ !$acc kernels loop seq gang ! { dg-error "conflicts with" }
+ DO i = 1,10
+ ENDDO
+
+ !$acc kernels loop worker
+ DO i = 1,10
+ ENDDO
+ !$acc kernels loop worker(5)
+ DO i = 1,10
+ ENDDO
+ !$acc kernels loop worker(num:5)
+ DO i = 1,10
+ ENDDO
+ !$acc kernels loop worker
+ DO i = 1,10
+ !$acc kernels loop worker
+ DO j = 1,10
+ ENDDO
+ !$acc kernels loop gang
+ DO j = 1,10
+ ENDDO
+ ENDDO
+ !$acc kernels loop seq worker ! { dg-error "conflicts with" }
+ DO i = 1,10
+ ENDDO
+ !$acc kernels loop gang worker ! { dg-error "conflicts with" }
+ DO i = 1,10
+ ENDDO
+
+ !$acc kernels loop vector
+ DO i = 1,10
+ ENDDO
+ !$acc kernels loop vector(5)
+ DO i = 1,10
+ ENDDO
+ !$acc kernels loop vector(length:5)
+ DO i = 1,10
+ ENDDO
+ !$acc kernels loop vector
+ DO i = 1,10
+ !$acc kernels loop vector
+ DO j = 1,10
+ ENDDO
+ !$acc kernels loop worker
+ DO j = 1,10
+ ENDDO
+ !$acc kernels loop gang
+ DO j = 1,10
+ ENDDO
+ ENDDO
+ !$acc kernels loop seq vector ! { dg-error "conflicts with" }
+ DO i = 1,10
+ ENDDO
+ !$acc kernels loop gang vector ! { dg-error "conflicts with" }
+ DO i = 1,10
+ ENDDO
+ !$acc kernels loop worker vector ! { dg-error "conflicts with" }
+ DO i = 1,10
+ ENDDO
+
+ !$acc kernels loop auto
+ DO i = 1,10
+ ENDDO
+ !$acc kernels loop seq auto ! { dg-error "conflicts with" }
+ DO i = 1,10
+ ENDDO
+ !$acc kernels loop gang auto ! { dg-error "conflicts with" }
+ DO i = 1,10
+ ENDDO
+ !$acc kernels loop worker auto ! { dg-error "conflicts with" }
+ DO i = 1,10
+ ENDDO
+ !$acc kernels loop vector auto ! { dg-error "conflicts with" }
+ DO i = 1,10
+ ENDDO
+
+ !$acc kernels loop tile ! { dg-error "Unclassifiable" }
+ DO i = 1,10
+ ENDDO
+ !$acc kernels loop tile() ! { dg-error "Syntax error" }
+ DO i = 1,10
+ ENDDO
+ !$acc kernels loop tile(1)
+ DO i = 1,10
+ ENDDO
+ !$acc kernels loop tile(*)
+ DO i = 1,10
+ ENDDO
+ !$acc kernels loop tile(*, 1)
+ DO i = 1,10
+ DO j = 1,10
+ ENDDO
+ ENDDO
+ !$acc kernels loop tile(-1) ! { dg-warning "must be positive" }
+ do i = 1,10
+ enddo
+ !$acc kernels loop tile(i) ! { dg-error "constant expression" }
+ do i = 1,10
+ enddo
+ !$acc kernels loop tile(2, 2, 1) ! { dg-error "not enough DO loops for tiled" }
+ do i = 1, 3
+ do j = 4, 6
+ end do
+ end do
+ !$acc kernels loop tile(2, 2)
+ do i = 1, 5, 2
+ do j = i + 1, 7, i ! { dg-error "tiled loops don.t form rectangular iteration space" }
+ end do
+ end do
+ !$acc kernels loop vector tile(*)
+ DO i = 1,10
+ ENDDO
+ !$acc kernels loop worker tile(*)
+ DO i = 1,10
+ ENDDO
+ !$acc kernels loop gang tile(*)
+ DO i = 1,10
+ ENDDO
+ !$acc kernels loop vector gang tile(*)
+ DO i = 1,10
+ ENDDO
+ !$acc kernels loop vector worker tile(*)
+ DO i = 1,10
+ ENDDO
+ !$acc kernels loop gang worker tile(*)
+ DO i = 1,10
+ ENDDO
+
+ !$acc parallel loop auto
+ DO i = 1,10
+ ENDDO
+ !$acc parallel loop gang
+ DO i = 1,10
+ ENDDO
+ !$acc parallel loop gang(5) ! { dg-error "non-static" }
+ DO i = 1,10
+ ENDDO
+ !$acc parallel loop gang(num:5) ! { dg-error "non-static" }
+ DO i = 1,10
+ ENDDO
+ !$acc parallel loop gang(static:5)
+ DO i = 1,10
+ ENDDO
+ !$acc parallel loop gang(static:*)
+ DO i = 1,10
+ ENDDO
+ !$acc parallel loop gang
+ DO i = 1,10
+ !$acc parallel loop gang
+ DO j = 1,10
+ ENDDO
+ ENDDO
+ !$acc parallel loop seq gang ! { dg-error "conflicts with" }
+ DO i = 1,10
+ ENDDO
+
+ !$acc parallel loop worker
+ DO i = 1,10
+ ENDDO
+ !$acc parallel loop worker(5) ! { dg-error "non-static" }
+ DO i = 1,10
+ ENDDO
+ !$acc parallel loop worker(num:5) ! { dg-error "non-static" }
+ DO i = 1,10
+ ENDDO
+ !$acc parallel loop worker
+ DO i = 1,10
+ !$acc parallel loop worker
+ DO j = 1,10
+ ENDDO
+ !$acc parallel loop gang
+ DO j = 1,10
+ ENDDO
+ ENDDO
+ !$acc parallel loop seq worker ! { dg-error "conflicts with" }
+ DO i = 1,10
+ ENDDO
+ !$acc parallel loop gang worker ! { dg-error "conflicts with" }
+ DO i = 1,10
+ ENDDO
+
+ !$acc parallel loop vector
+ DO i = 1,10
+ ENDDO
+ !$acc parallel loop vector(5)
+ DO i = 1,10
+ ENDDO
+ !$acc parallel loop vector(length:5)
+ DO i = 1,10
+ ENDDO
+ !$acc parallel loop vector
+ DO i = 1,10
+ !$acc parallel loop vector
+ DO j = 1,10
+ ENDDO
+ !$acc parallel loop worker
+ DO j = 1,10
+ ENDDO
+ !$acc parallel loop gang
+ DO j = 1,10
+ ENDDO
+ ENDDO
+ !$acc parallel loop seq vector ! { dg-error "conflicts with" }
+ DO i = 1,10
+ ENDDO
+ !$acc parallel loop gang vector ! { dg-error "conflicts with" }
+ DO i = 1,10
+ ENDDO
+ !$acc parallel loop worker vector ! { dg-error "conflicts with" }
+ DO i = 1,10
+ ENDDO
+
+ !$acc parallel loop auto
+ DO i = 1,10
+ ENDDO
+ !$acc parallel loop seq auto ! { dg-error "conflicts with" }
+ DO i = 1,10
+ ENDDO
+ !$acc parallel loop gang auto ! { dg-error "conflicts with" }
+ DO i = 1,10
+ ENDDO
+ !$acc parallel loop worker auto ! { dg-error "conflicts with" }
+ DO i = 1,10
+ ENDDO
+ !$acc parallel loop vector auto ! { dg-error "conflicts with" }
+ DO i = 1,10
+ ENDDO
+
+ !$acc parallel loop tile ! { dg-error "Unclassifiable" }
+ DO i = 1,10
+ ENDDO
+ !$acc parallel loop tile() ! { dg-error "Syntax error" }
+ DO i = 1,10
+ ENDDO
+ !$acc parallel loop tile(1)
+ DO i = 1,10
+ ENDDO
+ !$acc parallel loop tile(*)
+ DO i = 1,10
+ ENDDO
+ !$acc parallel loop tile(*, 1)
+ DO i = 1,10
+ DO j = 1,10
+ ENDDO
+ ENDDO
+ !$acc parallel loop tile(-1) ! { dg-warning "must be positive" }
+ do i = 1,10
+ enddo
+ !$acc parallel loop tile(i) ! { dg-error "constant expression" }
+ do i = 1,10
+ enddo
+ !$acc parallel loop tile(2, 2, 1) ! { dg-error "not enough DO loops for tiled" }
+ do i = 1, 3
+ do j = 4, 6
+ end do
+ end do
+ !$acc parallel loop tile(2, 2)
+ do i = 1, 5, 2
+ do j = i + 1, 7, i ! { dg-error "tiled loops don.t form rectangular iteration space" }
+ end do
+ end do
+ !$acc parallel loop vector tile(*)
+ DO i = 1,10
+ ENDDO
+ !$acc parallel loop worker tile(*)
+ DO i = 1,10
+ ENDDO
+ !$acc parallel loop gang tile(*)
+ DO i = 1,10
+ ENDDO
+ !$acc parallel loop vector gang tile(*)
+ DO i = 1,10
+ ENDDO
+ !$acc parallel loop vector worker tile(*)
+ DO i = 1,10
+ ENDDO
+ !$acc parallel loop gang worker tile(*)
+ DO i = 1,10
+ ENDDO
+end
\ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/goacc/loop-3.f95 b/gcc/testsuite/gfortran.dg/goacc/loop-3.f95
new file mode 100644
index 0000000..78bb72b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/loop-3.f95
@@ -0,0 +1,31 @@
+! { dg-do compile }
+
+subroutine test1
+ implicit none
+ integer :: i, j
+
+ ! !$acc end loop not required by spec
+ !$acc loop
+ do i = 1,5
+ enddo
+ !$acc end loop ! { dg-warning "Redundant" }
+
+ !$acc loop
+ do i = 1,5
+ enddo
+ j = 1
+ !$acc end loop ! { dg-error "Unexpected" }
+
+ !$acc parallel
+ !$acc loop
+ do i = 1,5
+ enddo
+ !$acc end parallel
+ !$acc end loop ! { dg-error "Unexpected" }
+
+ ! OpenACC supports Fortran 2008 do concurrent statement
+ !$acc loop
+ do concurrent (i = 1:5)
+ end do
+end subroutine test1
+
diff --git a/gcc/testsuite/gfortran.dg/goacc/omp.f95 b/gcc/testsuite/gfortran.dg/goacc/omp.f95
new file mode 100644
index 0000000..24f639f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/omp.f95
@@ -0,0 +1,66 @@
+! { dg-do compile }
+! { dg-additional-options "-fopenmp" }
+
+module test
+contains
+ subroutine ichi
+ implicit none
+ integer :: i
+ !$acc parallel
+ !$omp do ! { dg-error "cannot be specified" }
+ do i = 1,5
+ enddo
+ !$acc end parallel
+ end subroutine ichi
+
+ subroutine ni
+ implicit none
+ integer :: i
+ !$omp parallel
+ !$acc loop ! { dg-error "cannot be specified" }
+ do i = 1,5
+ enddo
+ !$omp end parallel
+ end subroutine ni
+
+ subroutine san
+ implicit none
+ integer :: i
+ !$omp do
+ !$acc loop ! { dg-error "Unexpected" }
+ do i = 1,5
+ enddo
+ end subroutine san
+
+ subroutine yon
+ implicit none
+ integer :: i
+ !$acc loop
+ !$omp do ! { dg-error "Expected DO loop" }
+ do i = 1,5
+ enddo
+ end subroutine yon
+
+ subroutine go
+ implicit none
+ integer :: i, j
+
+ !$omp parallel
+ do i = 1,5
+ !$acc kernels ! { dg-error "cannot be specified" }
+ do j = 1,5
+ enddo
+ !$acc end kernels
+ enddo
+ !$omp end parallel
+ end subroutine go
+
+ subroutine roku
+ implicit none
+
+ !$acc data
+ !$omp parallel ! { dg-error "cannot be specified" }
+ !$omp end parallel
+ !$acc end data
+ end subroutine roku
+end module test
\ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/goacc/parallel-kernels-clauses.f95 b/gcc/testsuite/gfortran.dg/goacc/parallel-kernels-clauses.f95
new file mode 100644
index 0000000..6084238
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/parallel-kernels-clauses.f95
@@ -0,0 +1,98 @@
+! { dg-do compile }
+
+! { dg-do compile }
+! { dg-additional-options "-fmax-errors=100" }
+
+! test clauses added in OpenACC ver 2.0
+
+program test
+ implicit none
+ integer :: i, a(10), b(5:7)
+ integer, parameter :: acc_async_noval = -1
+ integer, parameter :: acc_async_sync = -2
+ logical :: l
+
+ ! async
+ !$acc kernels async(i)
+ !$acc end kernels
+ !$acc parallel async(i)
+ !$acc end parallel
+
+ !$acc kernels async(0, 1) { dg-error "Unclassifiable" }
+ !$acc parallel async(0, 1) { dg-error "Unclassifiable" }
+
+ !$acc kernels async
+ !$acc end kernels
+ !$acc parallel async
+ !$acc end parallel
+
+ !$acc kernels async(acc_async_noval)
+ !$acc end kernels
+ !$acc parallel async(acc_async_noval)
+ !$acc end parallel
+
+ !$acc kernels async(acc_async_sync)
+ !$acc end kernels
+ !$acc parallel async(acc_async_sync)
+ !$acc end parallel
+
+ !$acc kernels async() { dg-error "Invalid character" }
+ !$acc parallel async() { dg-error "Invalid character" }
+
+ !$acc kernels async("a") { dg-error "Unclassifiable" }
+ !$acc parallel async("a") { dg-error "Unclassifiable" }
+
+ !$acc kernels async(.true.) { dg-error "Unclassifiable" }
+ !$acc parallel async(.true.) { dg-error "Unclassifiable" }
+
+ ! default(none)
+ !$acc kernels default(none)
+ !$acc end kernels
+ !$acc parallel default(none)
+ !$acc end parallel
+
+ !$acc kernels default (none)
+ !$acc end kernels
+ !$acc parallel default (none)
+ !$acc end parallel
+
+ !$acc kernels default ( none )
+ !$acc end kernels
+ !$acc parallel default ( none )
+ !$acc end parallel
+
+ !$acc kernels default { dg-error "Unclassifiable" }
+ !$acc parallel default { dg-error "Unclassifiable" }
+
+ !$acc kernels default() { dg-error "Unclassifiable" }
+ !$acc parallel default() { dg-error "Unclassifiable" }
+
+ !$acc kernels default(i) { dg-error "Unclassifiable" }
+ !$acc parallel default(i) { dg-error "Unclassifiable" }
+
+ !$acc kernels default(1) { dg-error "Unclassifiable" }
+ !$acc parallel default(1) { dg-error "Unclassifiable" }
+
+ ! Wait
+ !$acc kernels wait (l) ! { dg-error "INTEGER" }
+ !$acc end kernels
+ !$acc kernels wait (.true.) ! { dg-error "INTEGER" }
+ !$acc end kernels
+ !$acc kernels wait (i, 1)
+ !$acc end kernels
+ !$acc kernels wait (a) ! { dg-error "INTEGER" }
+ !$acc end kernels
+ !$acc kernels wait (b(5:6)) ! { dg-error "INTEGER" }
+ !$acc end kernels
+
+ !$acc parallel wait (l) ! { dg-error "INTEGER" }
+ !$acc end parallel
+ !$acc parallel wait (.true.) ! { dg-error "INTEGER" }
+ !$acc end parallel
+ !$acc parallel wait (i, 1)
+ !$acc end parallel
+ !$acc parallel wait (a) ! { dg-error "INTEGER" }
+ !$acc end parallel
+ !$acc parallel wait (b(5:6)) ! { dg-error "INTEGER" }
+ !$acc end parallel
+end
diff --git a/gcc/testsuite/gfortran.dg/goacc/parallel-kernels-regions.f95 b/gcc/testsuite/gfortran.dg/goacc/parallel-kernels-regions.f95
new file mode 100644
index 0000000..5cd4d6c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/parallel-kernels-regions.f95
@@ -0,0 +1,56 @@
+! { dg-do compile }
+
+! OpenACC 2.0 allows nested parallel/kernels regions
+! However, in middle-end there is check for nested parallel
+
+program test
+ implicit none
+
+ integer :: i
+
+ !$acc parallel
+ !$acc kernels
+ !$acc end kernels
+ !$acc end parallel
+
+ !$acc parallel
+ !$acc parallel ! { dg-error "may not be nested" }
+ !$acc end parallel
+ !$acc end parallel
+
+ !$acc parallel
+ !$acc parallel ! { dg-error "may not be nested" }
+ !$acc end parallel
+ !$acc kernels
+ !$acc end kernels
+ !$acc end parallel
+
+ !$acc kernels
+ !$acc kernels
+ !$acc end kernels
+ !$acc end kernels
+
+ !$acc kernels
+ !$acc parallel
+ !$acc end parallel
+ !$acc end kernels
+
+ !$acc kernels
+ !$acc parallel
+ !$acc end parallel
+ !$acc kernels
+ !$acc end kernels
+ !$acc end kernels
+
+ !$acc parallel
+ !$acc data ! { dg-error "may not be nested" }
+ !$acc end data
+ !$acc end parallel
+
+ !$acc kernels
+ !$acc data
+ !$acc end data
+ !$acc end kernels
+
+end program test
+! { dg-excess-errors "unimplemented" }
\ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/goacc/parallel-tree.f95 b/gcc/testsuite/gfortran.dg/goacc/parallel-tree.f95
new file mode 100644
index 0000000..a92de4e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/parallel-tree.f95
@@ -0,0 +1,42 @@
+! { dg-do compile }
+! { dg-additional-options "-fdump-tree-original" }
+
+! test for tree-dump-original and spaces-commas
+
+program test
+ implicit none
+ integer :: q, i, j, k, m, n, o, p, r, s, t, u, v, w
+ logical :: l
+
+ !$acc parallel if(l) async num_gangs(i) num_workers(i) vector_length(i) &
+ !$acc reduction(max:q), copy(i), copyin(j), copyout(k), create(m) &
+ !$acc present(o), pcopy(p), pcopyin(r), pcopyout(s), pcreate(t) &
+ !$acc deviceptr(u), private(v), firstprivate(w)
+ !$acc end parallel
+
+end program test
+! { dg-excess-errors "unimplemented" }
+! { dg-final { scan-tree-dump-times "pragma acc parallel" 1 "original" } }
+
+! { dg-final { scan-tree-dump-times "if" 1 "original" } }
+! { dg-final { scan-tree-dump-times "async" 1 "original" } }
+! { dg-final { scan-tree-dump-times "num_gangs" 1 "original" } }
+! { dg-final { scan-tree-dump-times "num_workers" 1 "original" } }
+! { dg-final { scan-tree-dump-times "vector_length" 1 "original" } }
+
+! { dg-final { scan-tree-dump-times "reduction\\(max:q\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "map\\(force_tofrom:i\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "map\\(force_to:j\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "map\\(force_from:k\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "map\\(force_alloc:m\\)" 1 "original" } }
+
+! { dg-final { scan-tree-dump-times "map\\(force_present:o\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "map\\(tofrom:p\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "map\\(to:r\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "map\\(from:s\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "map\\(alloc:t\\)" 1 "original" } }
+
+! { dg-final { scan-tree-dump-times "map\\(force_deviceptr:u\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "private\\(v\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "firstprivate\\(w\\)" 1 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
diff --git a/gcc/testsuite/gfortran.dg/goacc/parameter.f95 b/gcc/testsuite/gfortran.dg/goacc/parameter.f95
new file mode 100644
index 0000000..7693254
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/parameter.f95
@@ -0,0 +1,30 @@
+! { dg-do compile }
+
+module test
+contains
+ subroutine oacc1
+ implicit none
+ integer :: i
+ integer, parameter :: a = 1
+ !$acc declare device_resident (a) ! { dg-error "PARAMETER" }
+ !$acc data copy (a) ! { dg-error "not a variable" }
+ !$acc end data
+ !$acc data deviceptr (a) ! { dg-error "not a variable" }
+ !$acc end data
+ !$acc parallel private (a) ! { dg-error "not a variable" }
+ !$acc end parallel
+ !$acc host_data use_device (a) ! { dg-error "not a variable" }
+ !$acc end host_data
+ !$acc parallel loop reduction(+:a) ! { dg-error "not a variable" }
+ do i = 1,5
+ enddo
+ !$acc end parallel loop
+ !$acc parallel loop
+ do i = 1,5
+ !$acc cache (a) ! TODO: This must fail, as in openacc-1_0-branch
+ enddo
+ !$acc end parallel loop
+ !$acc update host (a) ! { dg-error "not a variable" }
+ !$acc update device (a) ! { dg-error "not a variable" }
+ end subroutine oacc1
+end module test
\ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/goacc/pure-elemental-procedures.f95 b/gcc/testsuite/gfortran.dg/goacc/pure-elemental-procedures.f95
new file mode 100644
index 0000000..726e8e9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/pure-elemental-procedures.f95
@@ -0,0 +1,78 @@
+! { dg-do compile }
+! { dg-additional-options "-std=f2008 -fcoarray=single" }
+
+module test
+ implicit none
+contains
+ elemental subroutine test1
+ !$acc parallel ! { dg-error "may not appear in PURE procedures" }
+ end subroutine test1
+
+ pure subroutine test2
+ !$acc parallel ! { dg-error "may not appear in PURE procedures" }
+ end subroutine test2
+
+ ! Implicit pure
+ elemental real function test3(x)
+ real, intent(in) :: x
+ !$acc parallel ! { dg-error "may not appear in PURE procedures" }
+ test3 = x*x
+ end function test3
+
+ pure real function test4(x)
+ real, intent(in) :: x
+ !$acc parallel ! { dg-error "may not appear in PURE procedures" }
+ test4 = x
+ end function test4
+
+ subroutine test5
+ real :: x = 0.0
+ integer :: i
+ !$acc parallel loop collapse(1) reduction(+:x)
+ do i = 1,10
+ x = x + 0.3
+ enddo
+ print *, x
+ end subroutine test5
+
+ real function test6(x)
+ real :: x
+ integer :: i
+ !$acc parallel loop collapse(1) reduction(+:x)
+ do i = 1,10
+ x = x + 0.3
+ enddo
+ test6 = x
+ end function test6
+
+ impure elemental real function test7(x)
+ real, intent(in) :: x
+ !$acc parallel
+ test7 = x
+ !$acc end parallel
+ end function test7
+
+ subroutine test8
+ real :: x = 0.0
+ integer :: i
+ !$acc parallel loop collapse(1) reduction(+:x)
+ do i = 1,10
+ critical ! { dg-error "CRITICAL block inside of" }
+ x = x + 0.3
+ end critical
+ enddo
+ print *, x
+ end subroutine test8
+
+ real function test9(n)
+ integer, value :: n
+ BLOCK
+ integer i
+ real sum
+ !$acc loop reduction(+:sum)
+ do i=1, n
+ sum = sum + sin(real(i))
+ end do
+ END BLOCK
+ end function test9
+end module test
\ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/goacc/reduction.f95 b/gcc/testsuite/gfortran.dg/goacc/reduction.f95
new file mode 100644
index 0000000..9b680e0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/reduction.f95
@@ -0,0 +1,138 @@
+! { dg-do compile }
+! { dg-additional-options "-fmax-errors=100" }
+
+subroutine foo (ia1)
+integer :: i1, i2, i3
+integer, dimension (*) :: ia1
+integer, dimension (10) :: ia2
+real :: r1
+real, dimension (5) :: ra1
+double precision :: d1
+double precision, dimension (4) :: da1
+complex :: c1
+complex, dimension (7) :: ca1
+logical :: l1
+logical, dimension (3) :: la1
+character (5) :: a1
+type t
+ integer :: i
+end type
+type(t) :: t1
+type(t), dimension (2) :: ta1
+real, pointer :: p1 => NULL()
+integer, allocatable :: aa1 (:,:)
+save i2
+common /blk/ i1
+
+!$acc parallel reduction (+:ia2)
+!$acc end parallel
+!$acc parallel reduction (+:ra1)
+!$acc end parallel
+!$acc parallel reduction (+:ca1)
+!$acc end parallel
+!$acc parallel reduction (+:da1)
+!$acc end parallel
+!$acc parallel reduction (.and.:la1)
+!$acc end parallel
+!$acc parallel reduction (+:i3, r1, d1, c1)
+!$acc end parallel
+!$acc parallel reduction (*:i3, r1, d1, c1)
+!$acc end parallel
+!$acc parallel reduction (-:i3, r1, d1, c1)
+!$acc end parallel
+!$acc parallel reduction (.and.:l1)
+!$acc end parallel
+!$acc parallel reduction (.or.:l1)
+!$acc end parallel
+!$acc parallel reduction (.eqv.:l1)
+!$acc end parallel
+!$acc parallel reduction (.neqv.:l1)
+!$acc end parallel
+!$acc parallel reduction (min:i3, r1, d1)
+!$acc end parallel
+!$acc parallel reduction (max:i3, r1, d1)
+!$acc end parallel
+!$acc parallel reduction (iand:i3)
+!$acc end parallel
+!$acc parallel reduction (ior:i3)
+!$acc end parallel
+!$acc parallel reduction (ieor:i3)
+!$acc end parallel
+!$acc parallel reduction (+:/blk/) ! { dg-error "Syntax error" }
+!$acc end parallel ! { dg-error "Unexpected" }
+!$acc parallel reduction (*:p1) ! { dg-error "POINTER object" }
+!$acc end parallel
+!$acc parallel reduction (-:aa1)
+!$acc end parallel
+!$acc parallel reduction (*:ia1) ! { dg-error "Assumed size" }
+!$acc end parallel
+!$acc parallel reduction (+:l1) ! { dg-error "must be of numeric type, got LOGICAL" }
+!$acc end parallel
+!$acc parallel reduction (*:la1) ! { dg-error "must be of numeric type, got LOGICAL" }
+!$acc end parallel
+!$acc parallel reduction (-:a1) ! { dg-error "must be of numeric type, got CHARACTER" }
+!$acc end parallel
+!$acc parallel reduction (+:t1) ! { dg-error "must be of numeric type, got TYPE" }
+!$acc end parallel
+!$acc parallel reduction (*:ta1) ! { dg-error "must be of numeric type, got TYPE" }
+!$acc end parallel
+!$acc parallel reduction (.and.:i3) ! { dg-error "must be LOGICAL" }
+!$acc end parallel
+!$acc parallel reduction (.or.:ia2) ! { dg-error "must be LOGICAL" }
+!$acc end parallel
+!$acc parallel reduction (.eqv.:r1) ! { dg-error "must be LOGICAL" }
+!$acc end parallel
+!$acc parallel reduction (.neqv.:ra1) ! { dg-error "must be LOGICAL" }
+!$acc end parallel
+!$acc parallel reduction (.and.:d1) ! { dg-error "must be LOGICAL" }
+!$acc end parallel
+!$acc parallel reduction (.or.:da1) ! { dg-error "must be LOGICAL" }
+!$acc end parallel
+!$acc parallel reduction (.eqv.:c1) ! { dg-error "must be LOGICAL" }
+!$acc end parallel
+!$acc parallel reduction (.neqv.:ca1) ! { dg-error "must be LOGICAL" }
+!$acc end parallel
+!$acc parallel reduction (.and.:a1) ! { dg-error "must be LOGICAL" }
+!$acc end parallel
+!$acc parallel reduction (.or.:t1) ! { dg-error "must be LOGICAL" }
+!$acc end parallel
+!$acc parallel reduction (.eqv.:ta1) ! { dg-error "must be LOGICAL" }
+!$acc end parallel
+!$acc parallel reduction (min:c1) ! { dg-error "must be INTEGER or REAL" }
+!$acc end parallel
+!$acc parallel reduction (max:ca1) ! { dg-error "must be INTEGER or REAL" }
+!$acc end parallel
+!$acc parallel reduction (max:l1) ! { dg-error "must be INTEGER or REAL" }
+!$acc end parallel
+!$acc parallel reduction (min:la1) ! { dg-error "must be INTEGER or REAL" }
+!$acc end parallel
+!$acc parallel reduction (max:a1) ! { dg-error "must be INTEGER or REAL" }
+!$acc end parallel
+!$acc parallel reduction (min:t1) ! { dg-error "must be INTEGER or REAL" }
+!$acc end parallel
+!$acc parallel reduction (max:ta1) ! { dg-error "must be INTEGER or REAL" }
+!$acc end parallel
+!$acc parallel reduction (iand:r1) ! { dg-error "must be INTEGER" }
+!$acc end parallel
+!$acc parallel reduction (ior:ra1) ! { dg-error "must be INTEGER" }
+!$acc end parallel
+!$acc parallel reduction (ieor:d1) ! { dg-error "must be INTEGER" }
+!$acc end parallel
+!$acc parallel reduction (ior:da1) ! { dg-error "must be INTEGER" }
+!$acc end parallel
+!$acc parallel reduction (iand:c1) ! { dg-error "must be INTEGER" }
+!$acc end parallel
+!$acc parallel reduction (ior:ca1) ! { dg-error "must be INTEGER" }
+!$acc end parallel
+!$acc parallel reduction (ieor:l1) ! { dg-error "must be INTEGER" }
+!$acc end parallel
+!$acc parallel reduction (iand:la1) ! { dg-error "must be INTEGER" }
+!$acc end parallel
+!$acc parallel reduction (ior:a1) ! { dg-error "must be INTEGER" }
+!$acc end parallel
+!$acc parallel reduction (ieor:t1) ! { dg-error "must be INTEGER" }
+!$acc end parallel
+!$acc parallel reduction (iand:ta1) ! { dg-error "must be INTEGER" }
+!$acc end parallel
+
+end subroutine
\ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/goacc/sentinel-free-form.f95 b/gcc/testsuite/gfortran.dg/goacc/sentinel-free-form.f95
new file mode 100644
index 0000000..1a3189c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/sentinel-free-form.f95
@@ -0,0 +1,21 @@
+! { dg-do compile }
+
+program test
+ implicit none
+
+ integer :: i
+ real :: x
+
+ ! sentinel may only be preceeded by white space
+ x = 0.0 !$acc parallel ! comment
+ ! sentinel must appear as a single word
+ ! $acc parallel ! comment
+ !$ acc parallel ! { dg-error "Unclassifiable statement" }
+ ! directive lines must have space after sentinel
+ !$accparallel ! { dg-warning "followed by a space" }
+ do i = 1,10
+ x = x + 0.3
+ enddo
+ !$acc end parallel ! { dg-error "Unexpected" }
+ print *, x
+end
\ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/goacc/several-directives.f95 b/gcc/testsuite/gfortran.dg/goacc/several-directives.f95
new file mode 100644
index 0000000..8fb97b5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/several-directives.f95
@@ -0,0 +1,6 @@
+! { dg-do compile }
+
+program test
+ ! only one directive-name may appear in directive
+ !$acc parallel kernels ! { dg-error "Unclassifiable OpenACC directive" }
+end
\ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/goacc/sie.f95 b/gcc/testsuite/gfortran.dg/goacc/sie.f95
new file mode 100644
index 0000000..2d66026
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/sie.f95
@@ -0,0 +1,252 @@
+! { dg-do compile }
+! { dg-additional-options "-fmax-errors=100" }
+
+! tests async, num_gangs, num_workers, vector_length, gang, worker, vector clauses
+
+program test
+ implicit none
+
+ integer :: i
+
+ !$acc parallel async
+ !$acc end parallel
+
+ !$acc parallel async(3)
+ !$acc end parallel
+
+ !$acc parallel async(i)
+ !$acc end parallel
+
+ !$acc parallel async(i+1)
+ !$acc end parallel
+
+ !$acc parallel async(-1)
+ !$acc end parallel
+
+ !$acc parallel async(0)
+ !$acc end parallel
+
+ !$acc parallel async() ! { dg-error "Invalid character in name" }
+
+ !$acc parallel async(1.5) ! { dg-error "scalar INTEGER expression" }
+ !$acc end parallel
+
+ !$acc parallel async(.true.) ! { dg-error "scalar INTEGER expression" }
+ !$acc end parallel
+
+ !$acc parallel async("1") ! { dg-error "scalar INTEGER expression" }
+ !$acc end parallel
+
+ !$acc kernels async
+ !$acc end kernels
+
+ !$acc kernels async(3)
+ !$acc end kernels
+
+ !$acc kernels async(i)
+ !$acc end kernels
+
+ !$acc kernels async(i+1)
+ !$acc end kernels
+
+ !$acc kernels async(-1)
+ !$acc end kernels
+
+ !$acc kernels async(0)
+ !$acc end kernels
+
+ !$acc kernels async() ! { dg-error "Invalid character in name" }
+
+ !$acc kernels async(1.5) ! { dg-error "scalar INTEGER expression" }
+ !$acc end kernels
+
+ !$acc kernels async(.true.) ! { dg-error "scalar INTEGER expression" }
+ !$acc end kernels
+
+ !$acc kernels async("1") ! { dg-error "scalar INTEGER expression" }
+ !$acc end kernels
+
+
+ !$acc parallel num_gangs ! { dg-error "Unclassifiable OpenACC directive" }
+
+ !$acc parallel num_gangs(3)
+ !$acc end parallel
+
+ !$acc parallel num_gangs(i)
+ !$acc end parallel
+
+ !$acc parallel num_gangs(i+1)
+ !$acc end parallel
+
+ !$acc parallel num_gangs(-1) ! { dg-warning "must be positive" }
+ !$acc end parallel
+
+ !$acc parallel num_gangs(0) ! { dg-warning "must be positive" }
+ !$acc end parallel
+
+ !$acc parallel num_gangs() ! { dg-error "Invalid character in name" }
+
+ !$acc parallel num_gangs(1.5) ! { dg-error "scalar INTEGER expression" }
+ !$acc end parallel
+
+ !$acc parallel num_gangs(.true.) ! { dg-error "scalar INTEGER expression" }
+ !$acc end parallel
+
+ !$acc parallel num_gangs("1") ! { dg-error "scalar INTEGER expression" }
+ !$acc end parallel
+
+
+ !$acc parallel num_workers ! { dg-error "Unclassifiable OpenACC directive" }
+
+ !$acc parallel num_workers(3)
+ !$acc end parallel
+
+ !$acc parallel num_workers(i)
+ !$acc end parallel
+
+ !$acc parallel num_workers(i+1)
+ !$acc end parallel
+
+ !$acc parallel num_workers(-1) ! { dg-warning "must be positive" }
+ !$acc end parallel
+
+ !$acc parallel num_workers(0) ! { dg-warning "must be positive" }
+ !$acc end parallel
+
+ !$acc parallel num_workers() ! { dg-error "Invalid character in name" }
+
+ !$acc parallel num_workers(1.5) ! { dg-error "scalar INTEGER expression" }
+ !$acc end parallel
+
+ !$acc parallel num_workers(.true.) ! { dg-error "scalar INTEGER expression" }
+ !$acc end parallel
+
+ !$acc parallel num_workers("1") ! { dg-error "scalar INTEGER expression" }
+ !$acc end parallel
+
+
+ !$acc parallel vector_length ! { dg-error "Unclassifiable OpenACC directive" }
+
+ !$acc parallel vector_length(3)
+ !$acc end parallel
+
+ !$acc parallel vector_length(i)
+ !$acc end parallel
+
+ !$acc parallel vector_length(i+1)
+ !$acc end parallel
+
+ !$acc parallel vector_length(-1) ! { dg-warning "must be positive" }
+ !$acc end parallel
+
+ !$acc parallel vector_length(0) ! { dg-warning "must be positive" }
+ !$acc end parallel
+
+ !$acc parallel vector_length() ! { dg-error "Invalid character in name" }
+
+ !$acc parallel vector_length(1.5) ! { dg-error "scalar INTEGER expression" }
+ !$acc end parallel
+
+ !$acc parallel vector_length(.true.) ! { dg-error "scalar INTEGER expression" }
+ !$acc end parallel
+
+ !$acc parallel vector_length("1") ! { dg-error "scalar INTEGER expression" }
+ !$acc end parallel
+
+
+ !$acc loop gang
+ do i = 1,10
+ enddo
+ !$acc loop gang(3)
+ do i = 1,10
+ enddo
+ !$acc loop gang(i)
+ do i = 1,10
+ enddo
+ !$acc loop gang(i+1)
+ do i = 1,10
+ enddo
+ !$acc loop gang(-1) ! { dg-warning "must be positive" }
+ do i = 1,10
+ enddo
+ !$acc loop gang(0) ! { dg-warning "must be positive" }
+ do i = 1,10
+ enddo
+ !$acc loop gang() ! { dg-error "Invalid character in name" }
+ do i = 1,10
+ enddo
+ !$acc loop gang(1.5) ! { dg-error "scalar INTEGER expression" }
+ do i = 1,10
+ enddo
+ !$acc loop gang(.true.) ! { dg-error "scalar INTEGER expression" }
+ do i = 1,10
+ enddo
+ !$acc loop gang("1") ! { dg-error "scalar INTEGER expression" }
+ do i = 1,10
+ enddo
+
+
+ !$acc loop worker
+ do i = 1,10
+ enddo
+ !$acc loop worker(3)
+ do i = 1,10
+ enddo
+ !$acc loop worker(i)
+ do i = 1,10
+ enddo
+ !$acc loop worker(i+1)
+ do i = 1,10
+ enddo
+ !$acc loop worker(-1) ! { dg-warning "must be positive" }
+ do i = 1,10
+ enddo
+ !$acc loop worker(0) ! { dg-warning "must be positive" }
+ do i = 1,10
+ enddo
+ !$acc loop worker() ! { dg-error "Invalid character in name" }
+ do i = 1,10
+ enddo
+ !$acc loop worker(1.5) ! { dg-error "scalar INTEGER expression" }
+ do i = 1,10
+ enddo
+ !$acc loop worker(.true.) ! { dg-error "scalar INTEGER expression" }
+ do i = 1,10
+ enddo
+ !$acc loop worker("1") ! { dg-error "scalar INTEGER expression" }
+ do i = 1,10
+ enddo
+
+
+ !$acc loop vector
+ do i = 1,10
+ enddo
+ !$acc loop vector(3)
+ do i = 1,10
+ enddo
+ !$acc loop vector(i)
+ do i = 1,10
+ enddo
+ !$acc loop vector(i+1)
+ do i = 1,10
+ enddo
+ !$acc loop vector(-1) ! { dg-warning "must be positive" }
+ do i = 1,10
+ enddo
+ !$acc loop vector(0) ! { dg-warning "must be positive" }
+ do i = 1,10
+ enddo
+ !$acc loop vector() ! { dg-error "Invalid character in name" }
+ do i = 1,10
+ enddo
+ !$acc loop vector(1.5) ! { dg-error "scalar INTEGER expression" }
+ do i = 1,10
+ enddo
+ !$acc loop vector(.true.) ! { dg-error "scalar INTEGER expression" }
+ do i = 1,10
+ enddo
+ !$acc loop vector("1") ! { dg-error "scalar INTEGER expression" }
+ do i = 1,10
+ enddo
+
+end program test
\ No newline at end of file
--
1.8.3.2
^ permalink raw reply [flat|nested] 89+ messages in thread
* Re: [PATCH 1/4] [GOMP4] [Fortran] OpenACC 1.0+ support in fortran front-end
2014-03-04 7:57 ` Ilmir Usmanov
2014-03-04 7:57 ` [PATCH 2/4] " Ilmir Usmanov
@ 2014-03-04 17:20 ` Tobias Burnus
2014-03-07 10:44 ` Ilmir Usmanov
2014-03-04 17:42 ` Tobias Burnus
2 siblings, 1 reply; 89+ messages in thread
From: Tobias Burnus @ 2014-03-04 17:20 UTC (permalink / raw)
To: Ilmir Usmanov
Cc: Thomas Schwinge, Evgeny Gavrin, GarbuzovViacheslav,
Dmitri Botcharnikov, gcc-patches, jakub, fortran
Hi Ilmir,
thanks for the update.
Ilmir Usmanov wrote:
>> I'd use "integer" instead of "INTEGER" as it is not a 'reserved' word
> OpenMP implementation uses capital letters, so, perhaps, we also
> should do this, for consistency?
Fine with me - I don't feel strong about it.
> OpenACC 1.0 support to fortran FE -- core.
>
> --- a/gcc/fortran/match.c
> +++ b/gcc/fortran/match.c
> @@ -2595,6 +2595,33 @@ match_exit_cycle (gfc_statement st, gfc_exec_op op)
> if (cnt > 0
> && o != NULL
> && o->state == COMP_OMP_STRUCTURED_BLOCK
> + && (o->head->op == EXEC_OACC_LOOP
> + || o->head->op == EXEC_OACC_PARALLEL_LOOP))
> + {
> + int collapse = 1;
> + gcc_assert (o->head->next != NULL
> + && (o->head->next->op == EXEC_DO
> + || o->head->next->op == EXEC_DO_WHILE)
> + && o->previous != NULL
> + && o->previous->tail->op == o->head->op);
> + if (o->previous->tail->ext.omp_clauses != NULL
> + && o->previous->tail->ext.omp_clauses->collapse > 1)
> + collapse = o->previous->tail->ext.omp_clauses->collapse;
> + if (st == ST_EXIT && cnt <= collapse)
> + {
> + gfc_error ("EXIT statement at %C terminating !$ACC LOOP loop");
> + return MATCH_ERROR;
> + }
> + if (st == ST_CYCLE && cnt < collapse)
> + {
> + gfc_error ("CYCLE statement at %C to non-innermost collapsed"
> + " !$ACC LOOP loop");
> + return MATCH_ERROR;
> + }
> + }
Can you - if you want as follow up patch - also handle the following
for both your OpenACC code and for the existing OpenMP code:
!$acc loop
outer_loop: do i = 1, n
inner_loop: do j = 1,m
! ...
cycle outer_loop
exit outer_loop
end do inner_loop
end do outer_loop
That's a new Fortran 2008 feature that CYCLE and EXIT can leave the
inner DO loop.
For DO CONCURRENT, that's already handled via the code in
"match_exit_cycle". If you want to try the do-concurrent code, replace
"inner_loop: do j = 1,m" by "inner_loop: do_concurrent(j=1:m)".
Otherwise, it looks good do me. I don't know whether Thomas has
additional comments.
Tobias
^ permalink raw reply [flat|nested] 89+ messages in thread
* Re: [PATCH 1/4] [GOMP4] [Fortran] OpenACC 1.0+ support in fortran front-end
2014-03-04 7:57 ` Ilmir Usmanov
2014-03-04 7:57 ` [PATCH 2/4] " Ilmir Usmanov
2014-03-04 17:20 ` [PATCH 1/4] " Tobias Burnus
@ 2014-03-04 17:42 ` Tobias Burnus
2 siblings, 0 replies; 89+ messages in thread
From: Tobias Burnus @ 2014-03-04 17:42 UTC (permalink / raw)
To: Ilmir Usmanov
Cc: Thomas Schwinge, Evgeny Gavrin, GarbuzovViacheslav,
Dmitri Botcharnikov, gcc-patches, jakub, fortran
Ilmir Usmanov:
> OpenACC 1.0 support to fortran FE -- core.
>
> + case OMP_LIST_USE_DEVICE:
> + if (n->sym->attr.allocatable)
> + gfc_error ("ALLOCATABLE object '%s' of polymorphic type "
> + "in %s clause at %L", n->sym->name, name, &code->loc);
That check is wrong (copy & paste bug): Either you only want to check
for allocatable - then it might be nonpolymorphic. Or you want to check
for polymorphism - then the check needs to be extended.
> + if ((sym->ts.type == BT_CLASS || sym->ts.type == BT_ASSUMED)
> + && sym->attr.allocatable)
> + gfc_error ("ALLOCATABLE object '%s' of polymorphic type "
> + "in %s clause at %L", sym->name, name, &loc);
Due to the idiosyncratic way BT_CLASS is implemented, this allocatable
check won't work. You have to use:
(sym->ts.type == BT_ASSUMED && sym->attr.allocatable)
|| (sym->ts.type == BT_ASSUMED && CLASS_DATA (sym)
&& CLASS_DATA (sym)->attr.allocatable)
You may need to add a similar check also in place of
sym->attr.allocatable and sym->attr.pointer (there:
CLASS_DATA(sym)->attr.class_pointer - instead of attr.pointer) for the
other checks, if a BT_CLASS can occur. (Thus: if(ts.type != BT_CLASS &&
...) || (ts.type == BT_CLASS && ...)
The extra CLASS_DATA(sym) ensures that one doesn't deref a NULL pointer,
which can happen if an error has occurred. That shouldn't be required in
trans*.c, but at least in resolve.c it can happen that the code is
reached, even though an error has been printed before.
> +static void
> +resolve_oacc_cache (gfc_code *)
> +{
> + // Nothing to do yet
> +}
Shouldn't you use:
sorry("OpenACC cache not yet implemented");
or something like that?
Otherwise, it looks good to me.
Tobias
^ permalink raw reply [flat|nested] 89+ messages in thread
* Re: [PATCH 3/4] [GOMP4] [Fortran] OpenACC 1.0+ support in fortran front-end
2014-03-04 7:58 ` [PATCH 3/4] " Ilmir Usmanov
2014-03-04 7:59 ` [PATCH 4/4] " Ilmir Usmanov
@ 2014-03-04 22:52 ` Tobias Burnus
1 sibling, 0 replies; 89+ messages in thread
From: Tobias Burnus @ 2014-03-04 22:52 UTC (permalink / raw)
To: Ilmir Usmanov
Cc: Thomas Schwinge, Evgeny Gavrin, GarbuzovViacheslav,
Dmitri Botcharnikov, gcc-patches, jakub, fortran
Ilmir Usmanov wrote:
> OpenACC 1.0 fortran FE support -- translation to GENERIC.
>
> --- a/gcc/fortran/trans.c
> +++ b/gcc/fortran/trans.c
> @@ -1850,6 +1850,21 @@ trans_code (gfc_code * code, tree cond)
...
> + case EXEC_OACC_PARALLEL:
> + case EXEC_OACC_PARALLEL_LOOP:
> + case EXEC_OACC_ENTER_DATA:
> + case EXEC_OACC_EXIT_DATA:
> + res = gfc_trans_oacc_directive (code);
> + break;
There is something wrong with the indention.
Otherwise, it looks good to me.
Tobias
^ permalink raw reply [flat|nested] 89+ messages in thread
* Re: [PATCH 4/4] [GOMP4] [Fortran] OpenACC 1.0+ support in fortran front-end
2014-03-04 7:59 ` [PATCH 4/4] " Ilmir Usmanov
@ 2014-03-04 22:56 ` Tobias Burnus
0 siblings, 0 replies; 89+ messages in thread
From: Tobias Burnus @ 2014-03-04 22:56 UTC (permalink / raw)
To: Ilmir Usmanov
Cc: Thomas Schwinge, Evgeny Gavrin, GarbuzovViacheslav,
Dmitri Botcharnikov, gcc-patches, jakub, fortran
Ilmir Usmanov wrote:
> OpenACC 1.0 fortran FE support -- tests.
I have browsed through those patches and haven't spotted anything;
however, I have not carefully checked against the OpenACC spec nor
really checked every patch. But at a glance, it looks okay.
Tobias
> gcc/testsuite/gfortran.dg/goacc/
> * assumed.f95: New test
> * branch.f95: Likewise
> * coarray.f95: Likewise
> * continuation-free-form.f95: Likewise
> * cray.f95: Likewise
> * critical.f95: Likewise
> * data-clauses.f95: Likewise
> * data-tree.f95: Likewise
> * declare-1.f95: Likewise
> * enter-exit-data.f95: Likewise
> * goacc.exp: Likewise
> * host_data-tree.f95: Likewise
> * if.f95: Likewise
> * kernels-tree.f95: Likewise
> * list.f95: Likewise
> * literal.f95: Likewise
> * loop-1.f95: Likewise
> * loop-2.f95: Likewise
> * loop-3.f95: Likewise
> * omp.f95: Likewise
> * parallel-kernels-clauses.f95: Likewise
> * parallel-kernels-regions.f95: Likewise
> * parallel-tree.f95: Likewise
> * parameter.f95: Likewise
> * pure-elemental-procedures.f95: Likewise
> * reduction.f95: Likewise
> * sentinel-free-form.f95: Likewise
> * several-directives.f95: Likewise
> * sie.f95: Likewise
^ permalink raw reply [flat|nested] 89+ messages in thread
* Re: [PATCH 1/4] [GOMP4] [Fortran] OpenACC 1.0+ support in fortran front-end
2014-03-04 17:20 ` [PATCH 1/4] " Tobias Burnus
@ 2014-03-07 10:44 ` Ilmir Usmanov
2014-03-07 10:45 ` Ilmir Usmanov
2014-03-10 15:44 ` Thomas Schwinge
0 siblings, 2 replies; 89+ messages in thread
From: Ilmir Usmanov @ 2014-03-07 10:44 UTC (permalink / raw)
To: Tobias Burnus
Cc: Thomas Schwinge, Evgeny Gavrin, GarbuzovViacheslav,
Dmitri Botcharnikov, gcc-patches, jakub, fortran
Hi Tobias!
Thanks a lot for your review!
> !$acc loop
> outer_loop: do i = 1, n
> inner_loop: do j = 1,m
> ! ...
> cycle outer_loop
> exit outer_loop
> end do inner_loop
> end do outer_loop
>
> That's a new Fortran 2008 feature that CYCLE and EXIT can leave the
> inner DO loop.
>
I added the following to test suite:
> !$acc loop
> outer_loop: do i = 1, 5
> inner_loop: do j = 1,5
> if (i .eq. j) cycle outer_loop
> if (i .ne. j) exit outer_loop ! { dg-error "EXIT statement" }
> end do inner_loop
> end do outer_loop
>
> outer_loop1: do i = 1, 5
> !$acc loop
> inner_loop1: do j = 1,5
> if (i .eq. j) cycle outer_loop1 ! { dg-error "CYCLE statement" }
> end do inner_loop1
> end do outer_loop1
>
> !$acc loop collapse(2)
> outer_loop2: do i = 1, 5
> inner_loop2: do j = 1,5
> if (i .eq. j) cycle outer_loop2 ! { dg-error "CYCLE statement" }
> if (i .ne. j) exit outer_loop2 ! { dg-error "EXIT statement" }
> end do inner_loop2
> end do outer_loop2
All cases pass.
The second one passes due to check of structured blocks:
> if (o != NULL)
> {
> gfc_error ("%s statement at %C leaving OpenMP structured block",
> gfc_ascii_statement (st));
> return MATCH_ERROR;
> }
So, I needed to change error message.
Also I fixed checks of polymofphic type and indentation.
OK for gomp4 branch?
--
Ilmir.
^ permalink raw reply [flat|nested] 89+ messages in thread
* Re: [PATCH 1/4] [GOMP4] [Fortran] OpenACC 1.0+ support in fortran front-end
2014-03-07 10:44 ` Ilmir Usmanov
@ 2014-03-07 10:45 ` Ilmir Usmanov
2014-03-07 10:46 ` [PATCH 2/4] " Ilmir Usmanov
2014-03-12 18:27 ` [PATCH 1/4] " Tobias Burnus
2014-03-10 15:44 ` Thomas Schwinge
1 sibling, 2 replies; 89+ messages in thread
From: Ilmir Usmanov @ 2014-03-07 10:45 UTC (permalink / raw)
To: Tobias Burnus
Cc: Thomas Schwinge, Evgeny Gavrin, GarbuzovViacheslav,
Dmitri Botcharnikov, gcc-patches, jakub, fortran
[-- Attachment #1: Type: text/plain, Size: 3802 bytes --]
OpenACC 1.0 support to fortran FE -- core.
gcc/fortran/
* dump-parse-tree.c
(show_omp_node): Dump also OpenACC executable statements.
(show_code_node): Call it.
(show_namespace): Dump !$ACC DECLARE directive.
* gfortran.h
(ST_OACC_PARALLEL_LOOP, ST_OACC_END_PARALLEL_LOOP, ST_OACC_PARALLEL,
ST_OACC_END_PARALLEL, ST_OACC_KERNELS, ST_OACC_END_KERNELS,
ST_OACC_DATA, ST_OACC_END_DATA, ST_OACC_HOST_DATA,
ST_OACC_END_HOST_DATA, ST_OACC_LOOP, ST_OACC_DECLARE, ST_OACC_UPDATE,
ST_OACC_WAIT, ST_OACC_CACHE, ST_OACC_KERNELS_LOOP,
ST_OACC_END_KERNELS_LOOP, ST_OACC_ENTER_DATA,
ST_OACC_EXIT_DATA, ST_OACC_END_LOOP): New statements.
(gfc_expr_list): New structure to hold list of expressions.
(OMP_LIST_COPY, OMP_LIST_DATA_CLAUSE_FIRST,
OMP_LIST_OACC_COPYIN, OMP_LIST_COPYOUT, OMP_LIST_CREATE,
OMP_LIST_DELETE,
OMP_LIST_PRESENT, OMP_LIST_PRESENT_OR_COPY,
OMP_LIST_PRESENT_OR_COPYIN, OMP_LIST_PRESENT_OR_COPYOUT,
OMP_LIST_PRESENT_OR_CREATE, OMP_LIST_DEVICEPTR,
OMP_LIST_DATA_CLAUSE_LAST, OMP_LIST_USE_DEVICE,
OMP_LIST_DEVICE_RESIDENT, OMP_LIST_HOST, OMP_LIST_DEVICE,
OMP_LIST_CACHE): New types of list, allowed in clauses.
(gfc_omp_clauses): Add OpenACC clauses.
(gfc_namespace): Add OpenACC declare directive clauses.
(EXEC_OACC_KERNELS_LOOP, EXEC_OACC_PARALLEL_LOOP, 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): New executable statements.
(gfc_free_expr_list): New function declaration.
(gfc_resolve_oacc_directive): Likewise.
(gfc_resolve_oacc_parallel_loop_blocks): Likewise.
(gfc_resolve_oacc_blocks): Likewise.
* match.c (match_exit_cycle): Add support of OpenACC regions and
loops.
* match.h (gfc_match_oacc_cache): New function declaration.
(gfc_match_oacc_wait, gfc_match_oacc_update): Likewise.
(gfc_match_oacc_declare, gfc_match_oacc_loop): Likewise.
(gfc_match_oacc_host_data, gfc_match_oacc_data): Likewise.
(gfc_match_oacc_kernels, gfc_match_oacc_kernels_loop): Likewise.
(gfc_match_oacc_parallel, gfc_match_oacc_parallel_loop): Likewise.
(gfc_match_oacc_enter_data, gfc_match_oacc_exit_data): Likewise.
* parse.c (decode_oacc_directive): New function.
(verify_token_free, verify_token_fixed): New helper functions.
(next_free, next_fixed): Decode !$ACC sentinel.
(case_executable): Add ST_OACC_UPDATE, ST_OACC_WAIT, ST_OACC_CACHE,
ST_OACC_ENTER_DATA and ST_OACC_EXIT_DATA directives.
(case_exec_markers): Add ST_OACC_PARALLEL_LOOP, ST_OACC_PARALLEL,
ST_OACC_KERNELS, ST_OACC_DATA, ST_OACC_HOST_DATA, ST_OACC_LOOP and
ST_OACC_KERNELS_LOOP directives.
(push_state): Initialize OpenACC declare clauses.
(gfc_ascii_statement): Dump names of OpenACC directives.
(verify_st_order): Verify OpenACC declare directive as declarative.
(parse_spec): Push clauses to state stack when declare directive is
parsed.
(parse_oacc_structured_block, parse_oacc_loop): New functions.
(parse_executable): Call them.
(parse_progunit): Move declare clauses from state stack to namespace.
* parse.h (gfc_state_data): Add declare directive's clauses.
* resolve.c (gfc_resolve_blocks): Resolve OpenACC directives.
(resolve_code): Likewise.
* scanner.c (openacc_flag, openacc_locus): New static variables.
(skip_oacc_attribute, skip_omp_attribute): New helper functions.
(skip_free_comments, skip_fixed_comments): Don't skip !$ACC sentinel.
(gfc_next_char_literal): Support OpenACC directives.
* st.c (gfc_free_statement): Free also OpenACC directives.
[-- Attachment #2: 0001-OpenACC-Fortran-FE-part-1.patch --]
[-- Type: text/x-diff, Size: 53315 bytes --]
From e1c245e93accbd4c7229d7f1bf6c8b5544981401 Mon Sep 17 00:00:00 2001
From: Ilmir Usmanov <i.usmanov@samsung.com>
Date: Fri, 7 Mar 2014 14:33:00 +0400
Subject: [PATCH 1/4] OpenACC Fortran FE -- part 1
---
gcc/fortran/dump-parse-tree.c | 391 +++++++++++++++++++++++++-----------
gcc/fortran/gfortran.h | 68 +++++++
gcc/fortran/match.c | 29 ++-
gcc/fortran/match.h | 15 ++
gcc/fortran/parse.c | 446 +++++++++++++++++++++++++++++++++++++++---
gcc/fortran/parse.h | 1 +
gcc/fortran/resolve.c | 37 ++++
gcc/fortran/scanner.c | 370 ++++++++++++++++++++++++++++-------
gcc/fortran/st.c | 12 ++
9 files changed, 1159 insertions(+), 210 deletions(-)
diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c
index b1343bc..b6679ab 100644
--- a/gcc/fortran/dump-parse-tree.c
+++ b/gcc/fortran/dump-parse-tree.c
@@ -1023,7 +1023,233 @@ show_namelist (gfc_namelist *n)
fprintf (dumpfile, "%s", n->sym->name);
}
-/* Show a single OpenMP directive node and everything underneath it
+
+/* Show OpenMP or OpenACC clauses. */
+
+static void
+show_omp_clauses (gfc_omp_clauses *omp_clauses)
+{
+ int list_type;
+
+ if (omp_clauses->if_expr)
+ {
+ fputs (" IF(", dumpfile);
+ show_expr (omp_clauses->if_expr);
+ fputc (')', dumpfile);
+ }
+ if (omp_clauses->final_expr)
+ {
+ fputs (" FINAL(", dumpfile);
+ show_expr (omp_clauses->final_expr);
+ fputc (')', dumpfile);
+ }
+ if (omp_clauses->num_threads)
+ {
+ fputs (" NUM_THREADS(", dumpfile);
+ show_expr (omp_clauses->num_threads);
+ fputc (')', dumpfile);
+ }
+ if (omp_clauses->async)
+ {
+ fputs (" ASYNC", dumpfile);
+ if (omp_clauses->async_expr)
+ {
+ fputc ('(', dumpfile);
+ show_expr (omp_clauses->async_expr);
+ fputc (')', dumpfile);
+ }
+ }
+ if (omp_clauses->num_gangs_expr)
+ {
+ fputs (" NUM_GANGS(", dumpfile);
+ show_expr (omp_clauses->num_gangs_expr);
+ fputc (')', dumpfile);
+ }
+ if (omp_clauses->num_workers_expr)
+ {
+ fputs (" NUM_WORKERS(", dumpfile);
+ show_expr (omp_clauses->num_workers_expr);
+ fputc (')', dumpfile);
+ }
+ if (omp_clauses->vector_length_expr)
+ {
+ fputs (" VECTOR_LENGTH(", dumpfile);
+ show_expr (omp_clauses->vector_length_expr);
+ fputc (')', dumpfile);
+ }
+ if (omp_clauses->gang)
+ {
+ fputs (" GANG", dumpfile);
+ if (omp_clauses->gang_expr)
+ {
+ fputc ('(', dumpfile);
+ show_expr (omp_clauses->gang_expr);
+ fputc (')', dumpfile);
+ }
+ }
+ if (omp_clauses->worker)
+ {
+ fputs (" WORKER", dumpfile);
+ if (omp_clauses->worker_expr)
+ {
+ fputc ('(', dumpfile);
+ show_expr (omp_clauses->worker_expr);
+ fputc (')', dumpfile);
+ }
+ }
+ if (omp_clauses->vector)
+ {
+ fputs (" VECTOR", dumpfile);
+ if (omp_clauses->vector_expr)
+ {
+ fputc ('(', dumpfile);
+ show_expr (omp_clauses->vector_expr);
+ fputc (')', dumpfile);
+ }
+ }
+ if (omp_clauses->non_clause_wait_expr)
+ {
+ fputc ('(', dumpfile);
+ show_expr (omp_clauses->non_clause_wait_expr);
+ fputc (')', dumpfile);
+ }
+ if (omp_clauses->sched_kind != OMP_SCHED_NONE)
+ {
+ const char *type;
+ switch (omp_clauses->sched_kind)
+ {
+ case OMP_SCHED_STATIC: type = "STATIC"; break;
+ case OMP_SCHED_DYNAMIC: type = "DYNAMIC"; break;
+ case OMP_SCHED_GUIDED: type = "GUIDED"; break;
+ case OMP_SCHED_RUNTIME: type = "RUNTIME"; break;
+ case OMP_SCHED_AUTO: type = "AUTO"; break;
+ default:
+ gcc_unreachable ();
+ }
+ fprintf (dumpfile, " SCHEDULE (%s", type);
+ if (omp_clauses->chunk_size)
+ {
+ fputc (',', dumpfile);
+ show_expr (omp_clauses->chunk_size);
+ }
+ fputc (')', dumpfile);
+ }
+ if (omp_clauses->default_sharing != OMP_DEFAULT_UNKNOWN)
+ {
+ const char *type;
+ switch (omp_clauses->default_sharing)
+ {
+ case OMP_DEFAULT_NONE: type = "NONE"; break;
+ case OMP_DEFAULT_PRIVATE: type = "PRIVATE"; break;
+ case OMP_DEFAULT_SHARED: type = "SHARED"; break;
+ case OMP_DEFAULT_FIRSTPRIVATE: type = "FIRSTPRIVATE"; break;
+ default:
+ gcc_unreachable ();
+ }
+ fprintf (dumpfile, " DEFAULT(%s)", type);
+ }
+ if (omp_clauses->tile_list)
+ {
+ gfc_expr_list *list;
+ fputs (" TILE(", dumpfile);
+ for (list = omp_clauses->tile_list; list; list = list->next)
+ {
+ show_expr (list->expr);
+ if (list->next)
+ fputs (", ", dumpfile);
+ }
+ fputc (')', dumpfile);
+ }
+ if (omp_clauses->wait_list)
+ {
+ gfc_expr_list *list;
+ fputs (" WAIT(", dumpfile);
+ for (list = omp_clauses->wait_list; list; list = list->next)
+ {
+ show_expr (list->expr);
+ if (list->next)
+ fputs (", ", dumpfile);
+ }
+ fputc (')', dumpfile);
+ }
+ if (omp_clauses->seq)
+ fputs (" SEQ", dumpfile);
+ if (omp_clauses->independent)
+ fputs (" INDEPENDENT", dumpfile);
+ if (omp_clauses->ordered)
+ fputs (" ORDERED", dumpfile);
+ if (omp_clauses->untied)
+ fputs (" UNTIED", dumpfile);
+ if (omp_clauses->mergeable)
+ fputs (" MERGEABLE", dumpfile);
+ if (omp_clauses->collapse)
+ fprintf (dumpfile, " COLLAPSE(%d)", omp_clauses->collapse);
+ for (list_type = 0; list_type < OMP_LIST_NUM; list_type++)
+ if (omp_clauses->lists[list_type] != NULL
+ && list_type != OMP_LIST_COPYPRIVATE)
+ {
+ const char *type;
+ if (list_type >= OMP_LIST_REDUCTION_FIRST)
+ {
+ switch (list_type)
+ {
+ case OMP_LIST_PLUS: type = "+"; break;
+ case OMP_LIST_MULT: type = "*"; break;
+ case OMP_LIST_SUB: type = "-"; break;
+ case OMP_LIST_AND: type = ".AND."; break;
+ case OMP_LIST_OR: type = ".OR."; break;
+ case OMP_LIST_EQV: type = ".EQV."; break;
+ case OMP_LIST_NEQV: type = ".NEQV."; break;
+ case OMP_LIST_MAX: type = "MAX"; break;
+ case OMP_LIST_MIN: type = "MIN"; break;
+ case OMP_LIST_IAND: type = "IAND"; break;
+ case OMP_LIST_IOR: type = "IOR"; break;
+ case OMP_LIST_IEOR: type = "IEOR"; break;
+ default:
+ gcc_unreachable ();
+ }
+ fprintf (dumpfile, " REDUCTION(%s:", type);
+ }
+ else
+ {
+ switch (list_type)
+ {
+ case OMP_LIST_COPY: type = "COPY"; break;
+ case OMP_LIST_OACC_COPYIN: type = "COPYIN"; break;
+ case OMP_LIST_COPYOUT: type = "COPYOUT"; break;
+ case OMP_LIST_CREATE: type = "CREATE"; break;
+ case OMP_LIST_DELETE: type = "DELETE"; break;
+ case OMP_LIST_PRESENT: type = "PRESENT"; break;
+ case OMP_LIST_PRESENT_OR_COPY:
+ type = "PRESENT_OR_COPY"; break;
+ case OMP_LIST_PRESENT_OR_COPYIN:
+ type = "PRESENT_OR_COPYIN"; break;
+ case OMP_LIST_PRESENT_OR_COPYOUT:
+ type = "PRESENT_OR_COPYOUT"; break;
+ case OMP_LIST_PRESENT_OR_CREATE:
+ type = "PRESENT_OR_CREATE"; break;
+ case OMP_LIST_DEVICEPTR: type = "DEVICEPTR"; break;
+ case OMP_LIST_USE_DEVICE: type = "USE_DEVICE"; break;
+ case OMP_LIST_DEVICE_RESIDENT: type = "USE_DEVICE"; break;
+ case OMP_LIST_HOST: type = "HOST"; break;
+ case OMP_LIST_DEVICE: type = "DEVICE"; break;
+ case OMP_LIST_CACHE: type = ""; break;
+ case OMP_LIST_PRIVATE: type = "PRIVATE"; break;
+ case OMP_LIST_FIRSTPRIVATE: type = "FIRSTPRIVATE"; break;
+ case OMP_LIST_LASTPRIVATE: type = "LASTPRIVATE"; break;
+ case OMP_LIST_SHARED: type = "SHARED"; break;
+ case OMP_LIST_COPYIN: type = "COPYIN"; break;
+ default:
+ gcc_unreachable ();
+ }
+ fprintf (dumpfile, " %s(", type);
+ }
+ show_namelist (omp_clauses->lists[list_type]);
+ fputc (')', dumpfile);
+ }
+}
+
+/* Show a single OpenMP or OpenACC directive node and everything underneath it
if necessary. */
static void
@@ -1031,9 +1257,22 @@ show_omp_node (int level, gfc_code *c)
{
gfc_omp_clauses *omp_clauses = NULL;
const char *name = NULL;
+ bool is_oacc = false;
switch (c->op)
{
+ case EXEC_OACC_PARALLEL_LOOP: name = "PARALLEL LOOP"; is_oacc = true; break;
+ case EXEC_OACC_PARALLEL: name = "PARALLEL"; is_oacc = true; break;
+ case EXEC_OACC_KERNELS_LOOP: name = "KERNELS LOOP"; is_oacc = true; break;
+ case EXEC_OACC_KERNELS: name = "KERNELS"; is_oacc = true; break;
+ case EXEC_OACC_DATA: name = "DATA"; is_oacc = true; break;
+ case EXEC_OACC_HOST_DATA: name = "HOST_DATA"; is_oacc = true; break;
+ case EXEC_OACC_LOOP: name = "LOOP"; is_oacc = true; break;
+ case EXEC_OACC_UPDATE: name = "UPDATE"; is_oacc = true; break;
+ case EXEC_OACC_WAIT: name = "WAIT"; is_oacc = true; break;
+ case EXEC_OACC_CACHE: name = "CACHE"; is_oacc = true; break;
+ case EXEC_OACC_ENTER_DATA: name = "ENTER DATA"; is_oacc = true; break;
+ case EXEC_OACC_EXIT_DATA: name = "EXIT DATA"; is_oacc = true; break;
case EXEC_OMP_ATOMIC: name = "ATOMIC"; break;
case EXEC_OMP_BARRIER: name = "BARRIER"; break;
case EXEC_OMP_CRITICAL: name = "CRITICAL"; break;
@@ -1054,9 +1293,21 @@ show_omp_node (int level, gfc_code *c)
default:
gcc_unreachable ();
}
- fprintf (dumpfile, "!$OMP %s", name);
+ fprintf (dumpfile, "!$%s %s", is_oacc ? "ACC" : "OMP", name);
switch (c->op)
{
+ case EXEC_OACC_PARALLEL_LOOP:
+ case EXEC_OACC_PARALLEL:
+ case EXEC_OACC_KERNELS_LOOP:
+ case EXEC_OACC_KERNELS:
+ case EXEC_OACC_DATA:
+ case EXEC_OACC_HOST_DATA:
+ case EXEC_OACC_LOOP:
+ case EXEC_OACC_UPDATE:
+ case EXEC_OACC_WAIT:
+ case EXEC_OACC_CACHE:
+ case EXEC_OACC_ENTER_DATA:
+ case EXEC_OACC_EXIT_DATA:
case EXEC_OMP_DO:
case EXEC_OMP_PARALLEL:
case EXEC_OMP_PARALLEL_DO:
@@ -1088,115 +1339,13 @@ show_omp_node (int level, gfc_code *c)
break;
}
if (omp_clauses)
- {
- int list_type;
-
- if (omp_clauses->if_expr)
- {
- fputs (" IF(", dumpfile);
- show_expr (omp_clauses->if_expr);
- fputc (')', dumpfile);
- }
- if (omp_clauses->final_expr)
- {
- fputs (" FINAL(", dumpfile);
- show_expr (omp_clauses->final_expr);
- fputc (')', dumpfile);
- }
- if (omp_clauses->num_threads)
- {
- fputs (" NUM_THREADS(", dumpfile);
- show_expr (omp_clauses->num_threads);
- fputc (')', dumpfile);
- }
- if (omp_clauses->sched_kind != OMP_SCHED_NONE)
- {
- const char *type;
- switch (omp_clauses->sched_kind)
- {
- case OMP_SCHED_STATIC: type = "STATIC"; break;
- case OMP_SCHED_DYNAMIC: type = "DYNAMIC"; break;
- case OMP_SCHED_GUIDED: type = "GUIDED"; break;
- case OMP_SCHED_RUNTIME: type = "RUNTIME"; break;
- case OMP_SCHED_AUTO: type = "AUTO"; break;
- default:
- gcc_unreachable ();
- }
- fprintf (dumpfile, " SCHEDULE (%s", type);
- if (omp_clauses->chunk_size)
- {
- fputc (',', dumpfile);
- show_expr (omp_clauses->chunk_size);
- }
- fputc (')', dumpfile);
- }
- if (omp_clauses->default_sharing != OMP_DEFAULT_UNKNOWN)
- {
- const char *type;
- switch (omp_clauses->default_sharing)
- {
- case OMP_DEFAULT_NONE: type = "NONE"; break;
- case OMP_DEFAULT_PRIVATE: type = "PRIVATE"; break;
- case OMP_DEFAULT_SHARED: type = "SHARED"; break;
- case OMP_DEFAULT_FIRSTPRIVATE: type = "FIRSTPRIVATE"; break;
- default:
- gcc_unreachable ();
- }
- fprintf (dumpfile, " DEFAULT(%s)", type);
- }
- if (omp_clauses->ordered)
- fputs (" ORDERED", dumpfile);
- if (omp_clauses->untied)
- fputs (" UNTIED", dumpfile);
- if (omp_clauses->mergeable)
- fputs (" MERGEABLE", dumpfile);
- if (omp_clauses->collapse)
- fprintf (dumpfile, " COLLAPSE(%d)", omp_clauses->collapse);
- for (list_type = 0; list_type < OMP_LIST_NUM; list_type++)
- if (omp_clauses->lists[list_type] != NULL
- && list_type != OMP_LIST_COPYPRIVATE)
- {
- const char *type;
- if (list_type >= OMP_LIST_REDUCTION_FIRST)
- {
- switch (list_type)
- {
- case OMP_LIST_PLUS: type = "+"; break;
- case OMP_LIST_MULT: type = "*"; break;
- case OMP_LIST_SUB: type = "-"; break;
- case OMP_LIST_AND: type = ".AND."; break;
- case OMP_LIST_OR: type = ".OR."; break;
- case OMP_LIST_EQV: type = ".EQV."; break;
- case OMP_LIST_NEQV: type = ".NEQV."; break;
- case OMP_LIST_MAX: type = "MAX"; break;
- case OMP_LIST_MIN: type = "MIN"; break;
- case OMP_LIST_IAND: type = "IAND"; break;
- case OMP_LIST_IOR: type = "IOR"; break;
- case OMP_LIST_IEOR: type = "IEOR"; break;
- default:
- gcc_unreachable ();
- }
- fprintf (dumpfile, " REDUCTION(%s:", type);
- }
- else
- {
- switch (list_type)
- {
- case OMP_LIST_PRIVATE: type = "PRIVATE"; break;
- case OMP_LIST_FIRSTPRIVATE: type = "FIRSTPRIVATE"; break;
- case OMP_LIST_LASTPRIVATE: type = "LASTPRIVATE"; break;
- case OMP_LIST_SHARED: type = "SHARED"; break;
- case OMP_LIST_COPYIN: type = "COPYIN"; break;
- default:
- gcc_unreachable ();
- }
- fprintf (dumpfile, " %s(", type);
- }
- show_namelist (omp_clauses->lists[list_type]);
- fputc (')', dumpfile);
- }
- }
+ show_omp_clauses (omp_clauses);
fputc ('\n', dumpfile);
+
+ /* OpenACC executable directives don't have associated blocks. */
+ if (c->op == EXEC_OACC_CACHE || c->op == EXEC_OACC_UPDATE
+ || c->op == EXEC_OACC_ENTER_DATA || c->op == EXEC_OACC_EXIT_DATA)
+ return;
if (c->op == EXEC_OMP_SECTIONS || c->op == EXEC_OMP_PARALLEL_SECTIONS)
{
gfc_code *d = c->block;
@@ -1215,7 +1364,7 @@ show_omp_node (int level, gfc_code *c)
if (c->op == EXEC_OMP_ATOMIC)
return;
code_indent (level, 0);
- fprintf (dumpfile, "!$OMP END %s", name);
+ fprintf (dumpfile, "!$%s END %s", is_oacc ? "ACC" : "OMP", name);
if (omp_clauses != NULL)
{
if (omp_clauses->lists[OMP_LIST_COPYPRIVATE])
@@ -2194,6 +2343,18 @@ show_code_node (int level, gfc_code *c)
fprintf (dumpfile, " EOR=%d", dt->eor->value);
break;
+ case EXEC_OACC_PARALLEL_LOOP:
+ case EXEC_OACC_PARALLEL:
+ case EXEC_OACC_KERNELS_LOOP:
+ case EXEC_OACC_KERNELS:
+ case EXEC_OACC_DATA:
+ case EXEC_OACC_HOST_DATA:
+ case EXEC_OACC_LOOP:
+ case EXEC_OACC_UPDATE:
+ case EXEC_OACC_WAIT:
+ case EXEC_OACC_CACHE:
+ case EXEC_OACC_ENTER_DATA:
+ case EXEC_OACC_EXIT_DATA:
case EXEC_OMP_ATOMIC:
case EXEC_OMP_BARRIER:
case EXEC_OMP_CRITICAL:
@@ -2309,6 +2470,14 @@ show_namespace (gfc_namespace *ns)
for (eq = ns->equiv; eq; eq = eq->next)
show_equiv (eq);
+ if (ns->oacc_declare_clauses)
+ {
+ /* Dump !$ACC DECLARE clauses. */
+ show_indent ();
+ fprintf (dumpfile, "!$ACC DECLARE");
+ show_omp_clauses (ns->oacc_declare_clauses);
+ }
+
fputc ('\n', dumpfile);
show_indent ();
fputs ("code:", dumpfile);
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index bce53a4..e09393d 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -203,6 +203,12 @@ typedef enum
ST_WRITE, ST_ASSIGNMENT, ST_POINTER_ASSIGNMENT, ST_SELECT_CASE, ST_SEQUENCE,
ST_SIMPLE_IF, ST_STATEMENT_FUNCTION, ST_DERIVED_DECL, ST_LABEL_ASSIGNMENT,
ST_ENUM, ST_ENUMERATOR, ST_END_ENUM, ST_SELECT_TYPE, ST_TYPE_IS, ST_CLASS_IS,
+ ST_OACC_PARALLEL_LOOP, ST_OACC_END_PARALLEL_LOOP, ST_OACC_PARALLEL,
+ ST_OACC_END_PARALLEL, ST_OACC_KERNELS, ST_OACC_END_KERNELS, ST_OACC_DATA,
+ ST_OACC_END_DATA, ST_OACC_HOST_DATA, ST_OACC_END_HOST_DATA, ST_OACC_LOOP,
+ ST_OACC_END_LOOP, ST_OACC_DECLARE, ST_OACC_UPDATE, ST_OACC_WAIT,
+ ST_OACC_CACHE, ST_OACC_KERNELS_LOOP, ST_OACC_END_KERNELS_LOOP,
+ ST_OACC_ENTER_DATA, ST_OACC_EXIT_DATA,
ST_OMP_ATOMIC, ST_OMP_BARRIER, ST_OMP_CRITICAL, ST_OMP_END_ATOMIC,
ST_OMP_END_CRITICAL, ST_OMP_END_DO, ST_OMP_END_MASTER, ST_OMP_END_ORDERED,
ST_OMP_END_PARALLEL, ST_OMP_END_PARALLEL_DO, ST_OMP_END_PARALLEL_SECTIONS,
@@ -1025,6 +1031,16 @@ gfc_namelist;
#define gfc_get_namelist() XCNEW (gfc_namelist)
+/* Likewise to gfc_namelist, but contains expressions. */
+typedef struct gfc_expr_list
+{
+ struct gfc_expr *expr;
+ struct gfc_expr_list *next;
+}
+gfc_expr_list;
+
+#define gfc_get_expr_list() XCNEW (gfc_expr_list)
+
enum
{
OMP_LIST_PRIVATE,
@@ -1033,6 +1049,24 @@ enum
OMP_LIST_COPYPRIVATE,
OMP_LIST_SHARED,
OMP_LIST_COPYIN,
+ OMP_LIST_COPY,
+ OMP_LIST_DATA_CLAUSE_FIRST = OMP_LIST_COPY,
+ OMP_LIST_OACC_COPYIN,
+ OMP_LIST_COPYOUT,
+ OMP_LIST_CREATE,
+ OMP_LIST_DELETE,
+ OMP_LIST_PRESENT,
+ OMP_LIST_PRESENT_OR_COPY,
+ OMP_LIST_PRESENT_OR_COPYIN,
+ OMP_LIST_PRESENT_OR_COPYOUT,
+ OMP_LIST_PRESENT_OR_CREATE,
+ OMP_LIST_DEVICEPTR,
+ OMP_LIST_DATA_CLAUSE_LAST = OMP_LIST_DEVICEPTR,
+ OMP_LIST_DEVICE_RESIDENT,
+ OMP_LIST_USE_DEVICE,
+ OMP_LIST_HOST,
+ OMP_LIST_DEVICE,
+ OMP_LIST_CACHE,
OMP_LIST_PLUS,
OMP_LIST_REDUCTION_FIRST = OMP_LIST_PLUS,
OMP_LIST_MULT,
@@ -1083,6 +1117,28 @@ typedef struct gfc_omp_clauses
enum gfc_omp_default_sharing default_sharing;
int collapse;
bool nowait, ordered, untied, mergeable;
+
+ /* OpenACC. */
+ struct gfc_expr *async_expr;
+ struct gfc_expr *gang_expr;
+ struct gfc_expr *worker_expr;
+ struct gfc_expr *vector_expr;
+ struct gfc_expr *num_gangs_expr;
+ struct gfc_expr *num_workers_expr;
+ struct gfc_expr *vector_length_expr;
+ struct gfc_expr *non_clause_wait_expr;
+ gfc_expr_list *wait_list;
+ gfc_expr_list *tile_list;
+ unsigned async:1, gang:1, worker:1, vector:1, seq:1, independent:1;
+ unsigned wait:1, par_auto:1, gang_static:1;
+
+ /* Directive specific data. */
+ union
+ {
+ /* !$ACC DECLARE locus. */
+ locus loc;
+ }
+ ext;
}
gfc_omp_clauses;
@@ -1444,6 +1500,9 @@ typedef struct gfc_namespace
this namespace. */
struct gfc_data *data;
+ /* !$ACC DECLARE clauses. */
+ gfc_omp_clauses *oacc_declare_clauses;
+
gfc_charlen *cl_list, *old_cl_list;
gfc_dt_list *derived_types;
@@ -2102,6 +2161,10 @@ typedef enum
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_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_OMP_CRITICAL, EXEC_OMP_DO, EXEC_OMP_FLUSH, EXEC_OMP_MASTER,
EXEC_OMP_ORDERED, EXEC_OMP_PARALLEL, EXEC_OMP_PARALLEL_DO,
EXEC_OMP_PARALLEL_SECTIONS, EXEC_OMP_PARALLEL_WORKSHARE,
@@ -2743,6 +2806,11 @@ void gfc_resolve_omp_parallel_blocks (gfc_code *, gfc_namespace *);
void gfc_resolve_omp_do_blocks (gfc_code *, gfc_namespace *);
void gfc_omp_save_and_clear_state (struct gfc_omp_saved_state *);
void gfc_omp_restore_state (struct gfc_omp_saved_state *);
+void gfc_free_expr_list (gfc_expr_list *);
+void gfc_resolve_oacc_directive (gfc_code *, gfc_namespace *);
+void gfc_resolve_oacc_declare (gfc_namespace *);
+void gfc_resolve_oacc_parallel_loop_blocks (gfc_code *, gfc_namespace *);
+void gfc_resolve_oacc_blocks (gfc_code *, gfc_namespace *);
/* expr.c */
void gfc_free_actual_arglist (gfc_actual_arglist *);
diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c
index eda1bf3..5965247 100644
--- a/gcc/fortran/match.c
+++ b/gcc/fortran/match.c
@@ -2585,7 +2585,7 @@ match_exit_cycle (gfc_statement st, gfc_exec_op op)
if (o != NULL)
{
- gfc_error ("%s statement at %C leaving OpenMP structured block",
+ gfc_error ("%s statement at %C leaving OpenMP or OpenACC structured block",
gfc_ascii_statement (st));
return MATCH_ERROR;
}
@@ -2595,6 +2595,33 @@ match_exit_cycle (gfc_statement st, gfc_exec_op op)
if (cnt > 0
&& o != NULL
&& o->state == COMP_OMP_STRUCTURED_BLOCK
+ && (o->head->op == EXEC_OACC_LOOP
+ || o->head->op == EXEC_OACC_PARALLEL_LOOP))
+ {
+ int collapse = 1;
+ gcc_assert (o->head->next != NULL
+ && (o->head->next->op == EXEC_DO
+ || o->head->next->op == EXEC_DO_WHILE)
+ && o->previous != NULL
+ && o->previous->tail->op == o->head->op);
+ if (o->previous->tail->ext.omp_clauses != NULL
+ && o->previous->tail->ext.omp_clauses->collapse > 1)
+ collapse = o->previous->tail->ext.omp_clauses->collapse;
+ if (st == ST_EXIT && cnt <= collapse)
+ {
+ gfc_error ("EXIT statement at %C terminating !$ACC LOOP loop");
+ return MATCH_ERROR;
+ }
+ if (st == ST_CYCLE && cnt < collapse)
+ {
+ gfc_error ("CYCLE statement at %C to non-innermost collapsed"
+ " !$ACC LOOP loop");
+ return MATCH_ERROR;
+ }
+ }
+ if (cnt > 0
+ && o != NULL
+ && (o->state == COMP_OMP_STRUCTURED_BLOCK)
&& (o->head->op == EXEC_OMP_DO
|| o->head->op == EXEC_OMP_PARALLEL_DO))
{
diff --git a/gcc/fortran/match.h b/gcc/fortran/match.h
index 385e840..80ba44f 100644
--- a/gcc/fortran/match.h
+++ b/gcc/fortran/match.h
@@ -122,6 +122,21 @@ gfc_common_head *gfc_get_common (const char *, int);
/* openmp.c. */
+/* OpenACC directive matchers. */
+match gfc_match_oacc_cache (void);
+match gfc_match_oacc_wait (void);
+match gfc_match_oacc_update (void);
+match gfc_match_oacc_declare (void);
+match gfc_match_oacc_loop (void);
+match gfc_match_oacc_host_data (void);
+match gfc_match_oacc_data (void);
+match gfc_match_oacc_kernels (void);
+match gfc_match_oacc_kernels_loop (void);
+match gfc_match_oacc_parallel (void);
+match gfc_match_oacc_parallel_loop (void);
+match gfc_match_oacc_enter_data (void);
+match gfc_match_oacc_exit_data (void);
+
/* OpenMP directive matchers. */
match gfc_match_omp_eos (void);
match gfc_match_omp_atomic (void);
diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index d9af60e..65613d2 100644
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -532,6 +532,91 @@ decode_statement (void)
}
static gfc_statement
+decode_oacc_directive (void)
+{
+ locus old_locus;
+ char c;
+
+ gfc_enforce_clean_symbol_state ();
+
+ gfc_clear_error (); /* Clear any pending errors. */
+ gfc_clear_warning (); /* Clear any pending warnings. */
+
+ if (gfc_pure (NULL))
+ {
+ gfc_error_now ("OpenACC directives at %C may not appear in PURE "
+ "procedures");
+ gfc_error_recovery ();
+ return ST_NONE;
+ }
+
+ if (gfc_implicit_pure (NULL))
+ gfc_current_ns->proc_name->attr.implicit_pure = 0;
+
+ old_locus = gfc_current_locus;
+
+ /* General OpenACC directive matching: Instead of testing every possible
+ statement, we eliminate most possibilities by peeking at the
+ first character. */
+
+ c = gfc_peek_ascii_char ();
+
+ switch (c)
+ {
+ case 'c':
+ match ("cache", gfc_match_oacc_cache, ST_OACC_CACHE);
+ break;
+ case 'd':
+ match ("data", gfc_match_oacc_data, ST_OACC_DATA);
+ match ("declare", gfc_match_oacc_declare, ST_OACC_DECLARE);
+ break;
+ case 'e':
+ match ("end data", gfc_match_omp_eos, ST_OACC_END_DATA);
+ match ("end host_data", gfc_match_omp_eos, ST_OACC_END_HOST_DATA);
+ match ("end kernels loop", gfc_match_omp_eos, ST_OACC_END_KERNELS_LOOP);
+ match ("end kernels", gfc_match_omp_eos, ST_OACC_END_KERNELS);
+ match ("end loop", gfc_match_omp_eos, ST_OACC_END_LOOP);
+ match ("end parallel loop", gfc_match_omp_eos, ST_OACC_END_PARALLEL_LOOP);
+ match ("end parallel", gfc_match_omp_eos, ST_OACC_END_PARALLEL);
+ match ("enter data", gfc_match_oacc_enter_data, ST_OACC_ENTER_DATA);
+ match ("exit data", gfc_match_oacc_exit_data, ST_OACC_EXIT_DATA);
+ break;
+ case 'h':
+ match ("host_data", gfc_match_oacc_host_data, ST_OACC_HOST_DATA);
+ break;
+ case 'p':
+ match ("parallel loop", gfc_match_oacc_parallel_loop, ST_OACC_PARALLEL_LOOP);
+ match ("parallel", gfc_match_oacc_parallel, ST_OACC_PARALLEL);
+ break;
+ case 'k':
+ match ("kernels loop", gfc_match_oacc_kernels_loop, ST_OACC_KERNELS_LOOP);
+ match ("kernels", gfc_match_oacc_kernels, ST_OACC_KERNELS);
+ break;
+ case 'l':
+ match ("loop", gfc_match_oacc_loop, ST_OACC_LOOP);
+ break;
+ case 'u':
+ match ("update", gfc_match_oacc_update, ST_OACC_UPDATE);
+ break;
+ case 'w':
+ match ("wait", gfc_match_oacc_wait, ST_OACC_WAIT);
+ break;
+ }
+
+ /* Directive not found or stored an error message.
+ Check and give up. */
+
+ if (gfc_error_check () == 0)
+ gfc_error_now ("Unclassifiable OpenACC directive at %C");
+
+ reject_statement ();
+
+ gfc_error_recovery ();
+
+ return ST_NONE;
+}
+
+static gfc_statement
decode_omp_directive (void)
{
locus old_locus;
@@ -668,6 +753,23 @@ decode_gcc_attribute (void)
#undef match
+/* Assert next length characters to be equal to token in free form. */
+
+static void
+verify_token_free (const char* token, int length, bool last_was_use_stmt)
+{
+ int i;
+ char c;
+
+ c = gfc_next_ascii_char ();
+ for (i = 0; i < length; i++, c = gfc_next_ascii_char ())
+ gcc_assert (c == token[i]);
+
+ gcc_assert (gfc_is_whitespace(c));
+ gfc_gobble_whitespace ();
+ if (last_was_use_stmt)
+ use_modules ();
+}
/* Get the next statement in free form source. */
@@ -737,7 +839,7 @@ next_free (void)
else if (c == '!')
{
/* Comments have already been skipped by the time we get here,
- except for GCC attributes and OpenMP directives. */
+ except for GCC attributes and OpenMP/OpenACC directives. */
gfc_next_ascii_char (); /* Eat up the exclamation sign. */
c = gfc_peek_ascii_char ();
@@ -754,21 +856,38 @@ next_free (void)
return decode_gcc_attribute ();
}
- else if (c == '$' && gfc_option.gfc_flag_openmp)
+
+ else if (c == '$')
{
- int i;
-
- c = gfc_next_ascii_char ();
- for (i = 0; i < 4; i++, c = gfc_next_ascii_char ())
- gcc_assert (c == "$omp"[i]);
+ /* Since both OpenMP and OpenACC directives starts with
+ !$ character sequence, we must check all flags combinations */
+ if (gfc_option.gfc_flag_openmp && !gfc_option.gfc_flag_openacc)
+ {
+ verify_token_free ("$omp", 4, last_was_use_stmt);
+ return decode_omp_directive ();
+ }
+ else if (gfc_option.gfc_flag_openmp && gfc_option.gfc_flag_openacc)
+ {
+ gfc_next_ascii_char (); /* Eat up dollar character */
+ c = gfc_peek_ascii_char ();
- gcc_assert (c == ' ' || c == '\t');
- gfc_gobble_whitespace ();
- if (last_was_use_stmt)
- use_modules ();
- return decode_omp_directive ();
+ if (c == 'o')
+ {
+ verify_token_free ("omp", 3, last_was_use_stmt);
+ return decode_omp_directive ();
+ }
+ else if (c == 'a')
+ {
+ verify_token_free ("acc", 3, last_was_use_stmt);
+ return decode_oacc_directive ();
+ }
+ }
+ else if (gfc_option.gfc_flag_openacc)
+ {
+ verify_token_free ("$acc", 4, last_was_use_stmt);
+ return decode_oacc_directive ();
+ }
}
-
gcc_unreachable ();
}
@@ -784,6 +903,28 @@ next_free (void)
return decode_statement ();
}
+/* Assert next length characters to be equal to token in fixed form. */
+
+static bool
+verify_token_fixed (const char *token, int length, bool last_was_use_stmt)
+{
+ int i;
+ char c = gfc_next_char_literal (NONSTRING);
+
+ for (i = 0; i < length; i++, c = gfc_next_char_literal (NONSTRING))
+ gcc_assert ((char) gfc_wide_tolower (c) == token[i]);
+
+ if (c != ' ' && c != '0')
+ {
+ gfc_buffer_error (0);
+ gfc_error ("Bad continuation line at %C");
+ return false;
+ }
+ if (last_was_use_stmt)
+ use_modules ();
+
+ return true;
+}
/* Get the next statement in fixed-form source. */
@@ -843,21 +984,38 @@ next_fixed (void)
return decode_gcc_attribute ();
}
- else if (c == '$' && gfc_option.gfc_flag_openmp)
- {
- for (i = 0; i < 4; i++, c = gfc_next_char_literal (NONSTRING))
- gcc_assert ((char) gfc_wide_tolower (c) == "$omp"[i]);
-
- if (c != ' ' && c != '0')
- {
- gfc_buffer_error (0);
- gfc_error ("Bad continuation line at %C");
+ else if (c == '$')
+ {
+ if (gfc_option.gfc_flag_openmp && !gfc_option.gfc_flag_openacc)
+ {
+ if (!verify_token_fixed ("omp", 3, last_was_use_stmt))
+ return ST_NONE;
+ return decode_omp_directive ();
+ }
+ else if (gfc_option.gfc_flag_openmp
+ && gfc_option.gfc_flag_openacc)
+ {
+ c = gfc_next_char_literal(NONSTRING);
+ if (c == 'o' || c == 'O')
+ {
+ if (!verify_token_fixed ("mp", 2, last_was_use_stmt))
return ST_NONE;
- }
- if (last_was_use_stmt)
- use_modules ();
- return decode_omp_directive ();
- }
+ return decode_omp_directive ();
+ }
+ else if (c == 'a' || c == 'A')
+ {
+ if (!verify_token_fixed ("cc", 2, last_was_use_stmt))
+ return ST_NONE;
+ return decode_oacc_directive ();
+ }
+ }
+ else if (gfc_option.gfc_flag_openacc)
+ {
+ if (!verify_token_fixed ("acc", 3, last_was_use_stmt))
+ return ST_NONE;
+ return decode_oacc_directive ();
+ }
+ }
/* FALLTHROUGH */
/* Comments have already been skipped by the time we get
@@ -1015,7 +1173,9 @@ next_statement (void)
case ST_LABEL_ASSIGNMENT: case ST_FLUSH: case ST_OMP_FLUSH: \
case ST_OMP_BARRIER: case ST_OMP_TASKWAIT: case ST_OMP_TASKYIELD: \
case ST_ERROR_STOP: case ST_SYNC_ALL: case ST_SYNC_IMAGES: \
- case ST_SYNC_MEMORY: case ST_LOCK: case ST_UNLOCK
+ case ST_SYNC_MEMORY: case ST_LOCK: case ST_UNLOCK: case ST_OACC_UPDATE: \
+ case ST_OACC_WAIT: case ST_OACC_CACHE: case ST_OACC_ENTER_DATA: \
+ case ST_OACC_EXIT_DATA
/* Statements that mark other executable statements. */
@@ -1027,7 +1187,9 @@ next_statement (void)
case ST_OMP_CRITICAL: case ST_OMP_MASTER: case ST_OMP_SINGLE: \
case ST_OMP_DO: case ST_OMP_PARALLEL_DO: case ST_OMP_ATOMIC: \
case ST_OMP_WORKSHARE: case ST_OMP_PARALLEL_WORKSHARE: \
- case ST_OMP_TASK: case ST_CRITICAL
+ case ST_OMP_TASK: case ST_CRITICAL: \
+ case ST_OACC_PARALLEL_LOOP: case ST_OACC_PARALLEL: case ST_OACC_KERNELS: \
+ case ST_OACC_DATA: case ST_OACC_HOST_DATA: case ST_OACC_LOOP: case ST_OACC_KERNELS_LOOP
/* Declaration statements */
@@ -1054,6 +1216,8 @@ push_state (gfc_state_data *p, gfc_compile_state new_state, gfc_symbol *sym)
p->sym = sym;
p->head = p->tail = NULL;
p->do_variable = NULL;
+ if (p->state != COMP_DO && p->state != COMP_DO_CONCURRENT)
+ p->ext.oacc_declare_clauses = NULL;
/* If this the state of a construct like BLOCK, DO or IF, the corresponding
construct statement was accepted right before pushing the state. Thus,
@@ -1519,6 +1683,66 @@ gfc_ascii_statement (gfc_statement st)
case ST_END_ENUM:
p = "END ENUM";
break;
+ case ST_OACC_PARALLEL_LOOP:
+ p = "!$ACC PARALLEL LOOP";
+ break;
+ case ST_OACC_END_PARALLEL_LOOP:
+ p = "!$ACC END PARALLEL LOOP";
+ break;
+ case ST_OACC_PARALLEL:
+ p = "!$ACC PARALLEL";
+ break;
+ case ST_OACC_END_PARALLEL:
+ p = "!$ACC END PARALLEL";
+ break;
+ case ST_OACC_KERNELS:
+ p = "!$ACC KERNELS";
+ break;
+ case ST_OACC_END_KERNELS:
+ p = "!$ACC END KERNELS";
+ break;
+ case ST_OACC_KERNELS_LOOP:
+ p = "!$ACC KERNELS LOOP";
+ break;
+ case ST_OACC_END_KERNELS_LOOP:
+ p = "!$ACC END KERNELS LOOP";
+ break;
+ case ST_OACC_DATA:
+ p = "!$ACC DATA";
+ break;
+ case ST_OACC_END_DATA:
+ p = "!$ACC END DATA";
+ break;
+ case ST_OACC_HOST_DATA:
+ p = "!$ACC HOST_DATA";
+ break;
+ case ST_OACC_END_HOST_DATA:
+ p = "!$ACC END HOST_DATA";
+ break;
+ case ST_OACC_LOOP:
+ p = "!$ACC LOOP";
+ break;
+ case ST_OACC_END_LOOP:
+ p = "!$ACC END LOOP";
+ break;
+ case ST_OACC_DECLARE:
+ p = "!$ACC DECLARE";
+ break;
+ case ST_OACC_UPDATE:
+ p = "!$ACC UPDATE";
+ break;
+ case ST_OACC_WAIT:
+ p = "!$ACC WAIT";
+ break;
+ case ST_OACC_CACHE:
+ p = "!$ACC CACHE";
+ break;
+ case ST_OACC_ENTER_DATA:
+ p = "!$ACC ENTER DATA";
+ break;
+ case ST_OACC_EXIT_DATA:
+ p = "!$ACC EXIT DATA";
+ break;
case ST_OMP_ATOMIC:
p = "!$OMP ATOMIC";
break;
@@ -1883,6 +2107,7 @@ verify_st_order (st_state *p, gfc_statement st, bool silent)
case ST_PUBLIC:
case ST_PRIVATE:
case ST_DERIVED_DECL:
+ case ST_OACC_DECLARE:
case_decl:
if (p->state >= ORDER_EXEC)
goto order;
@@ -2784,6 +3009,19 @@ declSt:
st = next_statement ();
goto loop;
+ case ST_OACC_DECLARE:
+ if (!verify_st_order(&ss, st, false))
+ {
+ reject_statement ();
+ st = next_statement ();
+ goto loop;
+ }
+ if (gfc_state_stack->ext.oacc_declare_clauses == NULL)
+ gfc_state_stack->ext.oacc_declare_clauses = new_st.ext.omp_clauses;
+ accept_statement (st);
+ st = next_statement ();
+ goto loop;
+
default:
break;
}
@@ -3274,9 +3512,13 @@ static void
parse_critical_block (void)
{
gfc_code *top, *d;
- gfc_state_data s;
+ gfc_state_data s, *sd;
gfc_statement st;
+ for (sd = gfc_state_stack; sd; sd = sd->previous)
+ if (sd->state == COMP_OMP_STRUCTURED_BLOCK)
+ gfc_error_now ("CRITICAL block inside of OpenMP or OpenACC region at %C");
+
s.ext.end_do_label = new_st.label1;
accept_statement (ST_CRITICAL);
@@ -3643,6 +3885,128 @@ parse_omp_atomic (void)
}
+/* Parse the statements of an OpenACC structured block. */
+
+static void
+parse_oacc_structured_block (gfc_statement acc_st)
+{
+ gfc_statement st, acc_end_st;
+ gfc_code *cp, *np;
+ gfc_state_data s, *sd;
+
+ for (sd = gfc_state_stack; sd; sd = sd->previous)
+ if (sd->state == COMP_CRITICAL)
+ gfc_error_now ("OpenACC directive inside of CRITICAL block at %C");
+
+ accept_statement (acc_st);
+
+ cp = gfc_state_stack->tail;
+ push_state (&s, COMP_OMP_STRUCTURED_BLOCK, NULL);
+ np = new_level (cp);
+ np->op = cp->op;
+ np->block = NULL;
+ switch (acc_st)
+ {
+ case ST_OACC_PARALLEL:
+ acc_end_st = ST_OACC_END_PARALLEL;
+ break;
+ case ST_OACC_KERNELS:
+ acc_end_st = ST_OACC_END_KERNELS;
+ break;
+ case ST_OACC_DATA:
+ acc_end_st = ST_OACC_END_DATA;
+ break;
+ case ST_OACC_HOST_DATA:
+ acc_end_st = ST_OACC_END_HOST_DATA;
+ break;
+ default:
+ gcc_unreachable ();
+ }
+
+ do
+ {
+ st = parse_executable (ST_NONE);
+ if (st == ST_NONE)
+ unexpected_eof ();
+ else if (st != acc_end_st)
+ gfc_error ("Expecting %s at %C", gfc_ascii_statement (acc_end_st));
+ reject_statement ();
+ }
+ while (st != acc_end_st);
+
+ gcc_assert (new_st.op == EXEC_NOP);
+
+ gfc_clear_new_st ();
+ gfc_commit_symbols ();
+ gfc_warning_check ();
+ pop_state ();
+}
+
+/* Parse the statements of OpenACC loop/parallel loop/kernels loop. */
+
+static gfc_statement
+parse_oacc_loop (gfc_statement acc_st)
+{
+ gfc_statement st;
+ gfc_code *cp, *np;
+ gfc_state_data s, *sd;
+
+ for (sd = gfc_state_stack; sd; sd = sd->previous)
+ if (sd->state == COMP_CRITICAL)
+ gfc_error_now ("OpenACC directive inside of CRITICAL block at %C");
+
+ accept_statement (acc_st);
+
+ cp = gfc_state_stack->tail;
+ push_state (&s, COMP_OMP_STRUCTURED_BLOCK, NULL);
+ np = new_level (cp);
+ np->op = cp->op;
+ np->block = NULL;
+
+ for (;;)
+ {
+ st = next_statement ();
+ if (st == ST_NONE)
+ unexpected_eof ();
+ else if (st == ST_DO)
+ break;
+ else
+ {
+ gfc_error ("Expected DO loop at %C");
+ reject_statement ();
+ }
+ }
+
+ parse_do_block ();
+ if (gfc_statement_label != NULL
+ && gfc_state_stack->previous != NULL
+ && gfc_state_stack->previous->state == COMP_DO
+ && gfc_state_stack->previous->ext.end_do_label == gfc_statement_label)
+ {
+ pop_state ();
+ return ST_IMPLIED_ENDDO;
+ }
+
+ check_do_closure ();
+ pop_state ();
+
+ st = next_statement ();
+ if (st == ST_OACC_END_LOOP)
+ gfc_warning ("Redundant !$ACC END LOOP at %C");
+ if ((acc_st == ST_OACC_PARALLEL_LOOP && st == ST_OACC_END_PARALLEL_LOOP) ||
+ (acc_st == ST_OACC_KERNELS_LOOP && st == ST_OACC_END_KERNELS_LOOP) ||
+ (acc_st == ST_OACC_LOOP && st == ST_OACC_END_LOOP))
+ {
+ gcc_assert (new_st.op == EXEC_NOP);
+ gfc_clear_new_st ();
+ gfc_commit_symbols ();
+ gfc_warning_check ();
+ st = next_statement ();
+ }
+ return st;
+}
+
+
/* Parse the statements of an OpenMP structured block. */
static void
@@ -3910,6 +4274,21 @@ parse_executable (gfc_statement st)
parse_forall_block ();
break;
+ case ST_OACC_PARALLEL_LOOP:
+ case ST_OACC_KERNELS_LOOP:
+ case ST_OACC_LOOP:
+ st = parse_oacc_loop (st);
+ if (st == ST_IMPLIED_ENDDO)
+ return st;
+ continue;
+
+ case ST_OACC_PARALLEL:
+ case ST_OACC_KERNELS:
+ case ST_OACC_DATA:
+ case ST_OACC_HOST_DATA:
+ parse_oacc_structured_block (st);
+ break;
+
case ST_OMP_PARALLEL:
case ST_OMP_PARALLEL_SECTIONS:
case ST_OMP_SECTIONS:
@@ -4220,6 +4599,13 @@ contains:
done:
gfc_current_ns->code = gfc_state_stack->head;
+ if (gfc_state_stack->state == COMP_PROGRAM
+ || gfc_state_stack->state == COMP_MODULE
+ || gfc_state_stack->state == COMP_SUBROUTINE
+ || gfc_state_stack->state == COMP_FUNCTION
+ || gfc_state_stack->state == COMP_BLOCK)
+ gfc_current_ns->oacc_declare_clauses
+ = gfc_state_stack->ext.oacc_declare_clauses;
}
diff --git a/gcc/fortran/parse.h b/gcc/fortran/parse.h
index 44b8f8b..be09a97 100644
--- a/gcc/fortran/parse.h
+++ b/gcc/fortran/parse.h
@@ -49,6 +49,7 @@ typedef struct gfc_state_data
union
{
gfc_st_label *end_do_label;
+ gfc_omp_clauses *oacc_declare_clauses;
}
ext;
}
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 69ec7bf..46a121f 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -8982,6 +8982,18 @@ gfc_resolve_blocks (gfc_code *b, gfc_namespace *ns)
case EXEC_WAIT:
break;
+ case EXEC_OACC_PARALLEL_LOOP:
+ case EXEC_OACC_PARALLEL:
+ case EXEC_OACC_KERNELS_LOOP:
+ case EXEC_OACC_KERNELS:
+ case EXEC_OACC_DATA:
+ case EXEC_OACC_HOST_DATA:
+ case EXEC_OACC_LOOP:
+ case EXEC_OACC_UPDATE:
+ case EXEC_OACC_WAIT:
+ case EXEC_OACC_CACHE:
+ case EXEC_OACC_ENTER_DATA:
+ case EXEC_OACC_EXIT_DATA:
case EXEC_OMP_ATOMIC:
case EXEC_OMP_CRITICAL:
case EXEC_OMP_DO:
@@ -9731,6 +9743,15 @@ resolve_code (gfc_code *code, gfc_namespace *ns)
omp_workshare_save = -1;
switch (code->op)
{
+ case EXEC_OACC_PARALLEL_LOOP:
+ case EXEC_OACC_PARALLEL:
+ case EXEC_OACC_KERNELS_LOOP:
+ case EXEC_OACC_KERNELS:
+ case EXEC_OACC_DATA:
+ case EXEC_OACC_HOST_DATA:
+ case EXEC_OACC_LOOP:
+ gfc_resolve_oacc_blocks (code, ns);
+ break;
case EXEC_OMP_PARALLEL_WORKSHARE:
omp_workshare_save = omp_workshare_flag;
omp_workshare_flag = 1;
@@ -10057,6 +10078,21 @@ resolve_code (gfc_code *code, gfc_namespace *ns)
"expression", &code->expr1->where);
break;
+ case EXEC_OACC_PARALLEL_LOOP:
+ case EXEC_OACC_PARALLEL:
+ case EXEC_OACC_KERNELS_LOOP:
+ case EXEC_OACC_KERNELS:
+ case EXEC_OACC_DATA:
+ case EXEC_OACC_HOST_DATA:
+ case EXEC_OACC_LOOP:
+ case EXEC_OACC_UPDATE:
+ case EXEC_OACC_WAIT:
+ case EXEC_OACC_CACHE:
+ case EXEC_OACC_ENTER_DATA:
+ case EXEC_OACC_EXIT_DATA:
+ gfc_resolve_oacc_directive (code, ns);
+ break;
+
case EXEC_OMP_ATOMIC:
case EXEC_OMP_BARRIER:
case EXEC_OMP_CRITICAL:
@@ -14559,6 +14595,7 @@ resolve_codes (gfc_namespace *ns)
old_obstack = labels_obstack;
bitmap_obstack_initialize (&labels_obstack);
+ gfc_resolve_oacc_declare (ns);
resolve_code (ns->code, ns);
bitmap_obstack_release (&labels_obstack);
diff --git a/gcc/fortran/scanner.c b/gcc/fortran/scanner.c
index 8f51734..da5ce63 100644
--- a/gcc/fortran/scanner.c
+++ b/gcc/fortran/scanner.c
@@ -55,9 +55,11 @@ gfc_directorylist *include_dirs, *intrinsic_modules_dirs;
static gfc_file *file_head, *current_file;
-static int continue_flag, end_flag, openmp_flag, gcc_attribute_flag;
+static int continue_flag, end_flag, gcc_attribute_flag;
+static int openmp_flag, openacc_flag; /* If !$omp/!$acc occurred in current comment line */
static int continue_count, continue_line;
static locus openmp_locus;
+static locus openacc_locus;
static locus gcc_attribute_locus;
gfc_source_form gfc_current_form;
@@ -710,11 +712,89 @@ skip_gcc_attribute (locus start)
return r;
}
+/* Return true if CC was matched. */
+static bool
+skip_oacc_attribute (locus start, locus old_loc, bool continue_flag)
+{
+ bool r = false;
+ char c;
+
+ if ((c = next_char ()) == 'c' || c == 'C')
+ if ((c = next_char ()) == 'c' || c == 'C')
+ r = true;
+ if (r)
+ {
+ if ((c = next_char ()) == ' ' || c == '\t'
+ || continue_flag)
+ {
+ while (gfc_is_whitespace (c))
+ c = next_char ();
+ if (c != '\n' && c != '!')
+ {
+ openacc_flag = 1;
+ openacc_locus = old_loc;
+ gfc_current_locus = start;
+ }
+ else
+ r = false;
+ }
+ else
+ {
+ gfc_warning_now ("!$ACC at %C starts a commented "
+ "line as it neither is followed "
+ "by a space nor is a "
+ "continuation line");
+ r = false;
+ }
+ }
+
+ return r;
+}
+
+/* Return true if MP was matched. */
+static bool
+skip_omp_attribute (locus start, locus old_loc, bool continue_flag)
+{
+ bool r = false;
+ char c;
+
+ if ((c = next_char ()) == 'm' || c == 'M')
+ if ((c = next_char ()) == 'p' || c == 'P')
+ r = true;
+
+ if (r)
+ {
+ if ((c = next_char ()) == ' ' || c == '\t'
+ || continue_flag)
+ {
+ while (gfc_is_whitespace (c))
+ c = next_char ();
+ if (c != '\n' && c != '!')
+ {
+ openmp_flag = 1;
+ openmp_locus = old_loc;
+ gfc_current_locus = start;
+ }
+ else
+ r = false;
+ }
+ else
+ {
+ gfc_warning_now ("!$OMP at %C starts a commented "
+ "line as it neither is followed "
+ "by a space nor is a "
+ "continuation line");
+ r = false;
+ }
+ }
+
+ return r;
+}
/* Comment lines are null lines, lines containing only blanks or lines
on which the first nonblank line is a '!'.
- Return true if !$ openmp conditional compilation sentinel was
+ Return true if !$ openmp or openacc conditional compilation sentinel was
seen. */
static bool
@@ -747,55 +827,95 @@ skip_free_comments (void)
if (at_bol && skip_gcc_attribute (start))
return false;
- /* If -fopenmp, we need to handle here 2 things:
- 1) don't treat !$omp as comments, but directives
- 2) handle OpenMP conditional compilation, where
+ /* If -fopenmp/-fopenacc, we need to handle here 2 things:
+ 1) don't treat !$omp/!$acc as comments, but directives
+ 2) handle OpenMP/OpenACC conditional compilation, where
!$ should be treated as 2 spaces (for initial lines
only if followed by space). */
- if (gfc_option.gfc_flag_openmp && at_bol)
- {
- locus old_loc = gfc_current_locus;
- if (next_char () == '$')
- {
- c = next_char ();
- if (c == 'o' || c == 'O')
- {
- if (((c = next_char ()) == 'm' || c == 'M')
- && ((c = next_char ()) == 'p' || c == 'P'))
+ if (at_bol)
+ {
+ if (gfc_option.gfc_flag_openmp && gfc_option.gfc_flag_openacc)
+ {
+ locus old_loc = gfc_current_locus;
+ if (next_char () == '$')
+ {
+ c = next_char ();
+ if (c == 'o' || c == 'O')
+ {
+ if (skip_omp_attribute (start, old_loc, continue_flag))
+ return false;
+ gfc_current_locus = old_loc;
+ next_char ();
+ c = next_char ();
+ }
+ else if (c == 'a' || c == 'A')
+ {
+ if (skip_oacc_attribute (start, old_loc, continue_flag))
+ return false;
+ gfc_current_locus = old_loc;
+ next_char ();
+ c = next_char ();
+ }
+ if (continue_flag || c == ' ' || c == '\t')
+ {
+ gfc_current_locus = old_loc;
+ next_char ();
+ openmp_flag = openacc_flag = 0;
+ return true;
+ }
+ }
+ gfc_current_locus = old_loc;
+ }
+ else if (gfc_option.gfc_flag_openmp && !gfc_option.gfc_flag_openacc)
+ {
+ locus old_loc = gfc_current_locus;
+ if (next_char () == '$')
+ {
+ c = next_char ();
+ if (c == 'o' || c == 'O')
+ {
+ if (skip_omp_attribute (start, old_loc, continue_flag))
+ return false;
+ gfc_current_locus = old_loc;
+ next_char ();
+ c = next_char ();
+ }
+ if (continue_flag || c == ' ' || c == '\t')
+ {
+ gfc_current_locus = old_loc;
+ next_char ();
+ openmp_flag = 0;
+ return true;
+ }
+ }
+ gfc_current_locus = old_loc;
+ }
+ else if (gfc_option.gfc_flag_openacc && !gfc_option.gfc_flag_openmp)
+ {
+ locus old_loc = gfc_current_locus;
+ if (next_char() == '$')
+ {
+ c = next_char();
+ if (c == 'a' || c == 'A')
{
- if ((c = next_char ()) == ' ' || c == '\t'
- || continue_flag)
- {
- while (gfc_is_whitespace (c))
- c = next_char ();
- if (c != '\n' && c != '!')
- {
- openmp_flag = 1;
- openmp_locus = old_loc;
- gfc_current_locus = start;
- return false;
- }
- }
- else
- gfc_warning_now ("!$OMP at %C starts a commented "
- "line as it neither is followed "
- "by a space nor is a "
- "continuation line");
+ if (skip_oacc_attribute (start, old_loc,
+ continue_flag))
+ return false;
+ gfc_current_locus = old_loc;
+ next_char();
+ c = next_char();
}
- gfc_current_locus = old_loc;
- next_char ();
- c = next_char ();
- }
- if (continue_flag || c == ' ' || c == '\t')
- {
- gfc_current_locus = old_loc;
- next_char ();
- openmp_flag = 0;
- return true;
- }
- }
- gfc_current_locus = old_loc;
- }
+ if (continue_flag || c == ' ' || c == '\t')
+ {
+ gfc_current_locus = old_loc;
+ next_char();
+ openacc_flag = 0;
+ return true;
+ }
+ }
+ gfc_current_locus = old_loc;
+ }
+ }
skip_comment_line ();
continue;
}
@@ -806,6 +926,9 @@ skip_free_comments (void)
if (openmp_flag && at_bol)
openmp_flag = 0;
+ if (openacc_flag && at_bol)
+ openacc_flag = 0;
+
gcc_attribute_flag = 0;
gfc_current_locus = start;
return false;
@@ -868,9 +991,10 @@ skip_fixed_comments (void)
return;
}
- /* If -fopenmp, we need to handle here 2 things:
- 1) don't treat !$omp|c$omp|*$omp as comments, but directives
- 2) handle OpenMP conditional compilation, where
+ /* If -fopenmp/-fopenacc, we need to handle here 2 things:
+ 1) don't treat !$omp/!$acc|c$omp/c$acc|*$omp / *$acc as comments,
+ but directives
+ 2) handle OpenMP/OpenACC conditional compilation, where
!$|c$|*$ should be treated as 2 spaces if the characters
in columns 3 to 6 are valid fixed form label columns
characters. */
@@ -937,6 +1061,67 @@ skip_fixed_comments (void)
}
gfc_current_locus = start;
}
+
+ if (gfc_option.gfc_flag_openacc)
+ {
+ if (next_char () == '$')
+ {
+ c = next_char ();
+ if (c == 'a' || c == 'A')
+ {
+ if (((c = next_char ()) == 'c' || c == 'C')
+ && ((c = next_char ()) == 'c' || c == 'C'))
+ {
+ c = next_char ();
+ if (c != '\n'
+ && ((openacc_flag && continue_flag)
+ || c == ' ' || c == '\t' || c == '0'))
+ {
+ do
+ c = next_char ();
+ while (gfc_is_whitespace (c));
+ if (c != '\n' && c != '!')
+ {
+ /* Canonicalize to *$acc. */
+ *start.nextc = '*';
+ openacc_flag = 1;
+ gfc_current_locus = start;
+ return;
+ }
+ }
+ }
+ }
+ else
+ {
+ int digit_seen = 0;
+
+ for (col = 3; col < 6; col++, c = next_char ())
+ if (c == ' ')
+ continue;
+ else if (c == '\t')
+ {
+ col = 6;
+ break;
+ }
+ else if (c < '0' || c > '9')
+ break;
+ else
+ digit_seen = 1;
+
+ if (col == 6 && c != '\n'
+ && ((continue_flag && !digit_seen)
+ || c == ' ' || c == '\t' || c == '0'))
+ {
+ gfc_current_locus = start;
+ start.nextc[0] = ' ';
+ start.nextc[1] = ' ';
+ continue;
+ }
+ }
+ }
+ gfc_current_locus = start;
+ }
+
skip_comment_line ();
continue;
}
@@ -1007,10 +1192,11 @@ gfc_char_t
gfc_next_char_literal (gfc_instring in_string)
{
locus old_loc;
- int i, prev_openmp_flag;
+ int i, prev_openmp_flag, prev_openacc_flag;
gfc_char_t c;
continue_flag = 0;
+ prev_openacc_flag = prev_openmp_flag = 0;
restart:
c = next_char ();
@@ -1036,6 +1222,11 @@ restart:
sizeof (gfc_current_locus)) == 0)
goto done;
+ if (openacc_flag
+ && memcmp (&gfc_current_locus, &openacc_locus,
+ sizeof (gfc_current_locus)) == 0)
+ goto done;
+
/* This line can't be continued */
do
{
@@ -1090,7 +1281,11 @@ restart:
goto done;
}
- prev_openmp_flag = openmp_flag;
+ if (gfc_option.gfc_flag_openmp)
+ prev_openmp_flag = openmp_flag;
+ if (gfc_option.gfc_flag_openacc)
+ prev_openacc_flag = openacc_flag;
+
continue_flag = 1;
if (c == '!')
skip_comment_line ();
@@ -1120,13 +1315,23 @@ restart:
&& continue_line < gfc_linebuf_linenum (gfc_current_locus.lb))
continue_line = gfc_linebuf_linenum (gfc_current_locus.lb);
- if (prev_openmp_flag != openmp_flag)
- {
- gfc_current_locus = old_loc;
- openmp_flag = prev_openmp_flag;
- c = '&';
- goto done;
- }
+ if (gfc_option.gfc_flag_openmp)
+ if (prev_openmp_flag != openmp_flag)
+ {
+ gfc_current_locus = old_loc;
+ openmp_flag = prev_openmp_flag;
+ c = '&';
+ goto done;
+ }
+
+ if (gfc_option.gfc_flag_openacc)
+ if (prev_openacc_flag != openacc_flag)
+ {
+ gfc_current_locus = old_loc;
+ openacc_flag = prev_openacc_flag;
+ c = '&';
+ goto done;
+ }
/* Now that we have a non-comment line, probe ahead for the
first non-whitespace character. If it is another '&', then
@@ -1150,6 +1355,17 @@ restart:
while (gfc_is_whitespace (c))
c = next_char ();
}
+ if (openacc_flag)
+ {
+ for (i = 0; i < 5; i++, c = next_char ())
+ {
+ gcc_assert(gfc_wide_tolower (c) == (unsigned char) "!$acc"[i]);
+ if (i == 4)
+ old_loc = gfc_current_locus;
+ }
+ while (gfc_is_whitespace (c))
+ c = next_char ();
+ }
if (c != '&')
{
@@ -1162,7 +1378,7 @@ restart:
}
/* Both !$omp and !$ -fopenmp continuation lines have & on the
continuation line only optionally. */
- else if (openmp_flag || openmp_cond_flag)
+ else if (openmp_flag || openacc_flag || openmp_cond_flag)
gfc_current_locus.nextc--;
else
{
@@ -1199,7 +1415,11 @@ restart:
gfc_warning_now ("Line truncated at %L", &gfc_current_locus);
}
- prev_openmp_flag = openmp_flag;
+ if (gfc_option.gfc_flag_openmp)
+ prev_openmp_flag = openmp_flag;
+ if (gfc_option.gfc_flag_openacc)
+ prev_openacc_flag = openacc_flag;
+
continue_flag = 1;
old_loc = gfc_current_locus;
@@ -1207,26 +1427,40 @@ restart:
skip_fixed_comments ();
/* See if this line is a continuation line. */
- if (openmp_flag != prev_openmp_flag)
- {
- openmp_flag = prev_openmp_flag;
- goto not_continuation;
- }
+ if (gfc_option.gfc_flag_openmp)
+ if (openmp_flag != prev_openmp_flag)
+ {
+ openmp_flag = prev_openmp_flag;
+ goto not_continuation;
+ }
+ if (gfc_option.gfc_flag_openacc)
+ if (openacc_flag != prev_openacc_flag)
+ {
+ openacc_flag = prev_openacc_flag;
+ goto not_continuation;
+ }
- if (!openmp_flag)
+ if (!openmp_flag && !openacc_flag)
for (i = 0; i < 5; i++)
{
c = next_char ();
if (c != ' ')
goto not_continuation;
}
- else
+ else if (openmp_flag)
for (i = 0; i < 5; i++)
{
c = next_char ();
if (gfc_wide_tolower (c) != (unsigned char) "*$omp"[i])
goto not_continuation;
}
+ else if (openacc_flag)
+ for (i = 0; i > 5; i++)
+ {
+ c = next_char ();
+ if (gfc_wide_tolower (c) != (unsigned char) "*$omp"[i])
+ goto not_continuation;
+ }
c = next_char ();
if (c == '0' || c == ' ' || c == '\n')
diff --git a/gcc/fortran/st.c b/gcc/fortran/st.c
index 0e1cc70..b582efe 100644
--- a/gcc/fortran/st.c
+++ b/gcc/fortran/st.c
@@ -185,6 +185,18 @@ gfc_free_statement (gfc_code *p)
gfc_free_forall_iterator (p->ext.forall_iterator);
break;
+ case EXEC_OACC_PARALLEL_LOOP:
+ case EXEC_OACC_PARALLEL:
+ case EXEC_OACC_KERNELS_LOOP:
+ case EXEC_OACC_KERNELS:
+ case EXEC_OACC_DATA:
+ case EXEC_OACC_HOST_DATA:
+ case EXEC_OACC_LOOP:
+ case EXEC_OACC_UPDATE:
+ case EXEC_OACC_WAIT:
+ case EXEC_OACC_CACHE:
+ case EXEC_OACC_ENTER_DATA:
+ case EXEC_OACC_EXIT_DATA:
case EXEC_OMP_DO:
case EXEC_OMP_END_SINGLE:
case EXEC_OMP_PARALLEL:
--
1.8.3.2
^ permalink raw reply [flat|nested] 89+ messages in thread
* Re: [PATCH 3/4] [GOMP4] [Fortran] OpenACC 1.0+ support in fortran front-end
2014-03-07 10:46 ` [PATCH 2/4] " Ilmir Usmanov
@ 2014-03-07 10:46 ` Ilmir Usmanov
2014-03-07 10:47 ` [PATCH 4/4] " Ilmir Usmanov
2014-03-08 17:19 ` [PATCH 3/4] " Tobias Burnus
2014-03-08 19:55 ` [PATCH 2/4] " Tobias Burnus
1 sibling, 2 replies; 89+ messages in thread
From: Ilmir Usmanov @ 2014-03-07 10:46 UTC (permalink / raw)
To: Tobias Burnus
Cc: Thomas Schwinge, Evgeny Gavrin, GarbuzovViacheslav,
Dmitri Botcharnikov, gcc-patches, jakub, fortran
[-- Attachment #1: Type: text/plain, Size: 909 bytes --]
OpenACC 1.0 fortran FE support -- translation to GENERIC.
gcc/fortran/
* trans-decl.c
(gfc_generate_function_code): Insert OACC_DECLARE GENERIC node.
* trans-openmp.c (gfc_convert_expr_to_tree): New helper function.
(gfc_trans_omp_array_reduction): Support also OpenACC. Add parameter.
(gfc_trans_omp_reduction_list): Update.
(gfc_trans_oacc_construct): New transform function.
(gfc_trans_omp_map_clause_list): Likewise.
(gfc_trans_oacc_executable_directive): Likewise.
(gfc_trans_oacc_combined_directive, gfc_trans_oacc_declare): Likewise.
(gfc_trans_oacc_directive): Use them.
(gfc_trans_oacc_loop): Stub.
(gfc_trans_omp_clauses): Transform OpenACC clauses.
* trans-stmt.h (gfc_trans_oacc_directive): New function prototype.
(gfc_trans_oacc_declare): Likewise.
* trans.c (trans_code): Transform also OpenACC directives.
[-- Attachment #2: 0003-OpenACC-Fortran-FE-part-3.patch --]
[-- Type: text/x-diff, Size: 15179 bytes --]
From 70dca7f32b50e762f1295a2054bb484ef7fbb42e Mon Sep 17 00:00:00 2001
From: Ilmir Usmanov <i.usmanov@samsung.com>
Date: Fri, 7 Mar 2014 14:33:47 +0400
Subject: [PATCH 3/4] OpenACC Fortran FE -- part 3
---
gcc/fortran/trans-decl.c | 7 +
gcc/fortran/trans-openmp.c | 357 +++++++++++++++++++++++++++++++++++++++++++++
gcc/fortran/trans-stmt.c | 8 +
gcc/fortran/trans-stmt.h | 4 +
gcc/fortran/trans.c | 15 ++
5 files changed, 391 insertions(+)
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 9c86653..ad26ef8 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -5606,6 +5606,13 @@ gfc_generate_function_code (gfc_namespace * ns)
if ((gfc_option.rtcheck & GFC_RTCHECK_BOUNDS) && !sym->attr.is_bind_c)
add_argument_checking (&body, sym);
+ /* Generate !$ACC DECLARE directive. */
+ if (ns->oacc_declare_clauses)
+ {
+ tree tmp = gfc_trans_oacc_declare (&body, ns);
+ gfc_add_expr_to_block (&body, tmp);
+ }
+
tmp = gfc_trans_code (ns->code);
gfc_add_expr_to_block (&body, tmp);
diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
index 41020a8..a1abd66 100644
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -767,6 +767,40 @@ gfc_trans_omp_reduction_list (gfc_namelist *namelist, tree list,
}
static tree
+gfc_trans_omp_map_clause_list (enum omp_clause_map_kind kind,
+ gfc_namelist *namelist, tree list)
+{
+ for (; namelist != NULL; namelist = namelist->next)
+ if (namelist->sym->attr.referenced)
+ {
+ tree t = gfc_trans_omp_variable (namelist->sym);
+ if (t != error_mark_node)
+ {
+ tree node = build_omp_clause (input_location, OMP_CLAUSE_MAP);
+ OMP_CLAUSE_DECL (node) = t;
+ OMP_CLAUSE_MAP_KIND (node) = kind;
+ list = gfc_trans_add_clause (node, list);
+ }
+ }
+ return list;
+}
+
+static inline tree
+gfc_convert_expr_to_tree (stmtblock_t *block, gfc_expr *expr)
+{
+ gfc_se se;
+ tree result;
+
+ gfc_init_se (&se, NULL );
+ gfc_conv_expr (&se, expr);
+ gfc_add_block_to_block (block, &se.pre);
+ result = gfc_evaluate_now (se.expr, block);
+ gfc_add_block_to_block (block, &se.post);
+
+ return result;
+}
+
+static tree
gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
locus where)
{
@@ -834,6 +868,51 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
where);
continue;
}
+ if (list >= OMP_LIST_DATA_CLAUSE_FIRST
+ && list <= OMP_LIST_DATA_CLAUSE_LAST)
+ {
+ enum omp_clause_map_kind kind;
+ switch (list)
+ {
+ case OMP_LIST_COPY:
+ kind = OMP_CLAUSE_MAP_FORCE_TOFROM;
+ break;
+ case OMP_LIST_OACC_COPYIN:
+ kind = OMP_CLAUSE_MAP_FORCE_TO;
+ break;
+ case OMP_LIST_COPYOUT:
+ kind = OMP_CLAUSE_MAP_FORCE_FROM;
+ break;
+ case OMP_LIST_CREATE:
+ kind = OMP_CLAUSE_MAP_FORCE_ALLOC;
+ break;
+ case OMP_LIST_DELETE:
+ kind = OMP_CLAUSE_MAP_FORCE_DEALLOC;
+ break;
+ case OMP_LIST_PRESENT:
+ kind = OMP_CLAUSE_MAP_FORCE_PRESENT;
+ break;
+ case OMP_LIST_PRESENT_OR_COPY:
+ kind = OMP_CLAUSE_MAP_TOFROM;
+ break;
+ case OMP_LIST_PRESENT_OR_COPYIN:
+ kind = OMP_CLAUSE_MAP_TO;
+ break;
+ case OMP_LIST_PRESENT_OR_COPYOUT:
+ kind = OMP_CLAUSE_MAP_FROM;
+ break;
+ case OMP_LIST_PRESENT_OR_CREATE:
+ kind = OMP_CLAUSE_MAP_ALLOC;
+ break;
+ case OMP_LIST_DEVICEPTR:
+ kind = OMP_CLAUSE_MAP_FORCE_DEVICEPTR;
+ break;
+ default:
+ gcc_unreachable ();
+ }
+ omp_clauses = gfc_trans_omp_map_clause_list (kind, n, omp_clauses);
+ continue;
+ }
switch (list)
{
case OMP_LIST_PRIVATE:
@@ -853,6 +932,21 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
goto add_clause;
case OMP_LIST_COPYPRIVATE:
clause_code = OMP_CLAUSE_COPYPRIVATE;
+ goto add_clause;
+ case OMP_LIST_USE_DEVICE:
+ clause_code = OMP_CLAUSE_USE_DEVICE;
+ goto add_clause;
+ case OMP_LIST_DEVICE_RESIDENT:
+ clause_code = OMP_CLAUSE_DEVICE_RESIDENT;
+ goto add_clause;
+ case OMP_LIST_HOST:
+ clause_code = OMP_CLAUSE_HOST;
+ goto add_clause;
+ case OMP_LIST_DEVICE:
+ clause_code = OMP_CLAUSE_OACC_DEVICE;
+ goto add_clause;
+ case OMP_LIST_CACHE:
+ clause_code = OMP_NO_CLAUSE_CACHE;
/* FALLTHROUGH */
add_clause:
omp_clauses
@@ -1000,6 +1094,107 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
omp_clauses = gfc_trans_add_clause (c, omp_clauses);
}
+ if (clauses->async)
+ {
+ c = build_omp_clause (where.lb->location, OMP_CLAUSE_ASYNC);
+ if (clauses->async_expr)
+ OMP_CLAUSE_ASYNC_EXPR (c) =
+ gfc_convert_expr_to_tree (block, clauses->async_expr);
+ else
+ OMP_CLAUSE_ASYNC_EXPR (c) = NULL;
+ omp_clauses = gfc_trans_add_clause (c, omp_clauses);
+ }
+ if (clauses->seq)
+ {
+ c = build_omp_clause (where.lb->location, OMP_CLAUSE_ORDERED);
+ omp_clauses = gfc_trans_add_clause (c, omp_clauses);
+ }
+ if (clauses->independent)
+ {
+ c = build_omp_clause (where.lb->location, OMP_CLAUSE_INDEPENDENT);
+ omp_clauses = gfc_trans_add_clause (c, omp_clauses);
+ }
+ if (clauses->num_gangs_expr)
+ {
+ tree num_gangs_var =
+ gfc_convert_expr_to_tree (block, clauses->num_gangs_expr);
+ c = build_omp_clause (where.lb->location, OMP_CLAUSE_NUM_GANGS);
+ OMP_CLAUSE_NUM_GANGS_EXPR (c) = num_gangs_var;
+ omp_clauses = gfc_trans_add_clause (c, omp_clauses);
+ }
+ if (clauses->num_workers_expr)
+ {
+ tree num_workers_var =
+ gfc_convert_expr_to_tree (block, clauses->num_workers_expr);
+ c = build_omp_clause (where.lb->location, OMP_CLAUSE_NUM_WORKERS);
+ OMP_CLAUSE_NUM_WORKERS_EXPR (c)= num_workers_var;
+ omp_clauses = gfc_trans_add_clause (c, omp_clauses);
+ }
+ if (clauses->vector_length_expr)
+ {
+ tree vector_length_var =
+ gfc_convert_expr_to_tree (block, clauses->vector_length_expr);
+ c = build_omp_clause (where.lb->location, OMP_CLAUSE_VECTOR_LENGTH);
+ OMP_CLAUSE_VECTOR_LENGTH_EXPR (c)= vector_length_var;
+ omp_clauses = gfc_trans_add_clause (c, omp_clauses);
+ }
+ if (clauses->vector)
+ {
+ if (clauses->vector_expr)
+ {
+ tree vector_var =
+ gfc_convert_expr_to_tree (block, clauses->vector_expr);
+ c = build_omp_clause (where.lb->location, OMP_CLAUSE_VECTOR);
+ OMP_CLAUSE_VECTOR_EXPR (c)= vector_var;
+ omp_clauses = gfc_trans_add_clause (c, omp_clauses);
+ }
+ else
+ {
+ c = build_omp_clause (where.lb->location, OMP_CLAUSE_VECTOR);
+ omp_clauses = gfc_trans_add_clause (c, omp_clauses);
+ }
+ }
+ if (clauses->worker)
+ {
+ if (clauses->worker_expr)
+ {
+ tree worker_var =
+ gfc_convert_expr_to_tree (block, clauses->worker_expr);
+ c = build_omp_clause (where.lb->location, OMP_CLAUSE_WORKER);
+ OMP_CLAUSE_WORKER_EXPR (c)= worker_var;
+ omp_clauses = gfc_trans_add_clause (c, omp_clauses);
+ }
+ else
+ {
+ c = build_omp_clause (where.lb->location, OMP_CLAUSE_WORKER);
+ omp_clauses = gfc_trans_add_clause (c, omp_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);
+ OMP_CLAUSE_GANG_EXPR (c)= gang_var;
+ omp_clauses = gfc_trans_add_clause (c, omp_clauses);
+ }
+ else
+ {
+ c = build_omp_clause (where.lb->location, OMP_CLAUSE_GANG);
+ omp_clauses = gfc_trans_add_clause (c, omp_clauses);
+ }
+ }
+ if (clauses->non_clause_wait_expr)
+ {
+ tree wait_var =
+ gfc_convert_expr_to_tree (block, clauses->non_clause_wait_expr);
+ c = build_omp_clause (where.lb->location, OMP_CLAUSE_WAIT);
+ OMP_WAIT_EXPR (c)= wait_var;
+ omp_clauses = gfc_trans_add_clause (c, omp_clauses);
+ }
+
return omp_clauses;
}
@@ -1027,6 +1222,80 @@ gfc_trans_omp_code (gfc_code *code, bool force_empty)
return stmt;
}
+/* Trans OpenACC directives. */
+/* parallel, kernels, data and host_data. */
+static tree
+gfc_trans_oacc_construct (gfc_code *code)
+{
+ stmtblock_t block;
+ tree stmt, oacc_clauses;
+ enum tree_code construct_code;
+
+ switch (code->op)
+ {
+ case EXEC_OACC_PARALLEL:
+ construct_code = OACC_PARALLEL;
+ break;
+ case EXEC_OACC_KERNELS:
+ construct_code = OACC_KERNELS;
+ break;
+ case EXEC_OACC_DATA:
+ construct_code = OACC_DATA;
+ break;
+ case EXEC_OACC_HOST_DATA:
+ construct_code = OACC_HOST_DATA;
+ break;
+ default:
+ gcc_unreachable ();
+ }
+
+ gfc_start_block (&block);
+ oacc_clauses = gfc_trans_omp_clauses (&block, code->ext.omp_clauses,
+ code->loc);
+ stmt = gfc_trans_omp_code (code->block->next, true);
+ stmt = build2_loc (input_location, construct_code, void_type_node, stmt,
+ oacc_clauses);
+ gfc_add_expr_to_block (&block, stmt);
+ return gfc_finish_block (&block);
+}
+
+/* update, enter_data, exit_data, wait, cache. */
+static tree
+gfc_trans_oacc_executable_directive (gfc_code *code)
+{
+ stmtblock_t block;
+ tree stmt, oacc_clauses;
+ enum tree_code construct_code;
+
+ switch (code->op)
+ {
+ case EXEC_OACC_UPDATE:
+ construct_code = OACC_UPDATE;
+ break;
+ case EXEC_OACC_ENTER_DATA:
+ construct_code = OACC_ENTER_DATA;
+ break;
+ case EXEC_OACC_EXIT_DATA:
+ construct_code = OACC_EXIT_DATA;
+ break;
+ case EXEC_OACC_WAIT:
+ construct_code = OACC_WAIT;
+ break;
+ case EXEC_OACC_CACHE:
+ construct_code = OACC_CACHE;
+ break;
+ default:
+ gcc_unreachable ();
+ }
+
+ gfc_start_block (&block);
+ oacc_clauses = gfc_trans_omp_clauses (&block, code->ext.omp_clauses,
+ code->loc);
+ stmt = build1_loc (input_location, construct_code, void_type_node,
+ oacc_clauses);
+ gfc_add_expr_to_block (&block, stmt);
+ return gfc_finish_block (&block);
+}
static tree gfc_trans_omp_sections (gfc_code *, gfc_omp_clauses *);
static tree gfc_trans_omp_workshare (gfc_code *, gfc_omp_clauses *);
@@ -1302,6 +1571,57 @@ typedef struct dovar_init_d {
tree init;
} dovar_init;
+/* parallel loop and kernels loop. */
+static tree
+gfc_trans_oacc_combined_directive (gfc_code *code)
+{
+ stmtblock_t block;
+ gfc_omp_clauses construct_clauses, loop_clauses;
+ tree stmt, oacc_clauses = NULL_TREE;
+ enum tree_code construct_code;
+
+ switch (code->op)
+ {
+ case EXEC_OACC_PARALLEL_LOOP:
+ construct_code = OACC_PARALLEL;
+ break;
+ case EXEC_OACC_KERNELS_LOOP:
+ construct_code = OACC_KERNELS;
+ break;
+ default:
+ gcc_unreachable ();
+ }
+
+ gfc_start_block (&block);
+
+ memset (&loop_clauses, 0, sizeof (loop_clauses));
+ if (code->ext.omp_clauses != NULL)
+ {
+ memcpy (&construct_clauses, code->ext.omp_clauses,
+ sizeof (construct_clauses));
+ loop_clauses.collapse = construct_clauses.collapse;
+ loop_clauses.gang = construct_clauses.gang;
+ loop_clauses.vector = construct_clauses.vector;
+ loop_clauses.worker = construct_clauses.worker;
+ loop_clauses.seq = construct_clauses.seq;
+ loop_clauses.independent = construct_clauses.independent;
+ construct_clauses.collapse = 0;
+ construct_clauses.gang = false;
+ construct_clauses.vector = false;
+ construct_clauses.worker = false;
+ construct_clauses.seq = false;
+ construct_clauses.independent = false;
+ oacc_clauses = gfc_trans_omp_clauses (&block, &construct_clauses,
+ code->loc);
+ }
+
+ gfc_error ("!$ACC LOOP directive not implemented yet %L", &code->loc);
+ stmt = gfc_trans_omp_code (code->block->next, true);
+ stmt = build2_loc (input_location, construct_code, void_type_node, stmt,
+ oacc_clauses);
+ gfc_add_expr_to_block (&block, stmt);
+ return gfc_finish_block (&block);
+}
static tree
gfc_trans_omp_do (gfc_code *code, stmtblock_t *pblock,
@@ -1915,6 +2235,43 @@ gfc_trans_omp_workshare (gfc_code *code, gfc_omp_clauses *clauses)
}
tree
+gfc_trans_oacc_declare (stmtblock_t *block, gfc_namespace *ns)
+{
+ tree oacc_clauses;
+ oacc_clauses = gfc_trans_omp_clauses (block, ns->oacc_declare_clauses,
+ ns->oacc_declare_clauses->ext.loc);
+ return build1_loc (ns->oacc_declare_clauses->ext.loc.lb->location,
+ OACC_DECLARE, void_type_node, oacc_clauses);
+}
+
+tree
+gfc_trans_oacc_directive (gfc_code *code)
+{
+ switch (code->op)
+ {
+ case EXEC_OACC_PARALLEL_LOOP:
+ case EXEC_OACC_KERNELS_LOOP:
+ return gfc_trans_oacc_combined_directive (code);
+ case EXEC_OACC_PARALLEL:
+ case EXEC_OACC_KERNELS:
+ case EXEC_OACC_DATA:
+ case EXEC_OACC_HOST_DATA:
+ return gfc_trans_oacc_construct (code);
+ case EXEC_OACC_LOOP:
+ gfc_error ("!$ACC LOOP directive not implemented yet %L", &code->loc);
+ return NULL_TREE;
+ case EXEC_OACC_UPDATE:
+ case EXEC_OACC_WAIT:
+ case EXEC_OACC_CACHE:
+ case EXEC_OACC_ENTER_DATA:
+ case EXEC_OACC_EXIT_DATA:
+ return gfc_trans_oacc_executable_directive (code);
+ default:
+ gcc_unreachable ();
+ }
+}
+
+tree
gfc_trans_omp_directive (gfc_code *code)
{
switch (code->op)
diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index 19e29a7..9b3113a 100644
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -1352,6 +1352,14 @@ gfc_trans_block_construct (gfc_code* code)
gfc_init_block (&body);
exit_label = gfc_build_label_decl (NULL_TREE);
code->exit_label = exit_label;
+
+ /* Generate !$ACC DECLARE directive. */
+ if (ns->oacc_declare_clauses)
+ {
+ tree tmp = gfc_trans_oacc_declare (&body, ns);
+ gfc_add_expr_to_block (&body, tmp);
+ }
+
gfc_add_expr_to_block (&body, gfc_trans_code (ns->code));
gfc_add_expr_to_block (&body, build1_v (LABEL_EXPR, exit_label));
diff --git a/gcc/fortran/trans-stmt.h b/gcc/fortran/trans-stmt.h
index 8a57be4..ad3a5e6 100644
--- a/gcc/fortran/trans-stmt.h
+++ b/gcc/fortran/trans-stmt.h
@@ -64,6 +64,10 @@ tree gfc_trans_deallocate_array (tree);
/* trans-openmp.c */
tree gfc_trans_omp_directive (gfc_code *);
+/* trans-openacc.c */
+tree gfc_trans_oacc_directive (gfc_code *);
+tree gfc_trans_oacc_declare (stmtblock_t *block, gfc_namespace *);
+
/* trans-io.c */
tree gfc_trans_open (gfc_code *);
tree gfc_trans_close (gfc_code *);
diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c
index c5b3b9e..78b48d4 100644
--- a/gcc/fortran/trans.c
+++ b/gcc/fortran/trans.c
@@ -1850,6 +1850,21 @@ trans_code (gfc_code * code, tree cond)
res = gfc_trans_omp_directive (code);
break;
+ case EXEC_OACC_CACHE:
+ case EXEC_OACC_WAIT:
+ case EXEC_OACC_UPDATE:
+ case EXEC_OACC_LOOP:
+ case EXEC_OACC_HOST_DATA:
+ case EXEC_OACC_DATA:
+ case EXEC_OACC_KERNELS:
+ case EXEC_OACC_KERNELS_LOOP:
+ case EXEC_OACC_PARALLEL:
+ case EXEC_OACC_PARALLEL_LOOP:
+ case EXEC_OACC_ENTER_DATA:
+ case EXEC_OACC_EXIT_DATA:
+ res = gfc_trans_oacc_directive (code);
+ break;
+
default:
internal_error ("gfc_trans_code(): Bad statement code");
}
--
1.8.3.2
^ permalink raw reply [flat|nested] 89+ messages in thread
* Re: [PATCH 2/4] [GOMP4] [Fortran] OpenACC 1.0+ support in fortran front-end
2014-03-07 10:45 ` Ilmir Usmanov
@ 2014-03-07 10:46 ` Ilmir Usmanov
2014-03-07 10:46 ` [PATCH 3/4] " Ilmir Usmanov
2014-03-08 19:55 ` [PATCH 2/4] " Tobias Burnus
2014-03-12 18:27 ` [PATCH 1/4] " Tobias Burnus
1 sibling, 2 replies; 89+ messages in thread
From: Ilmir Usmanov @ 2014-03-07 10:46 UTC (permalink / raw)
To: Tobias Burnus
Cc: Thomas Schwinge, Evgeny Gavrin, GarbuzovViacheslav,
Dmitri Botcharnikov, gcc-patches, jakub, fortran
[-- Attachment #1: Type: text/plain, Size: 2450 bytes --]
OpenACC 1.0 fortran FE support -- matching and resolving.
* gcc/fortran/openmp.c
(gfc_free_omp_clauses): Remove also OpenACC clauses.
(gfc_free_expr_list): New function to clear expression list.
(match_oacc_expr_list): New function to match expression list.
(match_oacc_clause_gang): New function to match OpenACC 2.0 gang
clauses.
(OMP_CLAUSE_ASYNC, OMP_CLAUSE_NUM_GANGS,
OMP_CLAUSE_NUM_WORKERS, OMP_CLAUSE_VECTOR_LENGTH,
OMP_CLAUSE_COPY, OMP_CLAUSE_OACC_COPYIN,
OMP_CLAUSE_COPYOUT, OMP_CLAUSE_CREATE, OMP_CLAUSE_PRESENT,
OMP_CLAUSE_PRESENT_OR_COPY, OMP_CLAUSE_PRESENT_OR_COPYIN,
OMP_CLAUSE_PRESENT_OR_COPYOUT, OMP_CLAUSE_PRESENT_OR_CREATE,
OMP_CLAUSE_DEVICEPTR, OMP_CLAUSE_GANG, OMP_CLAUSE_WORKER,
OMP_CLAUSE_VECTOR, OMP_CLAUSE_SEQ, OMP_CLAUSE_INDEPENDENT,
OMP_CLAUSE_USE_DEVICE, OMP_CLAUSE_HOST, OMP_CLAUSE_DEVICE_RESIDENT,
OMP_CLAUSE_DEVICE, OMP_CLAUSE_DEFAULT, OMP_CLAUSE_WAIT,
OMP_CLAUSE_DELETE, OMP_CLAUSE_AUTO, OMP_CLAUSE_TILE): New clauses.
(OACC_PARALLEL_CLAUSES, OACC_KERNELS_CLAUSES, OACC_DATA_CLAUSES,
OACC_LOOP_CLAUSES, OACC_PARALLEL_LOOP_CLAUSES,
OACC_KERNELS_LOOP_CLAUSES, OACC_HOST_DATA_CLAUSES,
OACC_DECLARE_CLAUSES,
OACC_UPDATE_CLAUSES, OACC_ENTER_DATA_CLAUSES,
OACC_EXIT_DATA_CLAUSES): New defines.
(gfc_match_oacc_parallel_loop, gfc_match_oacc_parallel,
gfc_match_oacc_kernels_loop, gfc_match_oacc_kernels,
gfc_match_oacc_data, gfc_match_oacc_host_data, gfc_match_oacc_loop,
gfc_match_oacc_declare, gfc_match_oacc_update,
gfc_match_oacc_enter_data, gfc_match_oacc_exit_data,
gfc_match_oacc_wait, gfc_match_oacc_cache, oacc_is_loop,
check_symbol_not_pointer, resolve_oacc_scalar_int_expr,
resolve_oacc_positive_int_expr, check_array_not_assumed,
resolve_oacc_data_clauses, resolve_oacc_deviceptr_clause,
oacc_is_parallel, oacc_is_kernels, omp_code_to_statement,
oacc_code_to_statement, resolve_oacc_directive_inside_omp_region,
resolve_omp_directive_inside_oacc_region, resolve_oacc_nested_loops,
resolve_oacc_params_in_parallel, resolve_oacc_loop_blocks,
gfc_resolve_oacc_blocks, resolve_oacc_loop, resolve_oacc_cache,
resolve_oacc_wait, gfc_resolve_oacc_declare,
gfc_resolve_oacc_directive): New functions.
(resolve_omp_clauses): Resolve also OpenACC clauses.
(gfc_resolve_omp_directive): Check for enclosing OpenACC region.
[-- Attachment #2: 0002-OpenACC-Fortran-FE-part-2.patch --]
[-- Type: text/x-diff, Size: 41861 bytes --]
From b783a60855f6649b6b8b440f177c1076f9af6521 Mon Sep 17 00:00:00 2001
From: Ilmir Usmanov <i.usmanov@samsung.com>
Date: Fri, 7 Mar 2014 14:33:17 +0400
Subject: [PATCH 2/4] OpenACC Fortran FE -- part 2
---
gcc/fortran/openmp.c | 1222 +++++++++++++++++++++++++++++++++++++++++++++++++-
1 file changed, 1200 insertions(+), 22 deletions(-)
diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index dff3ab1..e37c4c2 100644
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -69,11 +69,37 @@ gfc_free_omp_clauses (gfc_omp_clauses *c)
gfc_free_expr (c->final_expr);
gfc_free_expr (c->num_threads);
gfc_free_expr (c->chunk_size);
+ gfc_free_expr (c->async_expr);
+ gfc_free_expr (c->gang_expr);
+ gfc_free_expr (c->worker_expr);
+ gfc_free_expr (c->vector_expr);
+ gfc_free_expr (c->num_gangs_expr);
+ gfc_free_expr (c->num_workers_expr);
+ gfc_free_expr (c->vector_length_expr);
+ gfc_free_expr (c->non_clause_wait_expr);
+
for (i = 0; i < OMP_LIST_NUM; i++)
gfc_free_namelist (c->lists[i]);
+
+ gfc_free_expr_list (c->wait_list);
+ gfc_free_expr_list (c->tile_list);
+
free (c);
}
+/* Free expression list. */
+void
+gfc_free_expr_list (gfc_expr_list *list)
+{
+ gfc_expr_list *n;
+
+ for (; list; list = n)
+ {
+ n = list->next;
+ free (list);
+ }
+}
+
/* Match a variable/common block list and construct a namelist from it. */
static match
@@ -169,6 +195,87 @@ cleanup:
return MATCH_ERROR;
}
+static match
+match_oacc_expr_list (const char *str, gfc_expr_list **list, bool allow_asterisk)
+{
+ gfc_expr_list *head, *tail, *p;
+ locus old_loc;
+ gfc_expr *expr;
+ match m;
+
+ head = tail = NULL;
+
+ old_loc = gfc_current_locus;
+
+ m = gfc_match (str);
+ if (m != MATCH_YES)
+ return m;
+
+ for (;;)
+ {
+ m = gfc_match_expr (&expr);
+ if (m == MATCH_YES || allow_asterisk)
+ {
+ p = gfc_get_expr_list ();
+ if (head == NULL)
+ head = tail = p;
+ else
+ {
+ tail->next = p;
+ tail = tail->next;
+ }
+ if (m == MATCH_YES)
+ tail->expr = expr;
+ else if (gfc_match (" *") != MATCH_YES)
+ goto syntax;
+ goto next_item;
+ }
+ if (m == MATCH_ERROR)
+ goto cleanup;
+ goto syntax;
+
+ next_item:
+ if (gfc_match_char (')') == MATCH_YES)
+ break;
+ if (gfc_match_char (',') != MATCH_YES)
+ goto syntax;
+ }
+
+ while (*list)
+ list = &(*list)->next;
+
+ *list = head;
+ return MATCH_YES;
+
+syntax:
+ gfc_error ("Syntax error in OpenACC expression list at %C");
+
+cleanup:
+ gfc_free_expr_list (head);
+ gfc_current_locus = old_loc;
+ return MATCH_ERROR;
+}
+
+static match
+match_oacc_clause_gang (gfc_omp_clauses *cp)
+{
+ if (gfc_match_char ('(') != 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)
+ {
+ cp->gang_static = true;
+ if (gfc_match (" * )") != MATCH_YES)
+ return gfc_match (" %e )", &cp->gang_expr);
+ return MATCH_YES;
+ }
+ return gfc_match (" %e )", &cp->gang_expr);
+}
+
#define OMP_CLAUSE_PRIVATE (1 << 0)
#define OMP_CLAUSE_FIRSTPRIVATE (1 << 1)
#define OMP_CLAUSE_LASTPRIVATE (1 << 2)
@@ -186,11 +293,40 @@ cleanup:
#define OMP_CLAUSE_FINAL (1 << 14)
#define OMP_CLAUSE_MERGEABLE (1 << 15)
-/* Match OpenMP directive clauses. MASK is a bitmask of
+/* OpenACC 2.0 clauses. */
+#define OMP_CLAUSE_ASYNC (1 << 16)
+#define OMP_CLAUSE_NUM_GANGS (1 << 17)
+#define OMP_CLAUSE_NUM_WORKERS (1 << 18)
+#define OMP_CLAUSE_VECTOR_LENGTH (1 << 19)
+#define OMP_CLAUSE_COPY (1 << 20)
+#define OMP_CLAUSE_COPYOUT (1 << 21)
+#define OMP_CLAUSE_CREATE (1 << 22)
+#define OMP_CLAUSE_PRESENT (1 << 23)
+#define OMP_CLAUSE_PRESENT_OR_COPY (1 << 24)
+#define OMP_CLAUSE_PRESENT_OR_COPYIN (1 << 25)
+#define OMP_CLAUSE_PRESENT_OR_COPYOUT (1 << 26)
+#define OMP_CLAUSE_PRESENT_OR_CREATE (1 << 27)
+#define OMP_CLAUSE_DEVICEPTR (1 << 28)
+#define OMP_CLAUSE_GANG (1 << 29)
+#define OMP_CLAUSE_WORKER (1 << 30)
+#define OMP_CLAUSE_VECTOR (1 << 31)
+#define OMP_CLAUSE_SEQ (1LL << 32)
+#define OMP_CLAUSE_INDEPENDENT (1LL << 33)
+#define OMP_CLAUSE_USE_DEVICE (1LL << 34)
+#define OMP_CLAUSE_DEVICE_RESIDENT (1LL << 35)
+#define OMP_CLAUSE_HOST (1LL << 36)
+#define OMP_CLAUSE_DEVICE (1LL << 37)
+#define OMP_CLAUSE_OACC_COPYIN (1LL << 38)
+#define OMP_CLAUSE_WAIT (1LL << 39)
+#define OMP_CLAUSE_DELETE (1LL << 40)
+#define OMP_CLAUSE_AUTO (1LL << 41)
+#define OMP_CLAUSE_TILE (1LL << 42)
+
+/* Match OpenMP and OpenACC directive clauses. MASK is a bitmask of
clauses that are allowed for a particular directive. */
static match
-gfc_match_omp_clauses (gfc_omp_clauses **cp, int mask)
+gfc_match_omp_clauses (gfc_omp_clauses **cp, long long mask)
{
gfc_omp_clauses *c = gfc_get_omp_clauses ();
locus old_loc;
@@ -205,6 +341,52 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, int mask)
needs_space = false;
first = false;
gfc_gobble_whitespace ();
+ if ((mask & OMP_CLAUSE_ASYNC) && !c->async)
+ if (gfc_match ("async") == MATCH_YES)
+ {
+ c->async = true;
+ if (gfc_match (" ( %e )", &c->async_expr) == MATCH_YES)
+ needs_space = false;
+ else
+ needs_space = true;
+ continue;
+ }
+ if ((mask & OMP_CLAUSE_GANG) && !c->gang)
+ if (gfc_match ("gang") == MATCH_YES)
+ {
+ c->gang = true;
+ if (match_oacc_clause_gang(c) == MATCH_YES)
+ needs_space = false;
+ else
+ needs_space = true;
+ continue;
+ }
+ if ((mask & OMP_CLAUSE_WORKER) && !c->worker)
+ if (gfc_match ("worker") == MATCH_YES)
+ {
+ c->worker = true;
+ if (gfc_match (" ( num : %e )", &c->worker_expr) == MATCH_YES
+ || gfc_match (" ( %e )", &c->worker_expr) == MATCH_YES)
+ needs_space = false;
+ else
+ needs_space = true;
+ continue;
+ }
+ if ((mask & OMP_CLAUSE_VECTOR_LENGTH) && c->vector_length_expr == NULL
+ && gfc_match ("vector_length ( %e )", &c->vector_length_expr)
+ == MATCH_YES)
+ continue;
+ if ((mask & OMP_CLAUSE_VECTOR) && !c->vector)
+ if (gfc_match ("vector") == MATCH_YES)
+ {
+ c->vector = true;
+ if (gfc_match (" ( length : %e )", &c->vector_expr) == MATCH_YES
+ || gfc_match (" ( %e )", &c->vector_expr) == MATCH_YES)
+ needs_space = false;
+ else
+ needs_space = true;
+ continue;
+ }
if ((mask & OMP_CLAUSE_IF) && c->if_expr == NULL
&& gfc_match ("if ( %e )", &c->if_expr) == MATCH_YES)
continue;
@@ -247,6 +429,148 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, int mask)
&c->lists[OMP_LIST_COPYIN], true)
== MATCH_YES)
continue;
+ if ((mask & OMP_CLAUSE_NUM_GANGS) && c->num_gangs_expr == NULL
+ && gfc_match ("num_gangs ( %e )", &c->num_gangs_expr) == MATCH_YES)
+ continue;
+ if ((mask & OMP_CLAUSE_NUM_WORKERS) && c->num_workers_expr == NULL
+ && gfc_match ("num_workers ( %e )", &c->num_workers_expr)
+ == MATCH_YES)
+ continue;
+ if ((mask & OMP_CLAUSE_COPY)
+ && gfc_match_omp_variable_list ("copy (",
+ &c->lists[OMP_LIST_COPY], true)
+ == MATCH_YES)
+ continue;
+ if ((mask & OMP_CLAUSE_OACC_COPYIN)
+ && gfc_match_omp_variable_list ("copyin (",
+ &c->lists[OMP_LIST_OACC_COPYIN], true)
+ == MATCH_YES)
+ continue;
+ if ((mask & OMP_CLAUSE_COPYOUT)
+ && gfc_match_omp_variable_list ("copyout (",
+ &c->lists[OMP_LIST_COPYOUT], true)
+ == MATCH_YES)
+ continue;
+ if ((mask & OMP_CLAUSE_CREATE)
+ && gfc_match_omp_variable_list ("create (",
+ &c->lists[OMP_LIST_CREATE], true)
+ == MATCH_YES)
+ continue;
+ if ((mask & OMP_CLAUSE_DELETE)
+ && gfc_match_omp_variable_list ("delete (",
+ &c->lists[OMP_LIST_DELETE], true)
+ == MATCH_YES)
+ continue;
+ if ((mask & OMP_CLAUSE_PRESENT)
+ && gfc_match_omp_variable_list ("present (",
+ &c->lists[OMP_LIST_PRESENT], true)
+ == MATCH_YES)
+ continue;
+ if ((mask & OMP_CLAUSE_PRESENT_OR_COPY)
+ && gfc_match_omp_variable_list ("present_or_copy (",
+ &c->lists[OMP_LIST_PRESENT_OR_COPY],
+ true)
+ == MATCH_YES)
+ continue;
+ if ((mask & OMP_CLAUSE_PRESENT_OR_COPY)
+ && gfc_match_omp_variable_list ("pcopy (",
+ &c->lists[OMP_LIST_PRESENT_OR_COPY],
+ true)
+ == MATCH_YES)
+ continue;
+ if ((mask & OMP_CLAUSE_PRESENT_OR_COPYIN)
+ && gfc_match_omp_variable_list ("present_or_copyin (",
+ &c->lists[OMP_LIST_PRESENT_OR_COPYIN],
+ true)
+ == MATCH_YES)
+ continue;
+ if ((mask & OMP_CLAUSE_PRESENT_OR_COPYIN)
+ && gfc_match_omp_variable_list ("pcopyin (",
+ &c->lists[OMP_LIST_PRESENT_OR_COPYIN],
+ true)
+ == MATCH_YES)
+ continue;
+ if ((mask & OMP_CLAUSE_PRESENT_OR_COPYOUT)
+ && gfc_match_omp_variable_list ("present_or_copyout (",
+ &c->lists[OMP_LIST_PRESENT_OR_COPYOUT],
+ true)
+ == MATCH_YES)
+ continue;
+ if ((mask & OMP_CLAUSE_PRESENT_OR_COPYOUT)
+ && gfc_match_omp_variable_list ("pcopyout (",
+ &c->lists[OMP_LIST_PRESENT_OR_COPYOUT],
+ true)
+ == MATCH_YES)
+ continue;
+ if ((mask & OMP_CLAUSE_PRESENT_OR_CREATE)
+ && gfc_match_omp_variable_list ("present_or_create (",
+ &c->lists[OMP_LIST_PRESENT_OR_CREATE],
+ true)
+ == MATCH_YES)
+ continue;
+ if ((mask & OMP_CLAUSE_PRESENT_OR_CREATE)
+ && gfc_match_omp_variable_list ("pcreate (",
+ &c->lists[OMP_LIST_PRESENT_OR_CREATE],
+ true)
+ == MATCH_YES)
+ continue;
+ if ((mask & OMP_CLAUSE_DEVICEPTR)
+ && gfc_match_omp_variable_list ("deviceptr (",
+ &c->lists[OMP_LIST_DEVICEPTR], true)
+ == MATCH_YES)
+ continue;
+ if ((mask & OMP_CLAUSE_USE_DEVICE)
+ && gfc_match_omp_variable_list ("use_device (",
+ &c->lists[OMP_LIST_USE_DEVICE], true)
+ == MATCH_YES)
+ continue;
+ if ((mask & OMP_CLAUSE_DEVICE_RESIDENT)
+ && gfc_match_omp_variable_list ("device_resident (",
+ &c->lists[OMP_LIST_DEVICE_RESIDENT],
+ true)
+ == MATCH_YES)
+ continue;
+ if ((mask & OMP_CLAUSE_HOST)
+ && gfc_match_omp_variable_list ("host (",
+ &c->lists[OMP_LIST_HOST], true)
+ == MATCH_YES)
+ continue;
+ if ((mask & OMP_CLAUSE_DEVICE)
+ && gfc_match_omp_variable_list ("device (",
+ &c->lists[OMP_LIST_DEVICE], true)
+ == MATCH_YES)
+ continue;
+ if ((mask & OMP_CLAUSE_TILE)
+ && match_oacc_expr_list ("tile (", &c->tile_list, true) == MATCH_YES)
+ continue;
+ if ((mask & OMP_CLAUSE_SEQ) && !c->seq
+ && gfc_match ("seq") == MATCH_YES)
+ {
+ c->seq = true;
+ needs_space = true;
+ continue;
+ }
+ if ((mask & OMP_CLAUSE_INDEPENDENT) && !c->independent
+ && gfc_match ("independent") == MATCH_YES)
+ {
+ c->independent = true;
+ needs_space = true;
+ continue;
+ }
+ if ((mask & OMP_CLAUSE_AUTO) && !c->par_auto
+ && gfc_match ("auto") == MATCH_YES)
+ {
+ c->par_auto = true;
+ needs_space = true;
+ continue;
+ }
+ if ((mask & OMP_CLAUSE_WAIT) && !c->wait
+ && gfc_match ("wait") == MATCH_YES)
+ {
+ c->wait = true;
+ match_oacc_expr_list (" (", &c->wait_list, false);
+ continue;
+ }
old_loc = gfc_current_locus;
if ((mask & OMP_CLAUSE_REDUCTION)
&& gfc_match ("reduction ( ") == MATCH_YES)
@@ -423,31 +747,257 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, int mask)
break;
}
- if (gfc_match_omp_eos () != MATCH_YES)
+ if (gfc_match_omp_eos () != MATCH_YES)
+ {
+ gfc_free_omp_clauses (c);
+ return MATCH_ERROR;
+ }
+
+ *cp = c;
+ return MATCH_YES;
+}
+
+#define OACC_PARALLEL_CLAUSES \
+ (OMP_CLAUSE_IF | OMP_CLAUSE_ASYNC | OMP_CLAUSE_NUM_GANGS \
+ | OMP_CLAUSE_NUM_WORKERS | OMP_CLAUSE_VECTOR_LENGTH | OMP_CLAUSE_REDUCTION \
+ | OMP_CLAUSE_COPY | OMP_CLAUSE_OACC_COPYIN | OMP_CLAUSE_COPYOUT \
+ | OMP_CLAUSE_CREATE | OMP_CLAUSE_PRESENT | OMP_CLAUSE_PRESENT_OR_COPY \
+ | OMP_CLAUSE_PRESENT_OR_COPYIN | OMP_CLAUSE_PRESENT_OR_COPYOUT \
+ | OMP_CLAUSE_PRESENT_OR_CREATE | OMP_CLAUSE_DEVICEPTR | OMP_CLAUSE_PRIVATE \
+ | OMP_CLAUSE_FIRSTPRIVATE | OMP_CLAUSE_DEFAULT | OMP_CLAUSE_WAIT)
+#define OACC_KERNELS_CLAUSES \
+ (OMP_CLAUSE_IF | OMP_CLAUSE_ASYNC | OMP_CLAUSE_DEVICEPTR \
+ | OMP_CLAUSE_COPY | OMP_CLAUSE_OACC_COPYIN | OMP_CLAUSE_COPYOUT \
+ | OMP_CLAUSE_CREATE | OMP_CLAUSE_PRESENT | OMP_CLAUSE_PRESENT_OR_COPY \
+ | OMP_CLAUSE_PRESENT_OR_COPYIN | OMP_CLAUSE_PRESENT_OR_COPYOUT \
+ | OMP_CLAUSE_PRESENT_OR_CREATE | OMP_CLAUSE_DEFAULT | OMP_CLAUSE_WAIT)
+#define OACC_DATA_CLAUSES \
+ (OMP_CLAUSE_IF | OMP_CLAUSE_DEVICEPTR | OMP_CLAUSE_COPY \
+ | OMP_CLAUSE_OACC_COPYIN | OMP_CLAUSE_COPYOUT | OMP_CLAUSE_CREATE \
+ | OMP_CLAUSE_PRESENT | OMP_CLAUSE_PRESENT_OR_COPY \
+ | OMP_CLAUSE_PRESENT_OR_COPYIN | OMP_CLAUSE_PRESENT_OR_COPYOUT \
+ | OMP_CLAUSE_PRESENT_OR_CREATE)
+#define OACC_LOOP_CLAUSES \
+ (OMP_CLAUSE_COLLAPSE | OMP_CLAUSE_GANG | OMP_CLAUSE_WORKER \
+ | OMP_CLAUSE_VECTOR | OMP_CLAUSE_SEQ | OMP_CLAUSE_INDEPENDENT \
+ | OMP_CLAUSE_PRIVATE | OMP_CLAUSE_REDUCTION | OMP_CLAUSE_AUTO \
+ | OMP_CLAUSE_TILE)
+#define OACC_PARALLEL_LOOP_CLAUSES \
+ (OACC_LOOP_CLAUSES | OACC_PARALLEL_CLAUSES)
+#define OACC_KERNELS_LOOP_CLAUSES \
+ (OACC_LOOP_CLAUSES | OACC_KERNELS_CLAUSES)
+#define OACC_HOST_DATA_CLAUSES OMP_CLAUSE_USE_DEVICE
+#define OACC_DECLARE_CLAUSES \
+ (OMP_CLAUSE_COPY | OMP_CLAUSE_OACC_COPYIN | OMP_CLAUSE_COPYOUT \
+ | OMP_CLAUSE_CREATE | OMP_CLAUSE_DEVICEPTR | OMP_CLAUSE_DEVICE_RESIDENT \
+ | OMP_CLAUSE_PRESENT | OMP_CLAUSE_PRESENT_OR_COPY \
+ | OMP_CLAUSE_PRESENT_OR_COPYIN | OMP_CLAUSE_PRESENT_OR_COPYOUT \
+ | OMP_CLAUSE_PRESENT_OR_CREATE)
+#define OACC_UPDATE_CLAUSES \
+ (OMP_CLAUSE_IF | OMP_CLAUSE_ASYNC | OMP_CLAUSE_HOST | OMP_CLAUSE_DEVICE)
+#define OACC_ENTER_DATA_CLAUSES \
+ (OMP_CLAUSE_IF | OMP_CLAUSE_ASYNC | OMP_CLAUSE_WAIT | OMP_CLAUSE_OACC_COPYIN \
+ | OMP_CLAUSE_CREATE | OMP_CLAUSE_PRESENT_OR_COPYIN \
+ | OMP_CLAUSE_PRESENT_OR_CREATE)
+#define OACC_EXIT_DATA_CLAUSES \
+ (OMP_CLAUSE_IF | OMP_CLAUSE_ASYNC | OMP_CLAUSE_WAIT | OMP_CLAUSE_COPYOUT \
+ | OMP_CLAUSE_DELETE)
+
+#define OMP_PARALLEL_CLAUSES \
+ (OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE | OMP_CLAUSE_SHARED \
+ | OMP_CLAUSE_COPYIN | OMP_CLAUSE_REDUCTION | OMP_CLAUSE_IF \
+ | OMP_CLAUSE_NUM_THREADS | OMP_CLAUSE_DEFAULT)
+#define OMP_DO_CLAUSES \
+ (OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE \
+ | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_REDUCTION \
+ | OMP_CLAUSE_SCHEDULE | OMP_CLAUSE_ORDERED | OMP_CLAUSE_COLLAPSE)
+#define OMP_SECTIONS_CLAUSES \
+ (OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE \
+ | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_REDUCTION)
+#define OMP_TASK_CLAUSES \
+ (OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE | OMP_CLAUSE_SHARED \
+ | OMP_CLAUSE_IF | OMP_CLAUSE_DEFAULT | OMP_CLAUSE_UNTIED \
+ | OMP_CLAUSE_FINAL | OMP_CLAUSE_MERGEABLE)
+
+
+match
+gfc_match_oacc_parallel_loop (void)
+{
+ gfc_omp_clauses *c;
+ if (gfc_match_omp_clauses (&c, OACC_PARALLEL_LOOP_CLAUSES) != MATCH_YES)
+ return MATCH_ERROR;
+
+ new_st.op = EXEC_OACC_PARALLEL_LOOP;
+ new_st.ext.omp_clauses = c;
+ return MATCH_YES;
+}
+
+
+match
+gfc_match_oacc_parallel (void)
+{
+ gfc_omp_clauses *c;
+ if (gfc_match_omp_clauses (&c, OACC_PARALLEL_CLAUSES) != MATCH_YES)
+ return MATCH_ERROR;
+
+ new_st.op = EXEC_OACC_PARALLEL;
+ new_st.ext.omp_clauses = c;
+ return MATCH_YES;
+}
+
+
+match
+gfc_match_oacc_kernels_loop (void)
+{
+ gfc_omp_clauses *c;
+ if (gfc_match_omp_clauses (&c, OACC_KERNELS_LOOP_CLAUSES) != MATCH_YES)
+ return MATCH_ERROR;
+
+ new_st.op = EXEC_OACC_KERNELS_LOOP;
+ new_st.ext.omp_clauses = c;
+ return MATCH_YES;
+}
+
+
+match
+gfc_match_oacc_kernels (void)
+{
+ gfc_omp_clauses *c;
+ if (gfc_match_omp_clauses (&c, OACC_KERNELS_CLAUSES) != MATCH_YES)
+ return MATCH_ERROR;
+
+ new_st.op = EXEC_OACC_KERNELS;
+ new_st.ext.omp_clauses = c;
+ return MATCH_YES;
+}
+
+
+match
+gfc_match_oacc_data (void)
+{
+ gfc_omp_clauses *c;
+ if (gfc_match_omp_clauses (&c, OACC_DATA_CLAUSES) != MATCH_YES)
+ return MATCH_ERROR;
+
+ new_st.op = EXEC_OACC_DATA;
+ new_st.ext.omp_clauses = c;
+ return MATCH_YES;
+}
+
+
+match
+gfc_match_oacc_host_data (void)
+{
+ gfc_omp_clauses *c;
+ if (gfc_match_omp_clauses (&c, OACC_HOST_DATA_CLAUSES) != MATCH_YES)
+ return MATCH_ERROR;
+
+ new_st.op = EXEC_OACC_HOST_DATA;
+ new_st.ext.omp_clauses = c;
+ return MATCH_YES;
+}
+
+
+match
+gfc_match_oacc_loop (void)
+{
+ gfc_omp_clauses *c;
+ if (gfc_match_omp_clauses (&c, OACC_LOOP_CLAUSES) != MATCH_YES)
+ return MATCH_ERROR;
+
+ new_st.op = EXEC_OACC_LOOP;
+ new_st.ext.omp_clauses = c;
+ return MATCH_YES;
+}
+
+
+match
+gfc_match_oacc_declare (void)
+{
+ gfc_omp_clauses *c;
+ if (gfc_match_omp_clauses (&c, OACC_DECLARE_CLAUSES) != MATCH_YES)
+ return MATCH_ERROR;
+
+ new_st.ext.omp_clauses = c;
+ new_st.ext.omp_clauses->ext.loc = gfc_current_locus;
+ return MATCH_YES;
+}
+
+
+match
+gfc_match_oacc_update (void)
+{
+ gfc_omp_clauses *c;
+ if (gfc_match_omp_clauses (&c, OACC_UPDATE_CLAUSES) != MATCH_YES)
+ return MATCH_ERROR;
+
+ new_st.op = EXEC_OACC_UPDATE;
+ new_st.ext.omp_clauses = c;
+ return MATCH_YES;
+}
+
+
+match
+gfc_match_oacc_enter_data (void)
+{
+ gfc_omp_clauses *c;
+ if (gfc_match_omp_clauses (&c, OACC_ENTER_DATA_CLAUSES) != MATCH_YES)
+ return MATCH_ERROR;
+
+ new_st.op = EXEC_OACC_ENTER_DATA;
+ new_st.ext.omp_clauses = c;
+ return MATCH_YES;
+}
+
+
+match
+gfc_match_oacc_exit_data (void)
+{
+ gfc_omp_clauses *c;
+ if (gfc_match_omp_clauses (&c, OACC_EXIT_DATA_CLAUSES) != MATCH_YES)
+ return MATCH_ERROR;
+
+ new_st.op = EXEC_OACC_EXIT_DATA;
+ new_st.ext.omp_clauses = c;
+ return MATCH_YES;
+}
+
+
+match
+gfc_match_oacc_wait (void)
+{
+ gfc_omp_clauses *c = gfc_get_omp_clauses ();
+ gfc_match (" ( %e )", &c->non_clause_wait_expr);
+
+ new_st.op = EXEC_OACC_WAIT;
+ new_st.ext.omp_clauses = c;
+ return MATCH_YES;
+}
+
+
+match
+gfc_match_oacc_cache (void)
+{
+ gfc_omp_clauses *c = gfc_get_omp_clauses ();
+ match m = gfc_match_omp_variable_list (" (",&c->lists[OMP_LIST_CACHE], true);
+ if (m != MATCH_YES)
+ {
+ gfc_free_omp_clauses(c);
+ return m;
+ }
+
+ if (gfc_current_state() != COMP_DO)
{
- gfc_free_omp_clauses (c);
+ gfc_error ("ACC CACHE directive must be inside of loop %C");
+ gfc_free_omp_clauses(c);
return MATCH_ERROR;
}
- *cp = c;
+ new_st.op = EXEC_OACC_CACHE;
+ new_st.ext.omp_clauses = c;
return MATCH_YES;
}
-#define OMP_PARALLEL_CLAUSES \
- (OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE | OMP_CLAUSE_SHARED \
- | OMP_CLAUSE_COPYIN | OMP_CLAUSE_REDUCTION | OMP_CLAUSE_IF \
- | OMP_CLAUSE_NUM_THREADS | OMP_CLAUSE_DEFAULT)
-#define OMP_DO_CLAUSES \
- (OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE \
- | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_REDUCTION \
- | OMP_CLAUSE_SCHEDULE | OMP_CLAUSE_ORDERED | OMP_CLAUSE_COLLAPSE)
-#define OMP_SECTIONS_CLAUSES \
- (OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE \
- | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_REDUCTION)
-#define OMP_TASK_CLAUSES \
- (OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE | OMP_CLAUSE_SHARED \
- | OMP_CLAUSE_IF | OMP_CLAUSE_DEFAULT | OMP_CLAUSE_UNTIED \
- | OMP_CLAUSE_FINAL | OMP_CLAUSE_MERGEABLE)
match
gfc_match_omp_parallel (void)
@@ -793,6 +1343,127 @@ gfc_match_omp_end_single (void)
}
+static bool
+oacc_is_loop (gfc_code *code)
+{
+ return code->op == EXEC_OACC_PARALLEL_LOOP
+ || code->op == EXEC_OACC_KERNELS_LOOP
+ || code->op == EXEC_OACC_LOOP;
+}
+
+static void
+resolve_oacc_scalar_int_expr (gfc_expr *expr, const char *clause)
+{
+ if (!gfc_resolve_expr (expr)
+ || expr->ts.type != BT_INTEGER || expr->rank != 0)
+ gfc_error ("%s clause at %L requires a scalar INTEGER expression",
+ clause, &expr->where);
+}
+
+
+static void
+resolve_oacc_positive_int_expr (gfc_expr *expr, const char *clause)
+{
+ resolve_oacc_scalar_int_expr (expr, clause);
+ if (expr->expr_type == EXPR_CONSTANT && expr->ts.type == BT_INTEGER
+ && expr->value.integer->_mp_size <= 0)
+ gfc_warning ("INTEGER expression of %s clause at %L must be positive",
+ clause, &expr->where);
+}
+
+/* Emits error when symbol is pointer, cray pointer or cray pointee
+ of derived of polymorphic type. */
+
+static void
+check_symbol_not_pointer (gfc_symbol *sym, locus loc, const char *name)
+{
+ if (sym->ts.type == BT_DERIVED && sym->attr.pointer)
+ gfc_error ("POINTER object '%s' of derived type in %s clause at %L",
+ sym->name, name, &loc);
+ if (sym->ts.type == BT_DERIVED && sym->attr.cray_pointer)
+ gfc_error ("Cray pointer object of derived type '%s' in %s clause at %L",
+ sym->name, name, &loc);
+ if (sym->ts.type == BT_DERIVED && sym->attr.cray_pointee)
+ gfc_error ("Cray pointee object of derived type '%s' in %s clause at %L",
+ sym->name, name, &loc);
+
+ if ((sym->ts.type == BT_ASSUMED && sym->attr.pointer)
+ || (sym->ts.type == BT_ASSUMED && CLASS_DATA (sym)
+ && CLASS_DATA (sym)->attr.pointer))
+ gfc_error ("POINTER object '%s' of polymorphic type in %s clause at %L",
+ sym->name, name, &loc);
+ if ((sym->ts.type == BT_ASSUMED && sym->attr.cray_pointer)
+ || (sym->ts.type == BT_ASSUMED && CLASS_DATA (sym)
+ && CLASS_DATA (sym)->attr.cray_pointer))
+ gfc_error ("Cray pointer object of polymorphic type '%s' in %s clause at %L",
+ sym->name, name, &loc);
+ if ((sym->ts.type == BT_ASSUMED && sym->attr.cray_pointee)
+ || (sym->ts.type == BT_ASSUMED && CLASS_DATA (sym)
+ && CLASS_DATA (sym)->attr.cray_pointee))
+ gfc_error ("Cray pointee object of polymorphic type '%s' in %s clause at %L",
+ sym->name, name, &loc);
+}
+
+/* Emits error when symbol represents assumed size/shape/rank array. */
+
+static void
+check_array_not_assumed (gfc_symbol *sym, locus loc, const char *name)
+{
+ if (sym->as && sym->as->type == AS_ASSUMED_SIZE)
+ gfc_error ("Assumed size array '%s' in %s clause at %L",
+ sym->name, name, &loc);
+ if (sym->as && sym->as->type == AS_ASSUMED_SHAPE)
+ gfc_error ("Assumed shape array '%s' in %s clause at %L",
+ sym->name, name, &loc);
+ if (sym->as && sym->as->type == AS_ASSUMED_RANK)
+ gfc_error ("Assumed rank array '%s' in %s clause at %L",
+ sym->name, name, &loc);
+}
+
+static void
+resolve_oacc_data_clauses (gfc_symbol *sym, locus loc, const char *name)
+{
+ if (sym->ts.type == BT_DERIVED && sym->attr.allocatable)
+ gfc_error ("ALLOCATABLE object '%s' of derived type in %s clause at %L",
+ sym->name, name, &loc);
+ if ((sym->ts.type == BT_ASSUMED && sym->attr.allocatable)
+ || (sym->ts.type == BT_ASSUMED && CLASS_DATA (sym)
+ && CLASS_DATA (sym)->attr.allocatable))
+ gfc_error ("ALLOCATABLE object '%s' of polymorphic type "
+ "in %s clause at %L", sym->name, name, &loc);
+ check_symbol_not_pointer (sym, loc, name);
+ check_array_not_assumed (sym, loc, name);
+}
+
+static void
+resolve_oacc_deviceptr_clause (gfc_symbol *sym, locus loc, const char *name)
+{
+ if (sym->ts.type == BT_DERIVED && sym->attr.allocatable)
+ gfc_error ("ALLOCATABLE object '%s' of derived type in %s clause at %L",
+ sym->name, name, &loc);
+ if ((sym->ts.type == BT_ASSUMED && sym->attr.allocatable)
+ || (sym->ts.type == BT_ASSUMED && CLASS_DATA (sym)
+ && CLASS_DATA (sym)->attr.allocatable))
+ gfc_error ("ALLOCATABLE object '%s' of polymorphic type "
+ "in %s clause at %L", sym->name, name, &loc);
+ if (sym->attr.pointer)
+ gfc_error ("POINTER object '%s' in %s clause at %L",
+ sym->name, name, &loc);
+ if (sym->attr.cray_pointer)
+ gfc_error ("Cray pointer object '%s' in %s clause at %L",
+ sym->name, name, &loc);
+ if (sym->attr.cray_pointee)
+ gfc_error ("Cray pointee object '%s' in %s clause at %L",
+ sym->name, name, &loc);
+ if (sym->attr.allocatable)
+ gfc_error ("ALLOCATABLE object '%s' in %s clause at %L",
+ sym->name, name, &loc);
+ if (sym->attr.value)
+ gfc_error ("VALUE object '%s' in %s clause at %L",
+ sym->name, name, &loc);
+ check_array_not_assumed (sym, loc, name);
+}
+
/* OpenMP directive resolving routines. */
static void
@@ -800,10 +1471,14 @@ resolve_omp_clauses (gfc_code *code)
{
gfc_omp_clauses *omp_clauses = code->ext.omp_clauses;
gfc_namelist *n;
+ gfc_expr_list *el;
int list;
static const char *clause_names[]
= { "PRIVATE", "FIRSTPRIVATE", "LASTPRIVATE", "COPYPRIVATE", "SHARED",
- "COPYIN", "REDUCTION" };
+ "COPYIN", "COPY", "COPYIN", "COPYOUT", "CREATE", "DELETE",
+ "PRESENT", "PRESENT_OR_COPY", "PRESENT_OR_COPYIN", "PRESENT_OR_COPYOUT",
+ "PRESENT_OR_CREATE", "DEVICEPTR", "DEVICE_RESIDENT", "USE_DEVICE",
+ "HOST", "DEVICE", "CACHE", "REDUCTION"};
if (omp_clauses == NULL)
return;
@@ -933,8 +1608,36 @@ resolve_omp_clauses (gfc_code *code)
else
gcc_unreachable ();
+ if (list >= OMP_LIST_DATA_CLAUSE_FIRST
+ && list < OMP_LIST_DATA_CLAUSE_LAST)
+ resolve_oacc_data_clauses (n->sym, code->loc, name);
+
+ if (list > OMP_LIST_DATA_CLAUSE_LAST
+ && list < OMP_LIST_REDUCTION_FIRST)
+ {
+ check_symbol_not_pointer (n->sym, code->loc, name);
+ check_array_not_assumed (n->sym, code->loc, name);
+ }
+
switch (list)
{
+ case OMP_LIST_DEVICEPTR:
+ resolve_oacc_deviceptr_clause (n->sym, code->loc, name);
+ break;
+ case OMP_LIST_USE_DEVICE:
+ if (n->sym->attr.allocatable)
+ gfc_error ("ALLOCATABLE object '%s' in %s clause at %L",
+ n->sym->name, name, &code->loc);
+ if (n->sym->attr.pointer)
+ gfc_error ("POINTER object '%s' in %s clause at %L",
+ n->sym->name, name, &code->loc);
+ if (n->sym->attr.cray_pointer)
+ gfc_error ("Cray pointer object '%s' in %s clause at %L",
+ n->sym->name, name, &code->loc);
+ if (n->sym->attr.cray_pointee)
+ gfc_error ("Cray pointee object '%s' in %s clause at %L",
+ n->sym->name, name, &code->loc);
+ break;
case OMP_LIST_COPYIN:
for (; n != NULL; n = n->next)
{
@@ -996,7 +1699,9 @@ resolve_omp_clauses (gfc_code *code)
gfc_error ("Cray pointer '%s' in %s clause at %L",
n->sym->name, name, &code->loc);
}
- if (n->sym->as && n->sym->as->type == AS_ASSUMED_SIZE)
+ if (oacc_is_loop (code) || code->op == EXEC_OACC_PARALLEL)
+ check_array_not_assumed (n->sym, code->loc, name);
+ else if (n->sym->as && n->sym->as->type == AS_ASSUMED_SIZE)
gfc_error ("Assumed size array '%s' in %s clause at %L",
n->sym->name, name, &code->loc);
if (n->sym->attr.in_namelist
@@ -1059,6 +1764,25 @@ resolve_omp_clauses (gfc_code *code)
break;
}
}
+ if (omp_clauses->async)
+ if (omp_clauses->async_expr)
+ resolve_oacc_scalar_int_expr (omp_clauses->async_expr, "ASYNC");
+ 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");
+ 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");
+ if (omp_clauses->worker_expr)
+ resolve_oacc_positive_int_expr (omp_clauses->worker_expr, "WORKER");
+ if (omp_clauses->vector_expr)
+ resolve_oacc_positive_int_expr (omp_clauses->vector_expr, "VECTOR");
+ if (omp_clauses->wait)
+ if (omp_clauses->wait_list)
+ for (el = omp_clauses->wait_list; el; el = el->next)
+ resolve_oacc_positive_int_expr (el->expr, "WAIT");
}
@@ -1727,6 +2451,458 @@ resolve_omp_do (gfc_code *code)
}
}
+typedef struct omp_context oacc_context;
+oacc_context *oacc_current_ctx;
+
+static bool
+oacc_is_parallel (gfc_code *code)
+{
+ return code->op == EXEC_OACC_PARALLEL || code->op == EXEC_OACC_PARALLEL_LOOP;
+}
+
+static bool
+oacc_is_kernels (gfc_code *code)
+{
+ return code->op == EXEC_OACC_KERNELS || code->op == EXEC_OACC_KERNELS_LOOP;
+}
+
+static gfc_statement
+omp_code_to_statement (gfc_code *code)
+{
+switch (code->op)
+ {
+ case EXEC_OMP_PARALLEL:
+ return ST_OMP_PARALLEL;
+ case EXEC_OMP_PARALLEL_SECTIONS:
+ return ST_OMP_PARALLEL_SECTIONS;
+ case EXEC_OMP_SECTIONS:
+ return ST_OMP_SECTIONS;
+ case EXEC_OMP_ORDERED:
+ return ST_OMP_ORDERED;
+ case EXEC_OMP_CRITICAL:
+ return ST_OMP_CRITICAL;
+ case EXEC_OMP_MASTER:
+ return ST_OMP_MASTER;
+ case EXEC_OMP_SINGLE:
+ return ST_OMP_SINGLE;
+ case EXEC_OMP_TASK:
+ return ST_OMP_TASK;
+ case EXEC_OMP_WORKSHARE:
+ return ST_OMP_WORKSHARE;
+ case EXEC_OMP_PARALLEL_WORKSHARE:
+ return ST_OMP_PARALLEL_WORKSHARE;
+ case EXEC_OMP_DO:
+ return ST_OMP_DO;
+ default:
+ gcc_unreachable ();
+ }
+}
+
+static gfc_statement
+oacc_code_to_statement (gfc_code *code)
+{
+switch (code->op)
+ {
+ case EXEC_OACC_PARALLEL:
+ return ST_OACC_PARALLEL;
+ case EXEC_OACC_KERNELS:
+ return ST_OACC_KERNELS;
+ case EXEC_OACC_DATA:
+ return ST_OACC_DATA;
+ case EXEC_OACC_HOST_DATA:
+ return ST_OACC_HOST_DATA;
+ case EXEC_OACC_PARALLEL_LOOP:
+ return ST_OACC_PARALLEL_LOOP;
+ case EXEC_OACC_KERNELS_LOOP:
+ return ST_OACC_KERNELS_LOOP;
+ case EXEC_OACC_LOOP:
+ return ST_OACC_LOOP;
+ default:
+ gcc_unreachable ();
+ }
+}
+
+static void
+resolve_oacc_directive_inside_omp_region (gfc_code *code)
+{
+ if (omp_current_ctx != NULL)
+ {
+ gfc_statement st = omp_code_to_statement (omp_current_ctx->code);
+ gfc_statement oacc_st = oacc_code_to_statement (code);
+ gfc_error ("The %s directive cannot be specified within "
+ "a %s region at %L", gfc_ascii_statement (oacc_st),
+ gfc_ascii_statement (st), &code->loc);
+ }
+}
+
+static void
+resolve_omp_directive_inside_oacc_region (gfc_code *code)
+{
+ if (oacc_current_ctx != NULL)
+ {
+ gfc_statement st = oacc_code_to_statement (oacc_current_ctx->code);
+ gfc_statement omp_st = omp_code_to_statement (code);
+ gfc_error ("The %s directive cannot be specified within "
+ "a %s region at %L", gfc_ascii_statement (omp_st),
+ gfc_ascii_statement (st), &code->loc);
+ }
+}
+
+
+static void
+resolve_oacc_nested_loops (gfc_code *code, gfc_code* do_code, int collapse,
+ const char *clause)
+{
+ gfc_symbol *dovar;
+ gfc_code *c;
+ int i;
+
+ for (i = 1; i <= collapse; i++)
+ {
+ if (do_code->op == EXEC_DO_WHILE)
+ {
+ gfc_error ("!$ACC LOOP cannot be a DO WHILE or DO without loop control "
+ "at %L", &do_code->loc);
+ break;
+ }
+ gcc_assert (do_code->op == EXEC_DO || do_code->op == EXEC_DO_CONCURRENT);
+ if (do_code->ext.iterator->var->ts.type != BT_INTEGER)
+ gfc_error ("!$ACC LOOP iteration variable must be of type integer at %L",
+ &do_code->loc);
+ dovar = do_code->ext.iterator->var->symtree->n.sym;
+ if (i > 1)
+ {
+ gfc_code *do_code2 = code->block->next;
+ int j;
+
+ for (j = 1; j < i; j++)
+ {
+ gfc_symbol *ivar = do_code2->ext.iterator->var->symtree->n.sym;
+ if (dovar == ivar
+ || gfc_find_sym_in_expr (ivar, do_code->ext.iterator->start)
+ || gfc_find_sym_in_expr (ivar, do_code->ext.iterator->end)
+ || gfc_find_sym_in_expr (ivar, do_code->ext.iterator->step))
+ {
+ gfc_error ("!$ACC LOOP %s loops don't form rectangular iteration space at %L",
+ clause, &do_code->loc);
+ break;
+ }
+ if (j < i)
+ break;
+ do_code2 = do_code2->block->next;
+ }
+ }
+ if (i == collapse)
+ break;
+ for (c = do_code->next; c; c = c->next)
+ if (c->op != EXEC_NOP && c->op != EXEC_CONTINUE)
+ {
+ gfc_error ("%s !$ACC LOOP loops not perfectly nested at %L",
+ clause, &c->loc);
+ break;
+ }
+ if (c)
+ break;
+ do_code = do_code->block;
+ if (do_code->op != EXEC_DO && do_code->op != EXEC_DO_WHILE
+ && do_code->op != EXEC_DO_CONCURRENT)
+ {
+ gfc_error ("not enough DO loops for %s !$ACC LOOP at %L",
+ clause, &code->loc);
+ break;
+ }
+ do_code = do_code->next;
+ if (do_code == NULL
+ || (do_code->op != EXEC_DO && do_code->op != EXEC_DO_WHILE
+ && do_code->op != EXEC_DO_CONCURRENT))
+ {
+ gfc_error ("not enough DO loops for %s !$ACC LOOP at %L",
+ clause, &code->loc);
+ break;
+ }
+ }
+}
+
+
+static void
+resolve_oacc_params_in_parallel (gfc_code *code, const char *clause)
+{
+ oacc_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);
+ for (c = oacc_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);
+ }
+}
+
+
+static void
+resolve_oacc_loop_blocks (gfc_code *code)
+{
+ oacc_context *c;
+
+ if (!oacc_is_loop (code))
+ return;
+
+ if (code->op == EXEC_OACC_LOOP)
+ for (c = oacc_current_ctx; c; c = c->previous)
+ {
+ if (oacc_is_loop (c->code))
+ {
+ if (code->ext.omp_clauses->gang)
+ {
+ if (c->code->ext.omp_clauses->gang)
+ gfc_error ("Loop parallelized across gangs is not allowed "
+ "inside another loop parallelized across gangs at %L",
+ &code->loc);
+ 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",
+ &code->loc);
+ }
+ if (code->ext.omp_clauses->worker)
+ {
+ if (c->code->ext.omp_clauses->worker)
+ gfc_error ("Loop parallelized across workers is not allowed "
+ "inside another loop parallelized across workers at %L",
+ &code->loc);
+ if (c->code->ext.omp_clauses->vector)
+ gfc_error ("Loop parallelized across workers is not allowed "
+ "inside another loop parallelized across vectors at %L",
+ &code->loc);
+ }
+ if (code->ext.omp_clauses->vector)
+ if (c->code->ext.omp_clauses->vector)
+ gfc_error ("Loop parallelized across vectors is not allowed "
+ "inside another loop parallelized across vectors at %L",
+ &code->loc);
+ }
+
+ if (oacc_is_parallel (c->code) || oacc_is_kernels (c->code))
+ break;
+ }
+
+ if (code->ext.omp_clauses->seq)
+ {
+ if (code->ext.omp_clauses->independent)
+ gfc_error ("Clause SEQ conflicts with INDEPENDENT at %L", &code->loc);
+ if (code->ext.omp_clauses->gang)
+ gfc_error ("Clause SEQ conflicts with GANG at %L", &code->loc);
+ if (code->ext.omp_clauses->worker)
+ gfc_error ("Clause SEQ conflicts with WORKER at %L", &code->loc);
+ if (code->ext.omp_clauses->vector)
+ gfc_error ("Clause SEQ conflicts with VECTOR at %L", &code->loc);
+ if (code->ext.omp_clauses->par_auto)
+ gfc_error ("Clause SEQ conflicts with AUTO at %L", &code->loc);
+ }
+ if (code->ext.omp_clauses->par_auto)
+ {
+ if (code->ext.omp_clauses->gang)
+ gfc_error ("Clause AUTO conflicts with GANG at %L", &code->loc);
+ if (code->ext.omp_clauses->worker)
+ gfc_error ("Clause AUTO conflicts with WORKER at %L", &code->loc);
+ if (code->ext.omp_clauses->vector)
+ gfc_error ("Clause AUTO conflicts with VECTOR at %L", &code->loc);
+ }
+ if (!code->ext.omp_clauses->tile_list)
+ {
+ if (code->ext.omp_clauses->gang)
+ {
+ if (code->ext.omp_clauses->worker)
+ gfc_error ("Clause GANG conflicts with WORKER at %L", &code->loc);
+ if (code->ext.omp_clauses->vector)
+ gfc_error ("Clause GANG conflicts with VECTOR at %L", &code->loc);
+ }
+ if (code->ext.omp_clauses->worker)
+ if (code->ext.omp_clauses->vector)
+ gfc_error ("Clause WORKER conflicts with VECTOR at %L", &code->loc);
+ }
+ else if (code->ext.omp_clauses->gang
+ && code->ext.omp_clauses->worker
+ && code->ext.omp_clauses->vector)
+ gfc_error ("Tiled loop cannot be parallelized across gangs, workers and "
+ "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");
+
+ if (code->ext.omp_clauses->worker
+ && code->ext.omp_clauses->worker_expr)
+ resolve_oacc_params_in_parallel (code, "WORKER");
+
+ if (code->ext.omp_clauses->tile_list)
+ {
+ gfc_expr_list *el;
+ int num = 0;
+ for (el = code->ext.omp_clauses->tile_list; el; el = el->next)
+ {
+ num++;
+ if (el->expr == NULL)
+ continue;
+ resolve_oacc_positive_int_expr (el->expr, "TILE");
+ if (el->expr->expr_type != EXPR_CONSTANT)
+ gfc_error ("TILE requires constant expression at %L", &code->loc);
+ }
+ resolve_oacc_nested_loops (code, code->block->next, num, "tiled");
+ }
+}
+
+
+void
+gfc_resolve_oacc_blocks (gfc_code *code, gfc_namespace *ns)
+{
+ oacc_context ctx;
+
+ resolve_oacc_loop_blocks (code);
+
+ ctx.code = code;
+ ctx.previous = oacc_current_ctx;
+ oacc_current_ctx = &ctx;
+
+ gfc_resolve_blocks (code->block, ns);
+
+ oacc_current_ctx = ctx.previous;
+}
+
+
+static void
+resolve_oacc_loop(gfc_code *code)
+{
+ gfc_code *do_code;
+ int collapse;
+
+ if (code->ext.omp_clauses)
+ resolve_omp_clauses (code);
+
+ do_code = code->block->next;
+ collapse = code->ext.omp_clauses->collapse;
+
+ if (collapse <= 0)
+ collapse = 1;
+ resolve_oacc_nested_loops (code, do_code, collapse, "collapsed");
+}
+
+
+static void
+resolve_oacc_cache (gfc_code *code)
+{
+ gfc_error ("Sorry, !$ACC cache unimplemented yet at %L", &code->loc);
+}
+
+
+static void
+resolve_oacc_wait (gfc_code *code)
+{
+ gfc_expr_list* el;
+
+ for (el = code->ext.omp_clauses->wait_list; el; el = el->next)
+ resolve_oacc_positive_int_expr (el->expr, "WAIT");
+}
+
+
+void
+gfc_resolve_oacc_declare (gfc_namespace *ns)
+{
+ int list;
+ gfc_namelist *n;
+ locus loc;
+ static const char *clause_names[] = {"COPY", "COPYIN", "COPYOUT", "CREATE",
+ "DELETE", "PRESENT", "PRESENT_OR_COPY", "PRESENT_OR_COPYIN",
+ "PRESENT_OR_COPYOUT", "PRESENT_OR_CREATE", "DEVICEPTR",
+ "DEVICE_RESIDENT"};
+
+ if (ns->oacc_declare_clauses == NULL)
+ return;
+
+ loc = ns->oacc_declare_clauses->ext.loc;
+
+ for (list = OMP_LIST_DATA_CLAUSE_FIRST;
+ list <= OMP_LIST_DEVICE_RESIDENT; list++)
+ for (n = ns->oacc_declare_clauses->lists[list]; n; n = n->next)
+ {
+ n->sym->mark = 0;
+ if (n->sym->attr.flavor == FL_PARAMETER)
+ gfc_error ("PARAMETER object '%s' is not allowed at %L", n->sym->name, &loc);
+ }
+
+ for (list = OMP_LIST_DATA_CLAUSE_FIRST;
+ list <= OMP_LIST_DEVICE_RESIDENT; list++)
+ for (n = ns->oacc_declare_clauses->lists[list]; n; n = n->next)
+ {
+ if (n->sym->mark)
+ gfc_error ("Symbol '%s' present on multiple clauses at %L",
+ n->sym->name, &loc);
+ else
+ n->sym->mark = 1;
+ }
+
+ for (list = OMP_LIST_DATA_CLAUSE_FIRST;
+ list < OMP_LIST_DATA_CLAUSE_LAST; /* Skip deviceptr clause. */
+ list++)
+ {
+ const char *name = clause_names[list - OMP_LIST_DATA_CLAUSE_FIRST];
+ for (n = ns->oacc_declare_clauses->lists[list]; n; n = n->next)
+ resolve_oacc_data_clauses (n->sym, loc, name);
+ }
+
+ for (n = ns->oacc_declare_clauses->lists[OMP_LIST_DEVICEPTR]; n; n = n->next)
+ resolve_oacc_deviceptr_clause (n->sym, loc,
+ clause_names[OMP_LIST_DEVICEPTR -
+ OMP_LIST_DATA_CLAUSE_FIRST]);
+
+ for (n = ns->oacc_declare_clauses->lists[OMP_LIST_DEVICE_RESIDENT]; n;
+ n = n->next)
+ check_array_not_assumed (n->sym, loc,
+ clause_names[OMP_LIST_DEVICE_RESIDENT -
+ OMP_LIST_DATA_CLAUSE_FIRST]);
+}
+
+
+void
+gfc_resolve_oacc_directive (gfc_code *code, gfc_namespace *ns ATTRIBUTE_UNUSED)
+{
+ resolve_oacc_directive_inside_omp_region (code);
+
+ switch (code->op)
+ {
+ case EXEC_OACC_PARALLEL:
+ case EXEC_OACC_KERNELS:
+ case EXEC_OACC_DATA:
+ case EXEC_OACC_HOST_DATA:
+ case EXEC_OACC_UPDATE:
+ case EXEC_OACC_ENTER_DATA:
+ case EXEC_OACC_EXIT_DATA:
+ resolve_omp_clauses (code);
+ break;
+ case EXEC_OACC_PARALLEL_LOOP:
+ case EXEC_OACC_KERNELS_LOOP:
+ case EXEC_OACC_LOOP:
+ resolve_oacc_loop (code);
+ break;
+ case EXEC_OACC_CACHE:
+ resolve_oacc_cache (code);
+ break;
+ case EXEC_OACC_WAIT:
+ resolve_oacc_wait (code);
+ break;
+ default:
+ break;
+ }
+}
+
/* Resolve OpenMP directive clauses and check various requirements
of each directive. */
@@ -1734,6 +2910,8 @@ resolve_omp_do (gfc_code *code)
void
gfc_resolve_omp_directive (gfc_code *code, gfc_namespace *ns ATTRIBUTE_UNUSED)
{
+ resolve_omp_directive_inside_oacc_region (code);
+
if (code->op != EXEC_OMP_ATOMIC)
gfc_maybe_initialize_eh ();
--
1.8.3.2
^ permalink raw reply [flat|nested] 89+ messages in thread
* Re: [PATCH 4/4] [GOMP4] [Fortran] OpenACC 1.0+ support in fortran front-end
2014-03-07 10:46 ` [PATCH 3/4] " Ilmir Usmanov
@ 2014-03-07 10:47 ` Ilmir Usmanov
2014-03-08 17:55 ` Tobias Burnus
2014-03-20 10:53 ` Thomas Schwinge
2014-03-08 17:19 ` [PATCH 3/4] " Tobias Burnus
1 sibling, 2 replies; 89+ messages in thread
From: Ilmir Usmanov @ 2014-03-07 10:47 UTC (permalink / raw)
To: Tobias Burnus
Cc: Thomas Schwinge, Evgeny Gavrin, GarbuzovViacheslav,
Dmitri Botcharnikov, gcc-patches, jakub, fortran
[-- Attachment #1: Type: text/plain, Size: 1030 bytes --]
OpenACC 1.0 fortran FE support -- tests.
gcc/testsuite/gfortran.dg/goacc/
* assumed.f95: New test
* branch.f95: Likewise
* coarray.f95: Likewise
* continuation-free-form.f95: Likewise
* cray.f95: Likewise
* critical.f95: Likewise
* data-clauses.f95: Likewise
* data-tree.f95: Likewise
* declare-1.f95: Likewise
* enter-exit-data.f95: Likewise
* goacc.exp: Likewise
* host_data-tree.f95: Likewise
* if.f95: Likewise
* kernels-tree.f95: Likewise
* list.f95: Likewise
* literal.f95: Likewise
* loop-1.f95: Likewise
* loop-2.f95: Likewise
* loop-3.f95: Likewise
* omp.f95: Likewise
* parallel-kernels-clauses.f95: Likewise
* parallel-kernels-regions.f95: Likewise
* parallel-tree.f95: Likewise
* parameter.f95: Likewise
* pure-elemental-procedures.f95: Likewise
* reduction.f95: Likewise
* sentinel-free-form.f95: Likewise
* several-directives.f95: Likewise
* sie.f95: Likewise
[-- Attachment #2: 0004-OpenACC-Fortran-FE-tests.patch --]
[-- Type: text/x-diff, Size: 84864 bytes --]
From 6851de659ae8eaeddf0f438ae067bb600cb910c3 Mon Sep 17 00:00:00 2001
From: Ilmir Usmanov <i.usmanov@samsung.com>
Date: Fri, 7 Mar 2014 14:36:28 +0400
Subject: [PATCH 4/4] OpenACC Fortran FE -- tests
---
gcc/testsuite/gfortran.dg/goacc/assumed.f95 | 66 +++
gcc/testsuite/gfortran.dg/goacc/branch.f95 | 53 ++
gcc/testsuite/gfortran.dg/goacc/coarray.f95 | 35 ++
.../gfortran.dg/goacc/continuation-free-form.f95 | 23 +
gcc/testsuite/gfortran.dg/goacc/cray.f95 | 54 ++
gcc/testsuite/gfortran.dg/goacc/critical.f95 | 27 +
gcc/testsuite/gfortran.dg/goacc/data-clauses.f95 | 259 ++++++++
gcc/testsuite/gfortran.dg/goacc/data-tree.f95 | 31 +
gcc/testsuite/gfortran.dg/goacc/declare-1.f95 | 20 +
.../gfortran.dg/goacc/enter-exit-data.f95 | 88 +++
gcc/testsuite/gfortran.dg/goacc/goacc.exp | 36 ++
gcc/testsuite/gfortran.dg/goacc/host_data-tree.f95 | 13 +
gcc/testsuite/gfortran.dg/goacc/if.f95 | 52 ++
gcc/testsuite/gfortran.dg/goacc/kernels-tree.f95 | 33 ++
gcc/testsuite/gfortran.dg/goacc/list.f95 | 111 ++++
gcc/testsuite/gfortran.dg/goacc/literal.f95 | 29 +
gcc/testsuite/gfortran.dg/goacc/loop-1.f95 | 170 ++++++
gcc/testsuite/gfortran.dg/goacc/loop-2.f95 | 649 +++++++++++++++++++++
gcc/testsuite/gfortran.dg/goacc/loop-3.f95 | 55 ++
gcc/testsuite/gfortran.dg/goacc/omp.f95 | 66 +++
.../gfortran.dg/goacc/parallel-kernels-clauses.f95 | 96 +++
.../gfortran.dg/goacc/parallel-kernels-regions.f95 | 56 ++
gcc/testsuite/gfortran.dg/goacc/parallel-tree.f95 | 42 ++
gcc/testsuite/gfortran.dg/goacc/parameter.f95 | 31 +
.../goacc/pure-elemental-procedures.f95 | 78 +++
gcc/testsuite/gfortran.dg/goacc/reduction.f95 | 138 +++++
.../gfortran.dg/goacc/sentinel-free-form.f95 | 21 +
.../gfortran.dg/goacc/several-directives.f95 | 6 +
gcc/testsuite/gfortran.dg/goacc/sie.f95 | 252 ++++++++
29 files changed, 2590 insertions(+)
create mode 100644 gcc/testsuite/gfortran.dg/goacc/assumed.f95
create mode 100644 gcc/testsuite/gfortran.dg/goacc/branch.f95
create mode 100644 gcc/testsuite/gfortran.dg/goacc/coarray.f95
create mode 100644 gcc/testsuite/gfortran.dg/goacc/continuation-free-form.f95
create mode 100644 gcc/testsuite/gfortran.dg/goacc/cray.f95
create mode 100644 gcc/testsuite/gfortran.dg/goacc/critical.f95
create mode 100644 gcc/testsuite/gfortran.dg/goacc/data-clauses.f95
create mode 100644 gcc/testsuite/gfortran.dg/goacc/data-tree.f95
create mode 100644 gcc/testsuite/gfortran.dg/goacc/declare-1.f95
create mode 100644 gcc/testsuite/gfortran.dg/goacc/enter-exit-data.f95
create mode 100644 gcc/testsuite/gfortran.dg/goacc/goacc.exp
create mode 100644 gcc/testsuite/gfortran.dg/goacc/host_data-tree.f95
create mode 100644 gcc/testsuite/gfortran.dg/goacc/if.f95
create mode 100644 gcc/testsuite/gfortran.dg/goacc/kernels-tree.f95
create mode 100644 gcc/testsuite/gfortran.dg/goacc/list.f95
create mode 100644 gcc/testsuite/gfortran.dg/goacc/literal.f95
create mode 100644 gcc/testsuite/gfortran.dg/goacc/loop-1.f95
create mode 100644 gcc/testsuite/gfortran.dg/goacc/loop-2.f95
create mode 100644 gcc/testsuite/gfortran.dg/goacc/loop-3.f95
create mode 100644 gcc/testsuite/gfortran.dg/goacc/omp.f95
create mode 100644 gcc/testsuite/gfortran.dg/goacc/parallel-kernels-clauses.f95
create mode 100644 gcc/testsuite/gfortran.dg/goacc/parallel-kernels-regions.f95
create mode 100644 gcc/testsuite/gfortran.dg/goacc/parallel-tree.f95
create mode 100644 gcc/testsuite/gfortran.dg/goacc/parameter.f95
create mode 100644 gcc/testsuite/gfortran.dg/goacc/pure-elemental-procedures.f95
create mode 100644 gcc/testsuite/gfortran.dg/goacc/reduction.f95
create mode 100644 gcc/testsuite/gfortran.dg/goacc/sentinel-free-form.f95
create mode 100644 gcc/testsuite/gfortran.dg/goacc/several-directives.f95
create mode 100644 gcc/testsuite/gfortran.dg/goacc/sie.f95
diff --git a/gcc/testsuite/gfortran.dg/goacc/assumed.f95 b/gcc/testsuite/gfortran.dg/goacc/assumed.f95
new file mode 100644
index 0000000..4f6c23f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/assumed.f95
@@ -0,0 +1,66 @@
+! { dg-do compile }
+! { dg-additional-options "-fmax-errors=100" }
+
+module test
+contains
+ subroutine assumed_size(a)
+ implicit none
+ integer :: a(*), i
+ !$acc declare device_resident (a) ! { dg-error "Assumed size" }
+ !$acc data copy (a) ! { dg-error "Assumed size" }
+ !$acc end data
+ !$acc data deviceptr (a) ! { dg-error "Assumed size" }
+ !$acc end data
+ !$acc parallel private (a) ! { dg-error "Assumed size" }
+ !$acc end parallel
+ !$acc host_data use_device (a) ! { dg-error "Assumed size" }
+ !$acc end host_data
+ !$acc parallel loop reduction(+:a) ! { dg-error "Assumed size" }
+ do i = 1,5
+ enddo
+ !$acc end parallel loop
+ !$acc update host (a) ! { dg-error "Assumed size" }
+ !$acc update device (a) ! { dg-error "Assumed size" }
+ end subroutine assumed_size
+
+ subroutine assumed_shape(a)
+ implicit none
+ integer :: a(:), i
+ !$acc declare device_resident (a) ! { dg-error "Assumed shape" }
+ !$acc data copy (a) ! { dg-error "Assumed shape" }
+ !$acc end data
+ !$acc data deviceptr (a) ! { dg-error "Assumed shape" }
+ !$acc end data
+ !$acc parallel private (a) ! { dg-error "Assumed shape" }
+ !$acc end parallel
+ !$acc host_data use_device (a) ! { dg-error "Assumed shape" }
+ !$acc end host_data
+ !$acc parallel loop reduction(+:a) ! { dg-error "Assumed shape" }
+ do i = 1,5
+ enddo
+ !$acc end parallel loop
+ !$acc update host (a) ! { dg-error "Assumed shape" }
+ !$acc update device (a) ! { dg-error "Assumed shape" }
+ end subroutine assumed_shape
+
+ subroutine assumed_rank(a)
+ implicit none
+ integer, intent(in) :: a(..)
+ integer :: i
+ !$acc declare device_resident (a) ! { dg-error "Assumed rank" }
+ !$acc data copy (a) ! { dg-error "Assumed rank" }
+ !$acc end data
+ !$acc data deviceptr (a) ! { dg-error "Assumed rank" }
+ !$acc end data
+ !$acc parallel private (a) ! { dg-error "Assumed rank" }
+ !$acc end parallel
+ !$acc host_data use_device (a) ! { dg-error "Assumed rank" }
+ !$acc end host_data
+ !$acc parallel loop reduction(+:a) ! { dg-error "Assumed rank" }
+ do i = 1,5
+ enddo
+ !$acc end parallel loop
+ !$acc update host (a) ! { dg-error "Assumed rank" }
+ !$acc update device (a) ! { dg-error "Assumed rank" }
+ end subroutine assumed_rank
+end module test
\ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/goacc/branch.f95 b/gcc/testsuite/gfortran.dg/goacc/branch.f95
new file mode 100644
index 0000000..7eed3e2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/branch.f95
@@ -0,0 +1,53 @@
+! { dg-do compile }
+
+program test
+ implicit none
+
+ integer :: i
+
+ if (.true.) then
+ !$acc parallel
+ end if ! { dg-error "Unexpected" }
+ !$acc end parallel
+ end if
+
+ if (.true.) then
+ !$acc kernels
+ end if ! { dg-error "Unexpected" }
+ !$acc end kernels
+ end if
+
+ !$acc parallel
+ if (.true.) then
+ !$acc end parallel ! { dg-error "Unexpected" }
+ end if
+ !$acc end parallel
+
+ !$acc kernels
+ if (.true.) then
+ !$acc end kernels ! { dg-error "Unexpected" }
+ end if
+ !$acc end kernels
+
+ !$acc parallel
+ if (.true.) then
+ end if
+ !$acc end parallel
+
+ !$acc kernels
+ if (.true.) then
+ end if
+ !$acc end kernels
+
+ if (.true.) then
+ !$acc parallel
+ !$acc end parallel
+ end if
+
+ if (.true.) then
+ !$acc kernels
+ !$acc end kernels
+ end if
+
+
+end program test
\ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/goacc/coarray.f95 b/gcc/testsuite/gfortran.dg/goacc/coarray.f95
new file mode 100644
index 0000000..7afb4bc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/coarray.f95
@@ -0,0 +1,35 @@
+! { dg-do compile }
+! { dg-additional-options "-fcoarray=single" }
+
+! TODO: These cases must fail
+
+module test
+contains
+ subroutine oacc1(a)
+ implicit none
+ integer :: i
+ integer, codimension[*] :: a
+ !$acc declare device_resident (a)
+ !$acc data copy (a)
+ !$acc end data
+ !$acc data deviceptr (a)
+ !$acc end data
+ !$acc parallel private (a)
+ !$acc end parallel
+ !$acc host_data use_device (a)
+ !$acc end host_data
+ !$acc parallel loop reduction(+:a)
+ do i = 1,5
+ enddo
+ !$acc end parallel loop
+ !$acc parallel loop
+ do i = 1,5
+ !$acc cache (a)
+ enddo
+ !$acc end parallel loop
+ !$acc update host (a)
+ !$acc update device (a)
+ end subroutine oacc1
+end module test
+! { dg-excess-errors "Unimplemented" }
+! { dg-excess-errors "ACC LOOP" }
\ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/goacc/continuation-free-form.f95 b/gcc/testsuite/gfortran.dg/goacc/continuation-free-form.f95
new file mode 100644
index 0000000..1c9a3f3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/continuation-free-form.f95
@@ -0,0 +1,23 @@
+! { dg-do compile }
+
+program test
+ implicit none
+
+ integer :: i
+ real :: x
+
+ !$acc parallel &
+ !$acc loop & ! continuation
+ !$acc & reduction(+:x)
+
+ ! this line must be ignored
+ !$acc ! kernels
+ do i = 1,10
+ x = x + 0.3
+ enddo
+ ! continuation must begin with sentinel
+ !$acc end parallel & ! { dg-error "Unclassifiable OpenACC directive" }
+ ! loop
+
+ print *, x
+end
\ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/goacc/cray.f95 b/gcc/testsuite/gfortran.dg/goacc/cray.f95
new file mode 100644
index 0000000..509f61b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/cray.f95
@@ -0,0 +1,54 @@
+! { dg-do compile }
+! { dg-additional-options "-fcray-pointer" }
+
+module test
+contains
+ subroutine oacc1
+ implicit none
+ integer :: i
+ real :: pointee
+ pointer (ptr, pointee)
+ !$acc declare device_resident (pointee)
+ !$acc declare device_resident (ptr)
+ !$acc data copy (pointee) ! { dg-error "Cray pointee" }
+ !$acc end data
+ !$acc data deviceptr (pointee) ! { dg-error "Cray pointee" }
+ !$acc end data
+ !$acc parallel private (pointee) ! { dg-error "Cray pointee" }
+ !$acc end parallel
+ !$acc host_data use_device (pointee) ! { dg-error "Cray pointee" }
+ !$acc end host_data
+ !$acc parallel loop reduction(+:pointee) ! { dg-error "Cray pointee" }
+ do i = 1,5
+ enddo
+ !$acc end parallel loop
+ !$acc parallel loop
+ do i = 1,5
+ ! Subarrays are not implemented yet
+ !$acc cache (pointee) ! TODO: This must fail, as in openacc-1_0-branch
+ enddo
+ !$acc end parallel loop
+ !$acc update host (pointee) ! { dg-error "Cray pointee" }
+ !$acc update device (pointee) ! { dg-error "Cray pointee" }
+ !$acc data copy (ptr)
+ !$acc end data
+ !$acc data deviceptr (ptr) ! { dg-error "Cray pointer" }
+ !$acc end data
+ !$acc parallel private (ptr)
+ !$acc end parallel
+ !$acc host_data use_device (ptr) ! { dg-error "Cray pointer" }
+ !$acc end host_data
+ !$acc parallel loop reduction(+:ptr) ! { dg-error "Cray pointer" }
+ do i = 1,5
+ enddo
+ !$acc end parallel loop
+ !$acc parallel loop
+ do i = 1,5
+ !$acc cache (ptr) ! TODO: This must fail, as in openacc-1_0-branch
+ enddo
+ !$acc end parallel loop
+ !$acc update host (ptr)
+ !$acc update device (ptr)
+ end subroutine oacc1
+end module test
+! { dg-excess-errors "unimplemented" }
\ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/goacc/critical.f95 b/gcc/testsuite/gfortran.dg/goacc/critical.f95
new file mode 100644
index 0000000..510ea18
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/critical.f95
@@ -0,0 +1,27 @@
+! { dg-do compile }
+! { dg-additional-options "-fcoarray=single" }
+
+module test
+contains
+ subroutine oacc1
+ implicit none
+ integer :: i, j
+ j = 0
+ !$acc parallel
+ critical ! { dg-error "CRITICAL block inside of" }
+ j = j + 1
+ end critical
+ !$acc end parallel
+ end subroutine oacc1
+
+ subroutine oacc2
+ implicit none
+ integer :: i, j
+ j = 0
+ critical
+ !$acc parallel ! { dg-error "OpenACC directive inside of" }
+ j = j + 1
+ !$acc end parallel
+ end critical
+ end subroutine oacc2
+end module test
\ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/goacc/data-clauses.f95 b/gcc/testsuite/gfortran.dg/goacc/data-clauses.f95
new file mode 100644
index 0000000..b65d61d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/data-clauses.f95
@@ -0,0 +1,259 @@
+! { dg-do compile }
+! { dg-additional-options "-fmax-errors=100" }
+
+module test
+ implicit none
+contains
+
+ subroutine foo (vi)
+ integer, value :: vi
+ integer :: i, ia(10)
+ complex :: c, ca(10)
+ real, target:: r
+ real :: ra(10)
+ real, pointer :: rp
+ real, dimension(:), allocatable :: aa
+ type t
+ integer :: i
+ end type
+ type(t) :: ti
+ type(t), allocatable :: tia
+ type(t), target :: tit
+ type(t), pointer :: tip
+ rp => r
+ tip => tit
+
+ !$acc parallel deviceptr (rp) ! { dg-error "POINTER" }
+ !$acc end parallel
+ !$acc parallel deviceptr (vi) ! { dg-error "VALUE" }
+ !$acc end parallel
+ !$acc parallel deviceptr (aa) ! { dg-error "ALLOCATABLE" }
+ !$acc end parallel
+
+ !$acc parallel deviceptr (i, c, r, ia, ca, ra, ti)
+ !$acc end parallel
+ !$acc kernels deviceptr (i, c, r, ia, ca, ra, ti)
+ !$acc end kernels
+ !$acc data deviceptr (i, c, r, ia, ca, ra, ti)
+ !$acc end data
+
+
+ !$acc parallel copy (tip) ! { dg-error "POINTER" }
+ !$acc end parallel
+ !$acc parallel copy (tia) ! { dg-error "ALLOCATABLE" }
+ !$acc end parallel
+ !$acc parallel deviceptr (i) copy (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+
+ !$acc parallel copy (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end parallel
+ !$acc kernels copy (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end kernels
+ !$acc data copy (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end data
+
+
+ !$acc parallel copyin (tip) ! { dg-error "POINTER" }
+ !$acc end parallel
+ !$acc parallel copyin (tia) ! { dg-error "ALLOCATABLE" }
+ !$acc end parallel
+ !$acc parallel deviceptr (i) copyin (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel copy (i) copyin (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+
+ !$acc parallel copyin (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end parallel
+ !$acc kernels copyin (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end kernels
+ !$acc data copyin (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end data
+
+
+ !$acc parallel copyout (tip) ! { dg-error "POINTER" }
+ !$acc end parallel
+ !$acc parallel copyout (tia) ! { dg-error "ALLOCATABLE" }
+ !$acc end parallel
+ !$acc parallel deviceptr (i) copyout (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel copy (i) copyout (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel copyin (i) copyout (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+
+ !$acc parallel copyout (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end parallel
+ !$acc kernels copyout (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end kernels
+ !$acc data copyout (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end data
+
+
+ !$acc parallel create (tip) ! { dg-error "POINTER" }
+ !$acc end parallel
+ !$acc parallel create (tia) ! { dg-error "ALLOCATABLE" }
+ !$acc end parallel
+ !$acc parallel deviceptr (i) create (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel copy (i) create (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel copyin (i) create (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel copyout (i) create (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+
+ !$acc parallel create (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end parallel
+ !$acc kernels create (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end kernels
+ !$acc data create (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end data
+
+
+ !$acc parallel present (tip) ! { dg-error "POINTER" }
+ !$acc end parallel
+ !$acc parallel present (tia) ! { dg-error "ALLOCATABLE" }
+ !$acc end parallel
+ !$acc parallel deviceptr (i) present (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel copy (i) present (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel copyin (i) present (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel copyout (i) present (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel create (i) present (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+
+ !$acc parallel present (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end parallel
+ !$acc kernels present (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end kernels
+ !$acc data present (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end data
+
+
+ !$acc parallel pcopy (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end parallel
+ !$acc parallel pcopyin (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end parallel
+ !$acc parallel pcopyout (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end parallel
+ !$acc parallel pcreate (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end parallel
+
+
+ !$acc parallel present_or_copy (tip) ! { dg-error "POINTER" }
+ !$acc end parallel
+ !$acc parallel present_or_copy (tia) ! { dg-error "ALLOCATABLE" }
+ !$acc end parallel
+ !$acc parallel deviceptr (i) present_or_copy (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel copy (i) present_or_copy (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel copyin (i) present_or_copy (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel copyout (i) present_or_copy (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel create (i) present_or_copy (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel present (i) present_or_copy (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+
+ !$acc parallel present_or_copy (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end parallel
+ !$acc kernels present_or_copy (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end kernels
+ !$acc data present_or_copy (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end data
+
+
+ !$acc parallel present_or_copyin (tip) ! { dg-error "POINTER" }
+ !$acc end parallel
+ !$acc parallel present_or_copyin (tia) ! { dg-error "ALLOCATABLE" }
+ !$acc end parallel
+ !$acc parallel deviceptr (i) present_or_copyin (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel copy (i) present_or_copyin (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel copyin (i) present_or_copyin (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel copyout (i) present_or_copyin (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel create (i) present_or_copyin (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel present (i) present_or_copyin (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel present_or_copy (i) present_or_copyin (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+
+ !$acc parallel present_or_copyin (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end parallel
+ !$acc kernels present_or_copyin (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end kernels
+ !$acc data present_or_copyin (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end data
+
+
+ !$acc parallel present_or_copyout (tip) ! { dg-error "POINTER" }
+ !$acc end parallel
+ !$acc parallel present_or_copyout (tia) ! { dg-error "ALLOCATABLE" }
+ !$acc end parallel
+ !$acc parallel deviceptr (i) present_or_copyout (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel copy (i) present_or_copyout (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel copyin (i) present_or_copyout (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel copyout (i) present_or_copyout (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel create (i) present_or_copyout (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel present (i) present_or_copyout (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel present_or_copy (i) present_or_copyout (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel present_or_copyin (i) present_or_copyout (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+
+ !$acc parallel present_or_copyout (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end parallel
+ !$acc kernels present_or_copyout (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end kernels
+ !$acc data present_or_copyout (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end data
+
+
+ !$acc parallel present_or_create (tip) ! { dg-error "POINTER" }
+ !$acc end parallel
+ !$acc parallel present_or_create (tia) ! { dg-error "ALLOCATABLE" }
+ !$acc end parallel
+ !$acc parallel deviceptr (i) present_or_create (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel copy (i) present_or_create (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel copyin (i) present_or_create (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel copyout (i) present_or_create (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel create (i) present_or_create (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel present (i) present_or_create (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel present_or_copy (i) present_or_create (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel present_or_copyin (i) present_or_create (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+ !$acc parallel present_or_copyout (i) present_or_create (i) ! { dg-error "multiple clauses" }
+ !$acc end parallel
+
+ !$acc parallel present_or_create (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end parallel
+ !$acc kernels present_or_create (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end kernels
+ !$acc data present_or_create (i, c, r, ia, ca, ra, rp, ti, vi, aa)
+ !$acc end data
+
+ end subroutine foo
+
+end module test
\ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/goacc/data-tree.f95 b/gcc/testsuite/gfortran.dg/goacc/data-tree.f95
new file mode 100644
index 0000000..d29c060
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/data-tree.f95
@@ -0,0 +1,31 @@
+! { dg-do compile }
+! { dg-additional-options "-fdump-tree-original" }
+
+program test
+ implicit none
+ integer :: q, i, j, k, m, n, o, p, r, s, t, u, v, w
+ logical :: l
+
+ !$acc data if(l) copy(i), copyin(j), copyout(k), create(m) &
+ !$acc present(o), pcopy(p), pcopyin(r), pcopyout(s), pcreate(t) &
+ !$acc deviceptr(u)
+ !$acc end data
+
+end program test
+! { dg-excess-errors "unimplemented" }
+! { dg-final { scan-tree-dump-times "pragma acc data" 1 "original" } }
+
+! { dg-final { scan-tree-dump-times "if" 1 "original" } }
+! { dg-final { scan-tree-dump-times "map\\(force_tofrom:i\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "map\\(force_to:j\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "map\\(force_from:k\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "map\\(force_alloc:m\\)" 1 "original" } }
+
+! { dg-final { scan-tree-dump-times "map\\(force_present:o\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "map\\(tofrom:p\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "map\\(to:r\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "map\\(from:s\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "map\\(alloc:t\\)" 1 "original" } }
+
+! { dg-final { scan-tree-dump-times "map\\(force_deviceptr:u\\)" 1 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
\ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/goacc/declare-1.f95 b/gcc/testsuite/gfortran.dg/goacc/declare-1.f95
new file mode 100644
index 0000000..aec3ae8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/declare-1.f95
@@ -0,0 +1,20 @@
+! { dg-do compile }
+! { dg-additional-options "-fdump-tree-original" }
+
+program test
+ implicit none
+ integer :: i
+
+ !$acc declare copy(i)
+contains
+ real function foo(n)
+ integer, value :: n
+ BLOCK
+ integer i
+ !$acc declare copy(i)
+ END BLOCK
+ end function foo
+end program test
+! { dg-excess-errors "unimplemented" }
+! { dg-final { scan-tree-dump-times "pragma acc declare map\\(force_tofrom:i\\)" 2 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
diff --git a/gcc/testsuite/gfortran.dg/goacc/enter-exit-data.f95 b/gcc/testsuite/gfortran.dg/goacc/enter-exit-data.f95
new file mode 100644
index 0000000..8f1715e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/enter-exit-data.f95
@@ -0,0 +1,88 @@
+! { dg-do compile }
+! { dg-additional-options "-fmax-errors=100" }
+
+module test
+ implicit none
+contains
+
+ subroutine foo (vi)
+ logical :: l
+ integer, value :: vi
+ integer :: i, ia(10), a(10), b(2:8)
+ complex :: c, ca(10)
+ real, target:: r
+ real :: ra(10)
+ real, pointer :: rp
+ real, dimension(:), allocatable :: aa
+ type t
+ integer :: i
+ end type
+ type(t) :: ti
+ type(t), allocatable :: tia
+ type(t), target :: tit
+ type(t), pointer :: tip
+ rp => r
+ tip => tit
+
+ ! enter data
+ !$acc enter data
+ !$acc enter data if (.false.)
+ !$acc enter data if (l)
+ !$acc enter data if (.false.) if (l) ! { dg-error "Unclassifiable" }
+ !$acc enter data if (i) ! { dg-error "LOGICAL" }
+ !$acc enter data if (1) ! { dg-error "LOGICAL" }
+ !$acc enter data if (a) ! { dg-error "LOGICAL" }
+ !$acc enter data if (b(5:6)) ! { dg-error "LOGICAL" }
+ !$acc enter data async (l) ! { dg-error "INTEGER" }
+ !$acc enter data async (.true.) ! { dg-error "INTEGER" }
+ !$acc enter data async (1)
+ !$acc enter data async (i)
+ !$acc enter data async (a) ! { dg-error "INTEGER" }
+ !$acc enter data async (b(5:6)) ! { dg-error "INTEGER" }
+ !$acc enter data wait (l) ! { dg-error "INTEGER" }
+ !$acc enter data wait (.true.) ! { dg-error "INTEGER" }
+ !$acc enter data wait (i, 1)
+ !$acc enter data wait (a) ! { dg-error "INTEGER" }
+ !$acc enter data wait (b(5:6)) ! { dg-error "INTEGER" }
+ !$acc enter data copyin (tip) ! { dg-error "POINTER" }
+ !$acc enter data copyin (tia) ! { dg-error "ALLOCATABLE" }
+ !$acc enter data create (tip) ! { dg-error "POINTER" }
+ !$acc enter data create (tia) ! { dg-error "ALLOCATABLE" }
+ !$acc enter data present_or_copyin (tip) ! { dg-error "POINTER" }
+ !$acc enter data present_or_copyin (tia) ! { dg-error "ALLOCATABLE" }
+ !$acc enter data present_or_create (tip) ! { dg-error "POINTER" }
+ !$acc enter data present_or_create (tia) ! { dg-error "ALLOCATABLE" }
+ !$acc enter data copyin (i) create (i) ! { dg-error "multiple clauses" }
+ !$acc enter data copyin (i) present_or_copyin (i) ! { dg-error "multiple clauses" }
+ !$acc enter data create (i) present_or_copyin (i) ! { dg-error "multiple clauses" }
+ !$acc enter data copyin (i) present_or_create (i) ! { dg-error "multiple clauses" }
+ !$acc enter data create (i) present_or_create (i) ! { dg-error "multiple clauses" }
+ !$acc enter data present_or_copyin (i) present_or_create (i) ! { dg-error "multiple clauses" }
+
+ ! exit data
+ !$acc exit data
+ !$acc exit data if (.false.)
+ !$acc exit data if (l)
+ !$acc exit data if (.false.) if (l) ! { dg-error "Unclassifiable" }
+ !$acc exit data if (i) ! { dg-error "LOGICAL" }
+ !$acc exit data if (1) ! { dg-error "LOGICAL" }
+ !$acc exit data if (a) ! { dg-error "LOGICAL" }
+ !$acc exit data if (b(5:6)) ! { dg-error "LOGICAL" }
+ !$acc exit data async (l) ! { dg-error "INTEGER" }
+ !$acc exit data async (.true.) ! { dg-error "INTEGER" }
+ !$acc exit data async (1)
+ !$acc exit data async (i)
+ !$acc exit data async (a) ! { dg-error "INTEGER" }
+ !$acc exit data async (b(5:6)) ! { dg-error "INTEGER" }
+ !$acc exit data wait (l) ! { dg-error "INTEGER" }
+ !$acc exit data wait (.true.) ! { dg-error "INTEGER" }
+ !$acc exit data wait (i, 1)
+ !$acc exit data wait (a) ! { dg-error "INTEGER" }
+ !$acc exit data wait (b(5:6)) ! { dg-error "INTEGER" }
+ !$acc exit data copyout (tip) ! { dg-error "POINTER" }
+ !$acc exit data copyout (tia) ! { dg-error "ALLOCATABLE" }
+ !$acc exit data delete (tip) ! { dg-error "POINTER" }
+ !$acc exit data delete (tia) ! { dg-error "ALLOCATABLE" }
+ !$acc exit data copyout (i) delete (i) ! { dg-error "multiple clauses" }
+ end subroutine foo
+end module test
diff --git a/gcc/testsuite/gfortran.dg/goacc/goacc.exp b/gcc/testsuite/gfortran.dg/goacc/goacc.exp
new file mode 100644
index 0000000..96530d2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/goacc.exp
@@ -0,0 +1,36 @@
+# Copyright (C) 2005-2013 Free Software Foundation, Inc.
+#
+# This file is part of GCC.
+#
+# GCC is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3, or (at your option)
+# any later version.
+#
+# GCC is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with GCC; see the file COPYING3. If not see
+# <http://www.gnu.org/licenses/>.
+
+# GCC testsuite that uses the `dg.exp' driver.
+
+# Load support procs.
+load_lib gfortran-dg.exp
+
+if ![check_effective_target_fopenacc] {
+ return
+}
+
+# Initialize `dg'.
+dg-init
+
+# Main loop.
+gfortran-dg-runtest [lsort \
+ [find $srcdir/$subdir *.\[fF\]{,90,95,03,08} ] ] " -fopenacc"
+
+# All done.
+dg-finish
diff --git a/gcc/testsuite/gfortran.dg/goacc/host_data-tree.f95 b/gcc/testsuite/gfortran.dg/goacc/host_data-tree.f95
new file mode 100644
index 0000000..1c24fe7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/host_data-tree.f95
@@ -0,0 +1,13 @@
+! { dg-do compile }
+! { dg-additional-options "-fdump-tree-original" }
+
+program test
+ implicit none
+ integer :: i
+
+ !$acc host_data use_device(i)
+ !$acc end host_data
+end program test
+! { dg-excess-errors "unimplemented" }
+! { dg-final { scan-tree-dump-times "pragma acc host_data use_device\\(i\\)" 1 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
diff --git a/gcc/testsuite/gfortran.dg/goacc/if.f95 b/gcc/testsuite/gfortran.dg/goacc/if.f95
new file mode 100644
index 0000000..a45035d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/if.f95
@@ -0,0 +1,52 @@
+! { dg-do compile }
+
+program test
+ implicit none
+
+ logical :: x
+ integer :: i
+
+ !$acc parallel if ! { dg-error "Unclassifiable OpenACC directive" }
+ !$acc parallel if () ! { dg-error "Invalid character" }
+ !$acc parallel if (i) ! { dg-error "scalar LOGICAL expression" }
+ !$acc end parallel
+ !$acc parallel if (1) ! { dg-error "scalar LOGICAL expression" }
+ !$acc end parallel
+ !$acc kernels if (i) ! { dg-error "scalar LOGICAL expression" }
+ !$acc end kernels
+ !$acc kernels if ! { dg-error "Unclassifiable OpenACC directive" }
+ !$acc kernels if () ! { dg-error "Invalid character" }
+ !$acc kernels if (1) ! { dg-error "scalar LOGICAL expression" }
+ !$acc end kernels
+ !$acc data if ! { dg-error "Unclassifiable OpenACC directive" }
+ !$acc data if () ! { dg-error "Invalid character" }
+ !$acc data if (i) ! { dg-error "scalar LOGICAL expression" }
+ !$acc end data
+ !$acc data if (1) ! { dg-error "scalar LOGICAL expression" }
+ !$acc end data
+
+ ! at most one if clause may appear
+ !$acc parallel if (.false.) if (.false.) { dg-error "Unclassifiable OpenACC directive" }
+ !$acc kernels if (.false.) if (.false.) { dg-error "Unclassifiable OpenACC directive" }
+ !$acc data if (.false.) if (.false.) { dg-error "Unclassifiable OpenACC directive" }
+
+ !$acc parallel if (x)
+ !$acc end parallel
+ !$acc parallel if (.true.)
+ !$acc end parallel
+ !$acc parallel if (i.gt.1)
+ !$acc end parallel
+ !$acc kernels if (x)
+ !$acc end kernels
+ !$acc kernels if (.true.)
+ !$acc end kernels
+ !$acc kernels if (i.gt.1)
+ !$acc end kernels
+ !$acc data if (x)
+ !$acc end data
+ !$acc data if (.true.)
+ !$acc end data
+ !$acc data if (i.gt.1)
+ !$acc end data
+
+end program test
\ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/goacc/kernels-tree.f95 b/gcc/testsuite/gfortran.dg/goacc/kernels-tree.f95
new file mode 100644
index 0000000..5c65d2a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/kernels-tree.f95
@@ -0,0 +1,33 @@
+! { dg-do compile }
+! { dg-additional-options "-fdump-tree-original" }
+
+program test
+ implicit none
+ integer :: q, i, j, k, m, n, o, p, r, s, t, u, v, w
+ logical :: l
+
+ !$acc kernels if(l) async copy(i), copyin(j), copyout(k), create(m) &
+ !$acc present(o), pcopy(p), pcopyin(r), pcopyout(s), pcreate(t) &
+ !$acc deviceptr(u)
+ !$acc end kernels
+
+end program test
+! { dg-excess-errors "unimplemented" }
+! { dg-final { scan-tree-dump-times "pragma acc kernels" 1 "original" } }
+
+! { dg-final { scan-tree-dump-times "if" 1 "original" } }
+! { dg-final { scan-tree-dump-times "async" 1 "original" } }
+
+! { dg-final { scan-tree-dump-times "map\\(force_tofrom:i\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "map\\(force_to:j\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "map\\(force_from:k\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "map\\(force_alloc:m\\)" 1 "original" } }
+
+! { dg-final { scan-tree-dump-times "map\\(force_present:o\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "map\\(tofrom:p\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "map\\(to:r\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "map\\(from:s\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "map\\(alloc:t\\)" 1 "original" } }
+
+! { dg-final { scan-tree-dump-times "map\\(force_deviceptr:u\\)" 1 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
diff --git a/gcc/testsuite/gfortran.dg/goacc/list.f95 b/gcc/testsuite/gfortran.dg/goacc/list.f95
new file mode 100644
index 0000000..94fdadd
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/list.f95
@@ -0,0 +1,111 @@
+! { dg-do compile }
+! { dg-additional-options "-fmax-errors=100" }
+
+program test
+ implicit none
+
+ integer :: i, j, k, l, a(10)
+ common /b/ j, k
+ real, pointer :: p1 => NULL()
+ complex :: c, d(10)
+
+ !$acc parallel private(i)
+ !$acc end parallel
+
+ !$acc parallel private(a)
+ !$acc end parallel
+
+ !$acc parallel private(c, d)
+ !$acc end parallel
+
+ !$acc parallel private(i, j, k, l, a)
+ !$acc end parallel
+
+ !$acc parallel private (i) private (j)
+ !$acc end parallel
+
+ !$acc parallel private ! { dg-error "Unclassifiable OpenACC directive" }
+
+ !$acc parallel private() ! { dg-error "Syntax error" }
+
+ !$acc parallel private(a(1:3)) ! { dg-error "Syntax error" }
+
+ !$acc parallel private(10) ! { dg-error "Syntax error" }
+
+ !$acc parallel private(/b/, /b/) ! { dg-error "present on multiple clauses" }
+ !$acc end parallel
+
+ !$acc parallel private(i, j, i) ! { dg-error "present on multiple clauses" }
+ !$acc end parallel
+
+ !$acc parallel private(p1)
+ !$acc end parallel
+
+ !$acc parallel firstprivate(i)
+ !$acc end parallel
+
+ !$acc parallel firstprivate(c, d)
+ !$acc end parallel
+
+ !$acc parallel firstprivate(a)
+ !$acc end parallel
+
+ !$acc parallel firstprivate(i, j, k, l, a)
+ !$acc end parallel
+
+ !$acc parallel firstprivate (i) firstprivate (j)
+ !$acc end parallel
+
+ !$acc parallel firstprivate ! { dg-error "Unclassifiable OpenACC directive" }
+
+ !$acc parallel firstprivate() ! { dg-error "Syntax error" }
+
+ !$acc parallel firstprivate(a(1:3)) ! { dg-error "Syntax error" }
+
+ !$acc parallel firstprivate(10) ! { dg-error "Syntax error" }
+
+ !$acc parallel firstprivate (/b/, /b/) ! { dg-error "present on multiple clauses" }
+ !$acc end parallel
+
+ !$acc parallel firstprivate (i, j, i) ! { dg-error "present on multiple clauses" }
+ !$acc end parallel
+
+ !$acc parallel firstprivate(p1)
+ !$acc end parallel
+
+ !$acc parallel private (i) firstprivate (i) ! { dg-error "present on multiple clauses" }
+ !$acc end parallel
+
+ !$acc host_data use_device(i)
+ !$acc end host_data
+
+ !$acc host_data use_device(c, d)
+ !$acc end host_data
+
+ !$acc host_data use_device(a)
+ !$acc end host_data
+
+ !$acc host_data use_device(i, j, k, l, a)
+ !$acc end host_data
+
+ !$acc host_data use_device (i) use_device (j)
+ !$acc end host_data
+
+ !$acc host_data use_device ! { dg-error "Unclassifiable OpenACC directive" }
+
+ !$acc host_data use_device() ! { dg-error "Syntax error" }
+
+ !$acc host_data use_device(a(1:3)) ! { dg-error "Syntax error" }
+
+ !$acc host_data use_device(10) ! { dg-error "Syntax error" }
+
+ !$acc host_data use_device(/b/, /b/) ! { dg-error "present on multiple clauses" }
+ !$acc end host_data
+
+ !$acc host_data use_device(i, j, i) ! { dg-error "present on multiple clauses" }
+ !$acc end host_data
+
+ !$acc host_data use_device(p1) ! { dg-error "POINTER" }
+ !$acc end host_data
+
+end program test
\ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/goacc/literal.f95 b/gcc/testsuite/gfortran.dg/goacc/literal.f95
new file mode 100644
index 0000000..bdbf66d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/literal.f95
@@ -0,0 +1,29 @@
+! { dg-do compile }
+
+module test
+contains
+ subroutine oacc1
+ implicit none
+ integer :: i
+ !$acc declare device_resident (10) ! { dg-error "Syntax error" }
+ !$acc data copy (10) ! { dg-error "Syntax error" }
+ !$acc end data ! { dg-error "Unexpected" }
+ !$acc data deviceptr (10) ! { dg-error "Syntax error" }
+ !$acc end data ! { dg-error "Unexpected" }
+ !$acc data private (10) ! { dg-error "Unclassifiable" }
+ !$acc end data ! { dg-error "Unexpected" }
+ !$acc host_data use_device (10) ! { dg-error "Syntax error" }
+ !$acc end host_data ! { dg-error "Unexpected" }
+ !$acc parallel loop reduction(+:10) ! { dg-error "Syntax error" }
+ do i = 1,5
+ enddo
+ !$acc end parallel loop ! { dg-error "Unexpected" }
+ !$acc parallel loop
+ do i = 1,5
+ !$acc cache (10) ! { dg-error "Syntax error" }
+ enddo
+ !$acc end parallel loop
+ !$acc update host (10) ! { dg-error "Syntax error" }
+ !$acc update device (10) ! { dg-error "Syntax error" }
+ end subroutine oacc1
+end module test
\ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/goacc/loop-1.f95 b/gcc/testsuite/gfortran.dg/goacc/loop-1.f95
new file mode 100644
index 0000000..af4f537
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/loop-1.f95
@@ -0,0 +1,170 @@
+! { dg-do compile }
+! { dg-additional-options "-fmax-errors=100" }
+module test
+ implicit none
+contains
+
+subroutine test1
+ integer :: i, j, k, b(10)
+ integer, dimension (30) :: a
+ double precision :: d
+ real :: r
+ i = 0
+ !$acc loop
+ do 100 ! { dg-error "cannot be a DO WHILE or DO without loop control" }
+ if (i .gt. 0) exit ! { dg-error "EXIT statement" }
+ 100 i = i + 1
+ i = 0
+ !$acc loop
+ do ! { dg-error "cannot be a DO WHILE or DO without loop control" }
+ if (i .gt. 0) exit ! { dg-error "EXIT statement" }
+ i = i + 1
+ end do
+ i = 0
+ !$acc loop
+ do 200 while (i .lt. 4) ! { dg-error "cannot be a DO WHILE or DO without loop control" }
+ 200 i = i + 1
+ !$acc loop
+ do while (i .lt. 8) ! { dg-error "cannot be a DO WHILE or DO without loop control" }
+ i = i + 1
+ end do
+ !$acc loop
+ do 300 d = 1, 30, 6 ! { dg-error "integer" }
+ i = d
+ 300 a(i) = 1
+ !$acc loop
+ do d = 1, 30, 5 ! { dg-error "integer" }
+ i = d
+ a(i) = 2
+ end do
+ !$acc loop
+ do i = 1, 30
+ if (i .eq. 16) exit ! { dg-error "EXIT statement" }
+ end do
+ !$acc loop
+ outer: do i = 1, 30
+ do j = 5, 10
+ if (i .eq. 6 .and. j .eq. 7) exit outer ! { dg-error "EXIT statement" }
+ end do
+ end do outer
+ last: do i = 1, 30
+ end do last
+
+ ! different types of loop are allowed
+ !$acc loop
+ do i = 1,10
+ end do
+ !$acc loop
+ do 400, i = 1,10
+400 a(i) = i
+
+ ! after loop directive must be loop
+ !$acc loop
+ a(1) = 1 ! { dg-error "Expected DO loop" }
+ do i = 1,10
+ enddo
+
+ ! combined directives may be used with/without end
+ !$acc parallel loop
+ do i = 1,10
+ enddo
+ !$acc parallel loop
+ do i = 1,10
+ enddo
+ !$acc end parallel loop
+ !$acc kernels loop
+ do i = 1,10
+ enddo
+ !$acc kernels loop
+ do i = 1,10
+ enddo
+ !$acc end kernels loop
+
+ !$acc kernels loop reduction(max:i)
+ do i = 1,10
+ enddo
+ !$acc kernels
+ !$acc loop reduction(max:i)
+ do i = 1,10
+ enddo
+ !$acc end kernels
+
+ !$acc parallel loop collapse(0) ! { dg-error "constant positive integer" }
+ do i = 1,10
+ enddo
+
+ !$acc parallel loop collapse(-1) ! { dg-error "constant positive integer" }
+ do i = 1,10
+ enddo
+
+ !$acc parallel loop collapse(i) ! { dg-error "Constant expression required" }
+ do i = 1,10
+ enddo
+
+ !$acc parallel loop collapse(4) ! { dg-error "not enough DO loops for collapsed" }
+ do i = 1, 3
+ do j = 4, 6
+ do k = 5, 7
+ a(i+j-k) = i + j + k
+ end do
+ end do
+ end do
+ !$acc parallel loop collapse(2)
+ do i = 1, 5, 2
+ do j = i + 1, 7, i ! { dg-error "collapsed loops don.t form rectangular iteration space" }
+ end do
+ end do
+ !$acc parallel loop collapse(2)
+ do i = 1, 3
+ do j = 4, 6
+ end do
+ end do
+ !$acc parallel loop collapse(2)
+ do i = 1, 3
+ do j = 4, 6
+ end do
+ k = 4
+ end do
+ !$acc parallel loop collapse(3-1)
+ do i = 1, 3
+ do j = 4, 6
+ end do
+ k = 4
+ end do
+ !$acc parallel loop collapse(1+1)
+ do i = 1, 3
+ do j = 4, 6
+ end do
+ k = 4
+ end do
+ !$acc parallel loop collapse(2)
+ do i = 1, 3
+ do ! { dg-error "cannot be a DO WHILE or DO without loop control" }
+ end do
+ end do
+ !$acc parallel loop collapse(2)
+ do i = 1, 3
+ do r = 4, 6 ! { dg-error "integer" }
+ end do
+ end do
+
+ ! Both seq and independent are not allowed
+ !$acc loop independent seq ! { dg-error "SEQ conflicts with INDEPENDENT" }
+ do i = 1,10
+ enddo
+
+
+ !$acc cache (a) ! { dg-error "inside of loop" }
+
+ do i = 1,10
+ !$acc cache(a)
+ enddo
+
+ do i = 1,10
+ a(i) = i
+ !$acc cache(a)
+ enddo
+
+end subroutine test1
+end module test
+! { dg-excess-errors "Deleted" }
diff --git a/gcc/testsuite/gfortran.dg/goacc/loop-2.f95 b/gcc/testsuite/gfortran.dg/goacc/loop-2.f95
new file mode 100644
index 0000000..f85691e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/loop-2.f95
@@ -0,0 +1,649 @@
+! { dg-do compile }
+! { dg-additional-options "-fmax-errors=100" }
+
+! TODO: nested kernels are allowed in 2.0
+
+program test
+ implicit none
+ integer :: i, j
+
+ !$acc kernels
+ !$acc loop auto
+ DO i = 1,10
+ ENDDO
+ !$acc loop gang
+ DO i = 1,10
+ ENDDO
+ !$acc loop gang(5)
+ DO i = 1,10
+ ENDDO
+ !$acc loop gang(num:5)
+ DO i = 1,10
+ ENDDO
+ !$acc loop gang(static:5)
+ DO i = 1,10
+ ENDDO
+ !$acc loop gang(static:*)
+ DO i = 1,10
+ ENDDO
+ !$acc loop gang
+ DO i = 1,10
+ !$acc loop vector
+ DO j = 1,10
+ ENDDO
+ !$acc loop worker
+ DO j = 1,10
+ ENDDO
+ !$acc loop gang ! { dg-error "not allowed" }
+ DO j = 1,10
+ ENDDO
+ ENDDO
+ !$acc loop seq gang ! { dg-error "conflicts with" }
+ 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:5)
+ DO i = 1,10
+ ENDDO
+ !$acc loop worker
+ DO i = 1,10
+ !$acc loop vector
+ DO j = 1,10
+ ENDDO
+ !$acc loop worker ! { dg-error "not allowed" }
+ DO j = 1,10
+ ENDDO
+ !$acc loop gang ! { dg-error "not allowed" }
+ DO j = 1,10
+ ENDDO
+ ENDDO
+ !$acc loop seq worker ! { dg-error "conflicts with" }
+ DO i = 1,10
+ ENDDO
+ !$acc loop gang worker ! { dg-error "conflicts with" }
+ DO i = 1,10
+ ENDDO
+
+ !$acc loop vector
+ DO i = 1,10
+ ENDDO
+ !$acc loop vector(5)
+ DO i = 1,10
+ ENDDO
+ !$acc loop vector(length:5)
+ DO i = 1,10
+ ENDDO
+ !$acc loop vector
+ DO i = 1,10
+ !$acc loop vector ! { dg-error "not allowed" }
+ DO j = 1,10
+ ENDDO
+ !$acc loop worker ! { dg-error "not allowed" }
+ DO j = 1,10
+ ENDDO
+ !$acc loop gang ! { dg-error "not allowed" }
+ DO j = 1,10
+ ENDDO
+ ENDDO
+ !$acc loop seq vector ! { dg-error "conflicts with" }
+ DO i = 1,10
+ ENDDO
+ !$acc loop gang vector ! { dg-error "conflicts with" }
+ DO i = 1,10
+ ENDDO
+ !$acc loop worker vector ! { dg-error "conflicts with" }
+ DO i = 1,10
+ ENDDO
+
+ !$acc loop auto
+ DO i = 1,10
+ ENDDO
+ !$acc loop seq auto ! { dg-error "conflicts with" }
+ DO i = 1,10
+ ENDDO
+ !$acc loop gang auto ! { dg-error "conflicts with" }
+ DO i = 1,10
+ ENDDO
+ !$acc loop worker auto ! { dg-error "conflicts with" }
+ DO i = 1,10
+ ENDDO
+ !$acc loop vector auto ! { dg-error "conflicts with" }
+ DO i = 1,10
+ ENDDO
+
+ !$acc loop tile ! { dg-error "Unclassifiable" }
+ DO i = 1,10
+ ENDDO
+ !$acc loop tile() ! { dg-error "Syntax error" }
+ DO i = 1,10
+ ENDDO
+ !$acc loop tile(1)
+ DO i = 1,10
+ ENDDO
+ !$acc loop tile(2)
+ DO i = 1,10
+ ENDDO
+ !$acc loop tile(6-2)
+ DO i = 1,10
+ ENDDO
+ !$acc loop tile(6+2)
+ DO i = 1,10
+ ENDDO
+ !$acc loop tile(*)
+ DO i = 1,10
+ ENDDO
+ !$acc loop tile(*, 1)
+ DO i = 1,10
+ DO j = 1,10
+ ENDDO
+ ENDDO
+ !$acc loop tile(-1) ! { dg-warning "must be positive" }
+ do i = 1,10
+ enddo
+ !$acc loop tile(i) ! { dg-error "constant expression" }
+ do i = 1,10
+ enddo
+ !$acc loop tile(2, 2, 1) ! { dg-error "not enough DO loops for tiled" }
+ do i = 1, 3
+ do j = 4, 6
+ end do
+ end do
+ !$acc loop tile(2, 2)
+ do i = 1, 5, 2
+ do j = i + 1, 7, i ! { dg-error "tiled loops don.t form rectangular iteration space" }
+ end do
+ end do
+ !$acc loop vector tile(*)
+ DO i = 1,10
+ ENDDO
+ !$acc loop worker tile(*)
+ DO i = 1,10
+ ENDDO
+ !$acc loop gang tile(*)
+ DO i = 1,10
+ ENDDO
+ !$acc loop vector gang tile(*)
+ DO i = 1,10
+ ENDDO
+ !$acc loop vector worker tile(*)
+ DO i = 1,10
+ ENDDO
+ !$acc loop gang worker tile(*)
+ DO i = 1,10
+ ENDDO
+ !$acc end kernels
+
+
+ !$acc parallel
+ !$acc loop auto
+ DO i = 1,10
+ ENDDO
+ !$acc loop gang
+ DO i = 1,10
+ ENDDO
+ !$acc loop gang(5) ! { dg-error "non-static" }
+ DO i = 1,10
+ ENDDO
+ !$acc loop gang(num:5) ! { dg-error "non-static" }
+ DO i = 1,10
+ ENDDO
+ !$acc loop gang(static:5)
+ DO i = 1,10
+ ENDDO
+ !$acc loop gang(static:*)
+ DO i = 1,10
+ ENDDO
+ !$acc loop gang
+ DO i = 1,10
+ !$acc loop vector
+ DO j = 1,10
+ ENDDO
+ !$acc loop worker
+ DO j = 1,10
+ ENDDO
+ !$acc loop gang ! { dg-error "not allowed" }
+ DO j = 1,10
+ ENDDO
+ ENDDO
+ !$acc loop seq gang ! { dg-error "conflicts with" }
+ DO i = 1,10
+ ENDDO
+
+ !$acc loop worker
+ DO i = 1,10
+ ENDDO
+ !$acc loop worker(5) ! { dg-error "non-static" }
+ DO i = 1,10
+ ENDDO
+ !$acc loop worker(num:5) ! { dg-error "non-static" }
+ DO i = 1,10
+ ENDDO
+ !$acc loop worker
+ DO i = 1,10
+ !$acc loop vector
+ DO j = 1,10
+ ENDDO
+ !$acc loop worker ! { dg-error "not allowed" }
+ DO j = 1,10
+ ENDDO
+ !$acc loop gang ! { dg-error "not allowed" }
+ DO j = 1,10
+ ENDDO
+ ENDDO
+ !$acc loop seq worker ! { dg-error "conflicts with" }
+ DO i = 1,10
+ ENDDO
+ !$acc loop gang worker ! { dg-error "conflicts with" }
+ DO i = 1,10
+ ENDDO
+
+ !$acc loop vector
+ DO i = 1,10
+ ENDDO
+ !$acc loop vector(5)
+ DO i = 1,10
+ ENDDO
+ !$acc loop vector(length:5)
+ DO i = 1,10
+ ENDDO
+ !$acc loop vector
+ DO i = 1,10
+ !$acc loop vector ! { dg-error "not allowed" }
+ DO j = 1,10
+ ENDDO
+ !$acc loop worker ! { dg-error "not allowed" }
+ DO j = 1,10
+ ENDDO
+ !$acc loop gang ! { dg-error "not allowed" }
+ DO j = 1,10
+ ENDDO
+ ENDDO
+ !$acc loop seq vector ! { dg-error "conflicts with" }
+ DO i = 1,10
+ ENDDO
+ !$acc loop gang vector ! { dg-error "conflicts with" }
+ DO i = 1,10
+ ENDDO
+ !$acc loop worker vector ! { dg-error "conflicts with" }
+ DO i = 1,10
+ ENDDO
+
+ !$acc loop auto
+ DO i = 1,10
+ ENDDO
+ !$acc loop seq auto ! { dg-error "conflicts with" }
+ DO i = 1,10
+ ENDDO
+ !$acc loop gang auto ! { dg-error "conflicts with" }
+ DO i = 1,10
+ ENDDO
+ !$acc loop worker auto ! { dg-error "conflicts with" }
+ DO i = 1,10
+ ENDDO
+ !$acc loop vector auto ! { dg-error "conflicts with" }
+ DO i = 1,10
+ ENDDO
+
+ !$acc loop tile ! { dg-error "Unclassifiable" }
+ DO i = 1,10
+ ENDDO
+ !$acc loop tile() ! { dg-error "Syntax error" }
+ DO i = 1,10
+ ENDDO
+ !$acc loop tile(1)
+ DO i = 1,10
+ ENDDO
+ !$acc loop tile(*)
+ DO i = 1,10
+ ENDDO
+ !$acc loop tile(2)
+ DO i = 1,10
+ DO j = 1,10
+ ENDDO
+ ENDDO
+ !$acc loop tile(-1) ! { dg-warning "must be positive" }
+ do i = 1,10
+ enddo
+ !$acc loop tile(i) ! { dg-error "constant expression" }
+ do i = 1,10
+ enddo
+ !$acc loop tile(2, 2, 1) ! { dg-error "not enough DO loops for tiled" }
+ do i = 1, 3
+ do j = 4, 6
+ end do
+ end do
+ !$acc loop tile(2, 2)
+ do i = 1, 5, 2
+ do j = i + 1, 7, i ! { dg-error "tiled loops don.t form rectangular iteration space" }
+ end do
+ end do
+ !$acc loop vector tile(*)
+ DO i = 1,10
+ ENDDO
+ !$acc loop worker tile(*)
+ DO i = 1,10
+ ENDDO
+ !$acc loop gang tile(*)
+ DO i = 1,10
+ ENDDO
+ !$acc loop vector gang tile(*)
+ DO i = 1,10
+ ENDDO
+ !$acc loop vector worker tile(*)
+ DO i = 1,10
+ ENDDO
+ !$acc loop gang worker tile(*)
+ DO i = 1,10
+ ENDDO
+ !$acc end parallel
+
+ !$acc kernels loop auto
+ DO i = 1,10
+ ENDDO
+ !$acc kernels loop gang
+ DO i = 1,10
+ ENDDO
+ !$acc kernels loop gang(5)
+ DO i = 1,10
+ ENDDO
+ !$acc kernels loop gang(num:5)
+ DO i = 1,10
+ ENDDO
+ !$acc kernels loop gang(static:5)
+ DO i = 1,10
+ ENDDO
+ !$acc kernels loop gang(static:*)
+ DO i = 1,10
+ ENDDO
+ !$acc kernels loop gang
+ DO i = 1,10
+ !$acc kernels loop gang
+ DO j = 1,10
+ ENDDO
+ ENDDO
+ !$acc kernels loop seq gang ! { dg-error "conflicts with" }
+ DO i = 1,10
+ ENDDO
+
+ !$acc kernels loop worker
+ DO i = 1,10
+ ENDDO
+ !$acc kernels loop worker(5)
+ DO i = 1,10
+ ENDDO
+ !$acc kernels loop worker(num:5)
+ DO i = 1,10
+ ENDDO
+ !$acc kernels loop worker
+ DO i = 1,10
+ !$acc kernels loop worker
+ DO j = 1,10
+ ENDDO
+ !$acc kernels loop gang
+ DO j = 1,10
+ ENDDO
+ ENDDO
+ !$acc kernels loop seq worker ! { dg-error "conflicts with" }
+ DO i = 1,10
+ ENDDO
+ !$acc kernels loop gang worker ! { dg-error "conflicts with" }
+ DO i = 1,10
+ ENDDO
+
+ !$acc kernels loop vector
+ DO i = 1,10
+ ENDDO
+ !$acc kernels loop vector(5)
+ DO i = 1,10
+ ENDDO
+ !$acc kernels loop vector(length:5)
+ DO i = 1,10
+ ENDDO
+ !$acc kernels loop vector
+ DO i = 1,10
+ !$acc kernels loop vector
+ DO j = 1,10
+ ENDDO
+ !$acc kernels loop worker
+ DO j = 1,10
+ ENDDO
+ !$acc kernels loop gang
+ DO j = 1,10
+ ENDDO
+ ENDDO
+ !$acc kernels loop seq vector ! { dg-error "conflicts with" }
+ DO i = 1,10
+ ENDDO
+ !$acc kernels loop gang vector ! { dg-error "conflicts with" }
+ DO i = 1,10
+ ENDDO
+ !$acc kernels loop worker vector ! { dg-error "conflicts with" }
+ DO i = 1,10
+ ENDDO
+
+ !$acc kernels loop auto
+ DO i = 1,10
+ ENDDO
+ !$acc kernels loop seq auto ! { dg-error "conflicts with" }
+ DO i = 1,10
+ ENDDO
+ !$acc kernels loop gang auto ! { dg-error "conflicts with" }
+ DO i = 1,10
+ ENDDO
+ !$acc kernels loop worker auto ! { dg-error "conflicts with" }
+ DO i = 1,10
+ ENDDO
+ !$acc kernels loop vector auto ! { dg-error "conflicts with" }
+ DO i = 1,10
+ ENDDO
+
+ !$acc kernels loop tile ! { dg-error "Unclassifiable" }
+ DO i = 1,10
+ ENDDO
+ !$acc kernels loop tile() ! { dg-error "Syntax error" }
+ DO i = 1,10
+ ENDDO
+ !$acc kernels loop tile(1)
+ DO i = 1,10
+ ENDDO
+ !$acc kernels loop tile(*)
+ DO i = 1,10
+ ENDDO
+ !$acc kernels loop tile(*, 1)
+ DO i = 1,10
+ DO j = 1,10
+ ENDDO
+ ENDDO
+ !$acc kernels loop tile(-1) ! { dg-warning "must be positive" }
+ do i = 1,10
+ enddo
+ !$acc kernels loop tile(i) ! { dg-error "constant expression" }
+ do i = 1,10
+ enddo
+ !$acc kernels loop tile(2, 2, 1) ! { dg-error "not enough DO loops for tiled" }
+ do i = 1, 3
+ do j = 4, 6
+ end do
+ end do
+ !$acc kernels loop tile(2, 2)
+ do i = 1, 5, 2
+ do j = i + 1, 7, i ! { dg-error "tiled loops don.t form rectangular iteration space" }
+ end do
+ end do
+ !$acc kernels loop vector tile(*)
+ DO i = 1,10
+ ENDDO
+ !$acc kernels loop worker tile(*)
+ DO i = 1,10
+ ENDDO
+ !$acc kernels loop gang tile(*)
+ DO i = 1,10
+ ENDDO
+ !$acc kernels loop vector gang tile(*)
+ DO i = 1,10
+ ENDDO
+ !$acc kernels loop vector worker tile(*)
+ DO i = 1,10
+ ENDDO
+ !$acc kernels loop gang worker tile(*)
+ DO i = 1,10
+ ENDDO
+
+ !$acc parallel loop auto
+ DO i = 1,10
+ ENDDO
+ !$acc parallel loop gang
+ DO i = 1,10
+ ENDDO
+ !$acc parallel loop gang(5) ! { dg-error "non-static" }
+ DO i = 1,10
+ ENDDO
+ !$acc parallel loop gang(num:5) ! { dg-error "non-static" }
+ DO i = 1,10
+ ENDDO
+ !$acc parallel loop gang(static:5)
+ DO i = 1,10
+ ENDDO
+ !$acc parallel loop gang(static:*)
+ DO i = 1,10
+ ENDDO
+ !$acc parallel loop gang
+ DO i = 1,10
+ !$acc parallel loop gang
+ DO j = 1,10
+ ENDDO
+ ENDDO
+ !$acc parallel loop seq gang ! { dg-error "conflicts with" }
+ DO i = 1,10
+ ENDDO
+
+ !$acc parallel loop worker
+ DO i = 1,10
+ ENDDO
+ !$acc parallel loop worker(5) ! { dg-error "non-static" }
+ DO i = 1,10
+ ENDDO
+ !$acc parallel loop worker(num:5) ! { dg-error "non-static" }
+ DO i = 1,10
+ ENDDO
+ !$acc parallel loop worker
+ DO i = 1,10
+ !$acc parallel loop worker
+ DO j = 1,10
+ ENDDO
+ !$acc parallel loop gang
+ DO j = 1,10
+ ENDDO
+ ENDDO
+ !$acc parallel loop seq worker ! { dg-error "conflicts with" }
+ DO i = 1,10
+ ENDDO
+ !$acc parallel loop gang worker ! { dg-error "conflicts with" }
+ DO i = 1,10
+ ENDDO
+
+ !$acc parallel loop vector
+ DO i = 1,10
+ ENDDO
+ !$acc parallel loop vector(5)
+ DO i = 1,10
+ ENDDO
+ !$acc parallel loop vector(length:5)
+ DO i = 1,10
+ ENDDO
+ !$acc parallel loop vector
+ DO i = 1,10
+ !$acc parallel loop vector
+ DO j = 1,10
+ ENDDO
+ !$acc parallel loop worker
+ DO j = 1,10
+ ENDDO
+ !$acc parallel loop gang
+ DO j = 1,10
+ ENDDO
+ ENDDO
+ !$acc parallel loop seq vector ! { dg-error "conflicts with" }
+ DO i = 1,10
+ ENDDO
+ !$acc parallel loop gang vector ! { dg-error "conflicts with" }
+ DO i = 1,10
+ ENDDO
+ !$acc parallel loop worker vector ! { dg-error "conflicts with" }
+ DO i = 1,10
+ ENDDO
+
+ !$acc parallel loop auto
+ DO i = 1,10
+ ENDDO
+ !$acc parallel loop seq auto ! { dg-error "conflicts with" }
+ DO i = 1,10
+ ENDDO
+ !$acc parallel loop gang auto ! { dg-error "conflicts with" }
+ DO i = 1,10
+ ENDDO
+ !$acc parallel loop worker auto ! { dg-error "conflicts with" }
+ DO i = 1,10
+ ENDDO
+ !$acc parallel loop vector auto ! { dg-error "conflicts with" }
+ DO i = 1,10
+ ENDDO
+
+ !$acc parallel loop tile ! { dg-error "Unclassifiable" }
+ DO i = 1,10
+ ENDDO
+ !$acc parallel loop tile() ! { dg-error "Syntax error" }
+ DO i = 1,10
+ ENDDO
+ !$acc parallel loop tile(1)
+ DO i = 1,10
+ ENDDO
+ !$acc parallel loop tile(*)
+ DO i = 1,10
+ ENDDO
+ !$acc parallel loop tile(*, 1)
+ DO i = 1,10
+ DO j = 1,10
+ ENDDO
+ ENDDO
+ !$acc parallel loop tile(-1) ! { dg-warning "must be positive" }
+ do i = 1,10
+ enddo
+ !$acc parallel loop tile(i) ! { dg-error "constant expression" }
+ do i = 1,10
+ enddo
+ !$acc parallel loop tile(2, 2, 1) ! { dg-error "not enough DO loops for tiled" }
+ do i = 1, 3
+ do j = 4, 6
+ end do
+ end do
+ !$acc parallel loop tile(2, 2)
+ do i = 1, 5, 2
+ do j = i + 1, 7, i ! { dg-error "tiled loops don.t form rectangular iteration space" }
+ end do
+ end do
+ !$acc parallel loop vector tile(*)
+ DO i = 1,10
+ ENDDO
+ !$acc parallel loop worker tile(*)
+ DO i = 1,10
+ ENDDO
+ !$acc parallel loop gang tile(*)
+ DO i = 1,10
+ ENDDO
+ !$acc parallel loop vector gang tile(*)
+ DO i = 1,10
+ ENDDO
+ !$acc parallel loop vector worker tile(*)
+ DO i = 1,10
+ ENDDO
+ !$acc parallel loop gang worker tile(*)
+ DO i = 1,10
+ ENDDO
+end
\ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/goacc/loop-3.f95 b/gcc/testsuite/gfortran.dg/goacc/loop-3.f95
new file mode 100644
index 0000000..2a866c7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/loop-3.f95
@@ -0,0 +1,55 @@
+! { dg-do compile }
+! { dg-additional-options "-std=f2008" }
+
+subroutine test1
+ implicit none
+ integer :: i, j
+
+ ! !$acc end loop not required by spec
+ !$acc loop
+ do i = 1,5
+ enddo
+ !$acc end loop ! { dg-warning "Redundant" }
+
+ !$acc loop
+ do i = 1,5
+ enddo
+ j = 1
+ !$acc end loop ! { dg-error "Unexpected" }
+
+ !$acc parallel
+ !$acc loop
+ do i = 1,5
+ enddo
+ !$acc end parallel
+ !$acc end loop ! { dg-error "Unexpected" }
+
+ ! OpenACC supports Fortran 2008 do concurrent statement
+ !$acc loop
+ do concurrent (i = 1:5)
+ end do
+
+ !$acc loop
+ outer_loop: do i = 1, 5
+ inner_loop: do j = 1,5
+ if (i .eq. j) cycle outer_loop
+ if (i .ne. j) exit outer_loop ! { dg-error "EXIT statement" }
+ end do inner_loop
+ end do outer_loop
+
+ outer_loop1: do i = 1, 5
+ !$acc loop
+ inner_loop1: do j = 1,5
+ if (i .eq. j) cycle outer_loop1 ! { dg-error "CYCLE statement" }
+ end do inner_loop1
+ end do outer_loop1
+
+ !$acc loop collapse(2)
+ outer_loop2: do i = 1, 5
+ inner_loop2: do j = 1,5
+ if (i .eq. j) cycle outer_loop2 ! { dg-error "CYCLE statement" }
+ if (i .ne. j) exit outer_loop2 ! { dg-error "EXIT statement" }
+ end do inner_loop2
+ end do outer_loop2
+end subroutine test1
+
diff --git a/gcc/testsuite/gfortran.dg/goacc/omp.f95 b/gcc/testsuite/gfortran.dg/goacc/omp.f95
new file mode 100644
index 0000000..24f639f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/omp.f95
@@ -0,0 +1,66 @@
+! { dg-do compile }
+! { dg-additional-options "-fopenmp" }
+
+module test
+contains
+ subroutine ichi
+ implicit none
+ integer :: i
+ !$acc parallel
+ !$omp do ! { dg-error "cannot be specified" }
+ do i = 1,5
+ enddo
+ !$acc end parallel
+ end subroutine ichi
+
+ subroutine ni
+ implicit none
+ integer :: i
+ !$omp parallel
+ !$acc loop ! { dg-error "cannot be specified" }
+ do i = 1,5
+ enddo
+ !$omp end parallel
+ end subroutine ni
+
+ subroutine san
+ implicit none
+ integer :: i
+ !$omp do
+ !$acc loop ! { dg-error "Unexpected" }
+ do i = 1,5
+ enddo
+ end subroutine san
+
+ subroutine yon
+ implicit none
+ integer :: i
+ !$acc loop
+ !$omp do ! { dg-error "Expected DO loop" }
+ do i = 1,5
+ enddo
+ end subroutine yon
+
+ subroutine go
+ implicit none
+ integer :: i, j
+
+ !$omp parallel
+ do i = 1,5
+ !$acc kernels ! { dg-error "cannot be specified" }
+ do j = 1,5
+ enddo
+ !$acc end kernels
+ enddo
+ !$omp end parallel
+ end subroutine go
+
+ subroutine roku
+ implicit none
+
+ !$acc data
+ !$omp parallel ! { dg-error "cannot be specified" }
+ !$omp end parallel
+ !$acc end data
+ end subroutine roku
+end module test
\ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/goacc/parallel-kernels-clauses.f95 b/gcc/testsuite/gfortran.dg/goacc/parallel-kernels-clauses.f95
new file mode 100644
index 0000000..c37208c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/parallel-kernels-clauses.f95
@@ -0,0 +1,96 @@
+! { dg-do compile }
+! { dg-additional-options "-fmax-errors=100" }
+
+! test clauses added in OpenACC ver 2.0
+
+program test
+ implicit none
+ integer :: i, a(10), b(5:7)
+ integer, parameter :: acc_async_noval = -1
+ integer, parameter :: acc_async_sync = -2
+ logical :: l
+
+ ! async
+ !$acc kernels async(i)
+ !$acc end kernels
+ !$acc parallel async(i)
+ !$acc end parallel
+
+ !$acc kernels async(0, 1) { dg-error "Unclassifiable" }
+ !$acc parallel async(0, 1) { dg-error "Unclassifiable" }
+
+ !$acc kernels async
+ !$acc end kernels
+ !$acc parallel async
+ !$acc end parallel
+
+ !$acc kernels async(acc_async_noval)
+ !$acc end kernels
+ !$acc parallel async(acc_async_noval)
+ !$acc end parallel
+
+ !$acc kernels async(acc_async_sync)
+ !$acc end kernels
+ !$acc parallel async(acc_async_sync)
+ !$acc end parallel
+
+ !$acc kernels async() { dg-error "Invalid character" }
+ !$acc parallel async() { dg-error "Invalid character" }
+
+ !$acc kernels async("a") { dg-error "Unclassifiable" }
+ !$acc parallel async("a") { dg-error "Unclassifiable" }
+
+ !$acc kernels async(.true.) { dg-error "Unclassifiable" }
+ !$acc parallel async(.true.) { dg-error "Unclassifiable" }
+
+ ! default(none)
+ !$acc kernels default(none)
+ !$acc end kernels
+ !$acc parallel default(none)
+ !$acc end parallel
+
+ !$acc kernels default (none)
+ !$acc end kernels
+ !$acc parallel default (none)
+ !$acc end parallel
+
+ !$acc kernels default ( none )
+ !$acc end kernels
+ !$acc parallel default ( none )
+ !$acc end parallel
+
+ !$acc kernels default { dg-error "Unclassifiable" }
+ !$acc parallel default { dg-error "Unclassifiable" }
+
+ !$acc kernels default() { dg-error "Unclassifiable" }
+ !$acc parallel default() { dg-error "Unclassifiable" }
+
+ !$acc kernels default(i) { dg-error "Unclassifiable" }
+ !$acc parallel default(i) { dg-error "Unclassifiable" }
+
+ !$acc kernels default(1) { dg-error "Unclassifiable" }
+ !$acc parallel default(1) { dg-error "Unclassifiable" }
+
+ ! Wait
+ !$acc kernels wait (l) ! { dg-error "INTEGER" }
+ !$acc end kernels
+ !$acc kernels wait (.true.) ! { dg-error "INTEGER" }
+ !$acc end kernels
+ !$acc kernels wait (i, 1)
+ !$acc end kernels
+ !$acc kernels wait (a) ! { dg-error "INTEGER" }
+ !$acc end kernels
+ !$acc kernels wait (b(5:6)) ! { dg-error "INTEGER" }
+ !$acc end kernels
+
+ !$acc parallel wait (l) ! { dg-error "INTEGER" }
+ !$acc end parallel
+ !$acc parallel wait (.true.) ! { dg-error "INTEGER" }
+ !$acc end parallel
+ !$acc parallel wait (i, 1)
+ !$acc end parallel
+ !$acc parallel wait (a) ! { dg-error "INTEGER" }
+ !$acc end parallel
+ !$acc parallel wait (b(5:6)) ! { dg-error "INTEGER" }
+ !$acc end parallel
+end
diff --git a/gcc/testsuite/gfortran.dg/goacc/parallel-kernels-regions.f95 b/gcc/testsuite/gfortran.dg/goacc/parallel-kernels-regions.f95
new file mode 100644
index 0000000..5cd4d6c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/parallel-kernels-regions.f95
@@ -0,0 +1,56 @@
+! { dg-do compile }
+
+! OpenACC 2.0 allows nested parallel/kernels regions
+! However, in middle-end there is check for nested parallel
+
+program test
+ implicit none
+
+ integer :: i
+
+ !$acc parallel
+ !$acc kernels
+ !$acc end kernels
+ !$acc end parallel
+
+ !$acc parallel
+ !$acc parallel ! { dg-error "may not be nested" }
+ !$acc end parallel
+ !$acc end parallel
+
+ !$acc parallel
+ !$acc parallel ! { dg-error "may not be nested" }
+ !$acc end parallel
+ !$acc kernels
+ !$acc end kernels
+ !$acc end parallel
+
+ !$acc kernels
+ !$acc kernels
+ !$acc end kernels
+ !$acc end kernels
+
+ !$acc kernels
+ !$acc parallel
+ !$acc end parallel
+ !$acc end kernels
+
+ !$acc kernels
+ !$acc parallel
+ !$acc end parallel
+ !$acc kernels
+ !$acc end kernels
+ !$acc end kernels
+
+ !$acc parallel
+ !$acc data ! { dg-error "may not be nested" }
+ !$acc end data
+ !$acc end parallel
+
+ !$acc kernels
+ !$acc data
+ !$acc end data
+ !$acc end kernels
+
+end program test
+! { dg-excess-errors "unimplemented" }
\ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/goacc/parallel-tree.f95 b/gcc/testsuite/gfortran.dg/goacc/parallel-tree.f95
new file mode 100644
index 0000000..a92de4e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/parallel-tree.f95
@@ -0,0 +1,42 @@
+! { dg-do compile }
+! { dg-additional-options "-fdump-tree-original" }
+
+! test for tree-dump-original and spaces-commas
+
+program test
+ implicit none
+ integer :: q, i, j, k, m, n, o, p, r, s, t, u, v, w
+ logical :: l
+
+ !$acc parallel if(l) async num_gangs(i) num_workers(i) vector_length(i) &
+ !$acc reduction(max:q), copy(i), copyin(j), copyout(k), create(m) &
+ !$acc present(o), pcopy(p), pcopyin(r), pcopyout(s), pcreate(t) &
+ !$acc deviceptr(u), private(v), firstprivate(w)
+ !$acc end parallel
+
+end program test
+! { dg-excess-errors "unimplemented" }
+! { dg-final { scan-tree-dump-times "pragma acc parallel" 1 "original" } }
+
+! { dg-final { scan-tree-dump-times "if" 1 "original" } }
+! { dg-final { scan-tree-dump-times "async" 1 "original" } }
+! { dg-final { scan-tree-dump-times "num_gangs" 1 "original" } }
+! { dg-final { scan-tree-dump-times "num_workers" 1 "original" } }
+! { dg-final { scan-tree-dump-times "vector_length" 1 "original" } }
+
+! { dg-final { scan-tree-dump-times "reduction\\(max:q\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "map\\(force_tofrom:i\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "map\\(force_to:j\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "map\\(force_from:k\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "map\\(force_alloc:m\\)" 1 "original" } }
+
+! { dg-final { scan-tree-dump-times "map\\(force_present:o\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "map\\(tofrom:p\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "map\\(to:r\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "map\\(from:s\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "map\\(alloc:t\\)" 1 "original" } }
+
+! { dg-final { scan-tree-dump-times "map\\(force_deviceptr:u\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "private\\(v\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "firstprivate\\(w\\)" 1 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
diff --git a/gcc/testsuite/gfortran.dg/goacc/parameter.f95 b/gcc/testsuite/gfortran.dg/goacc/parameter.f95
new file mode 100644
index 0000000..917f772
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/parameter.f95
@@ -0,0 +1,31 @@
+! { dg-do compile }
+
+module test
+contains
+ subroutine oacc1
+ implicit none
+ integer :: i
+ integer, parameter :: a = 1
+ !$acc declare device_resident (a) ! { dg-error "PARAMETER" }
+ !$acc data copy (a) ! { dg-error "not a variable" }
+ !$acc end data
+ !$acc data deviceptr (a) ! { dg-error "not a variable" }
+ !$acc end data
+ !$acc parallel private (a) ! { dg-error "not a variable" }
+ !$acc end parallel
+ !$acc host_data use_device (a) ! { dg-error "not a variable" }
+ !$acc end host_data
+ !$acc parallel loop reduction(+:a) ! { dg-error "not a variable" }
+ do i = 1,5
+ enddo
+ !$acc end parallel loop
+ !$acc parallel loop
+ do i = 1,5
+ !$acc cache (a) ! TODO: This must fail, as in openacc-1_0-branch
+ enddo
+ !$acc end parallel loop
+ !$acc update host (a) ! { dg-error "not a variable" }
+ !$acc update device (a) ! { dg-error "not a variable" }
+ end subroutine oacc1
+end module test
+! { dg-excess-errors "unimplemented" }
\ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/goacc/pure-elemental-procedures.f95 b/gcc/testsuite/gfortran.dg/goacc/pure-elemental-procedures.f95
new file mode 100644
index 0000000..726e8e9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/pure-elemental-procedures.f95
@@ -0,0 +1,78 @@
+! { dg-do compile }
+! { dg-additional-options "-std=f2008 -fcoarray=single" }
+
+module test
+ implicit none
+contains
+ elemental subroutine test1
+ !$acc parallel ! { dg-error "may not appear in PURE procedures" }
+ end subroutine test1
+
+ pure subroutine test2
+ !$acc parallel ! { dg-error "may not appear in PURE procedures" }
+ end subroutine test2
+
+ ! Implicit pure
+ elemental real function test3(x)
+ real, intent(in) :: x
+ !$acc parallel ! { dg-error "may not appear in PURE procedures" }
+ test3 = x*x
+ end function test3
+
+ pure real function test4(x)
+ real, intent(in) :: x
+ !$acc parallel ! { dg-error "may not appear in PURE procedures" }
+ test4 = x
+ end function test4
+
+ subroutine test5
+ real :: x = 0.0
+ integer :: i
+ !$acc parallel loop collapse(1) reduction(+:x)
+ do i = 1,10
+ x = x + 0.3
+ enddo
+ print *, x
+ end subroutine test5
+
+ real function test6(x)
+ real :: x
+ integer :: i
+ !$acc parallel loop collapse(1) reduction(+:x)
+ do i = 1,10
+ x = x + 0.3
+ enddo
+ test6 = x
+ end function test6
+
+ impure elemental real function test7(x)
+ real, intent(in) :: x
+ !$acc parallel
+ test7 = x
+ !$acc end parallel
+ end function test7
+
+ subroutine test8
+ real :: x = 0.0
+ integer :: i
+ !$acc parallel loop collapse(1) reduction(+:x)
+ do i = 1,10
+ critical ! { dg-error "CRITICAL block inside of" }
+ x = x + 0.3
+ end critical
+ enddo
+ print *, x
+ end subroutine test8
+
+ real function test9(n)
+ integer, value :: n
+ BLOCK
+ integer i
+ real sum
+ !$acc loop reduction(+:sum)
+ do i=1, n
+ sum = sum + sin(real(i))
+ end do
+ END BLOCK
+ end function test9
+end module test
\ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/goacc/reduction.f95 b/gcc/testsuite/gfortran.dg/goacc/reduction.f95
new file mode 100644
index 0000000..9b680e0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/reduction.f95
@@ -0,0 +1,138 @@
+! { dg-do compile }
+! { dg-additional-options "-fmax-errors=100" }
+
+subroutine foo (ia1)
+integer :: i1, i2, i3
+integer, dimension (*) :: ia1
+integer, dimension (10) :: ia2
+real :: r1
+real, dimension (5) :: ra1
+double precision :: d1
+double precision, dimension (4) :: da1
+complex :: c1
+complex, dimension (7) :: ca1
+logical :: l1
+logical, dimension (3) :: la1
+character (5) :: a1
+type t
+ integer :: i
+end type
+type(t) :: t1
+type(t), dimension (2) :: ta1
+real, pointer :: p1 => NULL()
+integer, allocatable :: aa1 (:,:)
+save i2
+common /blk/ i1
+
+!$acc parallel reduction (+:ia2)
+!$acc end parallel
+!$acc parallel reduction (+:ra1)
+!$acc end parallel
+!$acc parallel reduction (+:ca1)
+!$acc end parallel
+!$acc parallel reduction (+:da1)
+!$acc end parallel
+!$acc parallel reduction (.and.:la1)
+!$acc end parallel
+!$acc parallel reduction (+:i3, r1, d1, c1)
+!$acc end parallel
+!$acc parallel reduction (*:i3, r1, d1, c1)
+!$acc end parallel
+!$acc parallel reduction (-:i3, r1, d1, c1)
+!$acc end parallel
+!$acc parallel reduction (.and.:l1)
+!$acc end parallel
+!$acc parallel reduction (.or.:l1)
+!$acc end parallel
+!$acc parallel reduction (.eqv.:l1)
+!$acc end parallel
+!$acc parallel reduction (.neqv.:l1)
+!$acc end parallel
+!$acc parallel reduction (min:i3, r1, d1)
+!$acc end parallel
+!$acc parallel reduction (max:i3, r1, d1)
+!$acc end parallel
+!$acc parallel reduction (iand:i3)
+!$acc end parallel
+!$acc parallel reduction (ior:i3)
+!$acc end parallel
+!$acc parallel reduction (ieor:i3)
+!$acc end parallel
+!$acc parallel reduction (+:/blk/) ! { dg-error "Syntax error" }
+!$acc end parallel ! { dg-error "Unexpected" }
+!$acc parallel reduction (*:p1) ! { dg-error "POINTER object" }
+!$acc end parallel
+!$acc parallel reduction (-:aa1)
+!$acc end parallel
+!$acc parallel reduction (*:ia1) ! { dg-error "Assumed size" }
+!$acc end parallel
+!$acc parallel reduction (+:l1) ! { dg-error "must be of numeric type, got LOGICAL" }
+!$acc end parallel
+!$acc parallel reduction (*:la1) ! { dg-error "must be of numeric type, got LOGICAL" }
+!$acc end parallel
+!$acc parallel reduction (-:a1) ! { dg-error "must be of numeric type, got CHARACTER" }
+!$acc end parallel
+!$acc parallel reduction (+:t1) ! { dg-error "must be of numeric type, got TYPE" }
+!$acc end parallel
+!$acc parallel reduction (*:ta1) ! { dg-error "must be of numeric type, got TYPE" }
+!$acc end parallel
+!$acc parallel reduction (.and.:i3) ! { dg-error "must be LOGICAL" }
+!$acc end parallel
+!$acc parallel reduction (.or.:ia2) ! { dg-error "must be LOGICAL" }
+!$acc end parallel
+!$acc parallel reduction (.eqv.:r1) ! { dg-error "must be LOGICAL" }
+!$acc end parallel
+!$acc parallel reduction (.neqv.:ra1) ! { dg-error "must be LOGICAL" }
+!$acc end parallel
+!$acc parallel reduction (.and.:d1) ! { dg-error "must be LOGICAL" }
+!$acc end parallel
+!$acc parallel reduction (.or.:da1) ! { dg-error "must be LOGICAL" }
+!$acc end parallel
+!$acc parallel reduction (.eqv.:c1) ! { dg-error "must be LOGICAL" }
+!$acc end parallel
+!$acc parallel reduction (.neqv.:ca1) ! { dg-error "must be LOGICAL" }
+!$acc end parallel
+!$acc parallel reduction (.and.:a1) ! { dg-error "must be LOGICAL" }
+!$acc end parallel
+!$acc parallel reduction (.or.:t1) ! { dg-error "must be LOGICAL" }
+!$acc end parallel
+!$acc parallel reduction (.eqv.:ta1) ! { dg-error "must be LOGICAL" }
+!$acc end parallel
+!$acc parallel reduction (min:c1) ! { dg-error "must be INTEGER or REAL" }
+!$acc end parallel
+!$acc parallel reduction (max:ca1) ! { dg-error "must be INTEGER or REAL" }
+!$acc end parallel
+!$acc parallel reduction (max:l1) ! { dg-error "must be INTEGER or REAL" }
+!$acc end parallel
+!$acc parallel reduction (min:la1) ! { dg-error "must be INTEGER or REAL" }
+!$acc end parallel
+!$acc parallel reduction (max:a1) ! { dg-error "must be INTEGER or REAL" }
+!$acc end parallel
+!$acc parallel reduction (min:t1) ! { dg-error "must be INTEGER or REAL" }
+!$acc end parallel
+!$acc parallel reduction (max:ta1) ! { dg-error "must be INTEGER or REAL" }
+!$acc end parallel
+!$acc parallel reduction (iand:r1) ! { dg-error "must be INTEGER" }
+!$acc end parallel
+!$acc parallel reduction (ior:ra1) ! { dg-error "must be INTEGER" }
+!$acc end parallel
+!$acc parallel reduction (ieor:d1) ! { dg-error "must be INTEGER" }
+!$acc end parallel
+!$acc parallel reduction (ior:da1) ! { dg-error "must be INTEGER" }
+!$acc end parallel
+!$acc parallel reduction (iand:c1) ! { dg-error "must be INTEGER" }
+!$acc end parallel
+!$acc parallel reduction (ior:ca1) ! { dg-error "must be INTEGER" }
+!$acc end parallel
+!$acc parallel reduction (ieor:l1) ! { dg-error "must be INTEGER" }
+!$acc end parallel
+!$acc parallel reduction (iand:la1) ! { dg-error "must be INTEGER" }
+!$acc end parallel
+!$acc parallel reduction (ior:a1) ! { dg-error "must be INTEGER" }
+!$acc end parallel
+!$acc parallel reduction (ieor:t1) ! { dg-error "must be INTEGER" }
+!$acc end parallel
+!$acc parallel reduction (iand:ta1) ! { dg-error "must be INTEGER" }
+!$acc end parallel
+
+end subroutine
\ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/goacc/sentinel-free-form.f95 b/gcc/testsuite/gfortran.dg/goacc/sentinel-free-form.f95
new file mode 100644
index 0000000..1a3189c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/sentinel-free-form.f95
@@ -0,0 +1,21 @@
+! { dg-do compile }
+
+program test
+ implicit none
+
+ integer :: i
+ real :: x
+
+ ! sentinel may only be preceeded by white space
+ x = 0.0 !$acc parallel ! comment
+ ! sentinel must appear as a single word
+ ! $acc parallel ! comment
+ !$ acc parallel ! { dg-error "Unclassifiable statement" }
+ ! directive lines must have space after sentinel
+ !$accparallel ! { dg-warning "followed by a space" }
+ do i = 1,10
+ x = x + 0.3
+ enddo
+ !$acc end parallel ! { dg-error "Unexpected" }
+ print *, x
+end
\ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/goacc/several-directives.f95 b/gcc/testsuite/gfortran.dg/goacc/several-directives.f95
new file mode 100644
index 0000000..8fb97b5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/several-directives.f95
@@ -0,0 +1,6 @@
+! { dg-do compile }
+
+program test
+ ! only one directive-name may appear in directive
+ !$acc parallel kernels ! { dg-error "Unclassifiable OpenACC directive" }
+end
\ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/goacc/sie.f95 b/gcc/testsuite/gfortran.dg/goacc/sie.f95
new file mode 100644
index 0000000..2d66026
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/sie.f95
@@ -0,0 +1,252 @@
+! { dg-do compile }
+! { dg-additional-options "-fmax-errors=100" }
+
+! tests async, num_gangs, num_workers, vector_length, gang, worker, vector clauses
+
+program test
+ implicit none
+
+ integer :: i
+
+ !$acc parallel async
+ !$acc end parallel
+
+ !$acc parallel async(3)
+ !$acc end parallel
+
+ !$acc parallel async(i)
+ !$acc end parallel
+
+ !$acc parallel async(i+1)
+ !$acc end parallel
+
+ !$acc parallel async(-1)
+ !$acc end parallel
+
+ !$acc parallel async(0)
+ !$acc end parallel
+
+ !$acc parallel async() ! { dg-error "Invalid character in name" }
+
+ !$acc parallel async(1.5) ! { dg-error "scalar INTEGER expression" }
+ !$acc end parallel
+
+ !$acc parallel async(.true.) ! { dg-error "scalar INTEGER expression" }
+ !$acc end parallel
+
+ !$acc parallel async("1") ! { dg-error "scalar INTEGER expression" }
+ !$acc end parallel
+
+ !$acc kernels async
+ !$acc end kernels
+
+ !$acc kernels async(3)
+ !$acc end kernels
+
+ !$acc kernels async(i)
+ !$acc end kernels
+
+ !$acc kernels async(i+1)
+ !$acc end kernels
+
+ !$acc kernels async(-1)
+ !$acc end kernels
+
+ !$acc kernels async(0)
+ !$acc end kernels
+
+ !$acc kernels async() ! { dg-error "Invalid character in name" }
+
+ !$acc kernels async(1.5) ! { dg-error "scalar INTEGER expression" }
+ !$acc end kernels
+
+ !$acc kernels async(.true.) ! { dg-error "scalar INTEGER expression" }
+ !$acc end kernels
+
+ !$acc kernels async("1") ! { dg-error "scalar INTEGER expression" }
+ !$acc end kernels
+
+
+ !$acc parallel num_gangs ! { dg-error "Unclassifiable OpenACC directive" }
+
+ !$acc parallel num_gangs(3)
+ !$acc end parallel
+
+ !$acc parallel num_gangs(i)
+ !$acc end parallel
+
+ !$acc parallel num_gangs(i+1)
+ !$acc end parallel
+
+ !$acc parallel num_gangs(-1) ! { dg-warning "must be positive" }
+ !$acc end parallel
+
+ !$acc parallel num_gangs(0) ! { dg-warning "must be positive" }
+ !$acc end parallel
+
+ !$acc parallel num_gangs() ! { dg-error "Invalid character in name" }
+
+ !$acc parallel num_gangs(1.5) ! { dg-error "scalar INTEGER expression" }
+ !$acc end parallel
+
+ !$acc parallel num_gangs(.true.) ! { dg-error "scalar INTEGER expression" }
+ !$acc end parallel
+
+ !$acc parallel num_gangs("1") ! { dg-error "scalar INTEGER expression" }
+ !$acc end parallel
+
+
+ !$acc parallel num_workers ! { dg-error "Unclassifiable OpenACC directive" }
+
+ !$acc parallel num_workers(3)
+ !$acc end parallel
+
+ !$acc parallel num_workers(i)
+ !$acc end parallel
+
+ !$acc parallel num_workers(i+1)
+ !$acc end parallel
+
+ !$acc parallel num_workers(-1) ! { dg-warning "must be positive" }
+ !$acc end parallel
+
+ !$acc parallel num_workers(0) ! { dg-warning "must be positive" }
+ !$acc end parallel
+
+ !$acc parallel num_workers() ! { dg-error "Invalid character in name" }
+
+ !$acc parallel num_workers(1.5) ! { dg-error "scalar INTEGER expression" }
+ !$acc end parallel
+
+ !$acc parallel num_workers(.true.) ! { dg-error "scalar INTEGER expression" }
+ !$acc end parallel
+
+ !$acc parallel num_workers("1") ! { dg-error "scalar INTEGER expression" }
+ !$acc end parallel
+
+
+ !$acc parallel vector_length ! { dg-error "Unclassifiable OpenACC directive" }
+
+ !$acc parallel vector_length(3)
+ !$acc end parallel
+
+ !$acc parallel vector_length(i)
+ !$acc end parallel
+
+ !$acc parallel vector_length(i+1)
+ !$acc end parallel
+
+ !$acc parallel vector_length(-1) ! { dg-warning "must be positive" }
+ !$acc end parallel
+
+ !$acc parallel vector_length(0) ! { dg-warning "must be positive" }
+ !$acc end parallel
+
+ !$acc parallel vector_length() ! { dg-error "Invalid character in name" }
+
+ !$acc parallel vector_length(1.5) ! { dg-error "scalar INTEGER expression" }
+ !$acc end parallel
+
+ !$acc parallel vector_length(.true.) ! { dg-error "scalar INTEGER expression" }
+ !$acc end parallel
+
+ !$acc parallel vector_length("1") ! { dg-error "scalar INTEGER expression" }
+ !$acc end parallel
+
+
+ !$acc loop gang
+ do i = 1,10
+ enddo
+ !$acc loop gang(3)
+ do i = 1,10
+ enddo
+ !$acc loop gang(i)
+ do i = 1,10
+ enddo
+ !$acc loop gang(i+1)
+ do i = 1,10
+ enddo
+ !$acc loop gang(-1) ! { dg-warning "must be positive" }
+ do i = 1,10
+ enddo
+ !$acc loop gang(0) ! { dg-warning "must be positive" }
+ do i = 1,10
+ enddo
+ !$acc loop gang() ! { dg-error "Invalid character in name" }
+ do i = 1,10
+ enddo
+ !$acc loop gang(1.5) ! { dg-error "scalar INTEGER expression" }
+ do i = 1,10
+ enddo
+ !$acc loop gang(.true.) ! { dg-error "scalar INTEGER expression" }
+ do i = 1,10
+ enddo
+ !$acc loop gang("1") ! { dg-error "scalar INTEGER expression" }
+ do i = 1,10
+ enddo
+
+
+ !$acc loop worker
+ do i = 1,10
+ enddo
+ !$acc loop worker(3)
+ do i = 1,10
+ enddo
+ !$acc loop worker(i)
+ do i = 1,10
+ enddo
+ !$acc loop worker(i+1)
+ do i = 1,10
+ enddo
+ !$acc loop worker(-1) ! { dg-warning "must be positive" }
+ do i = 1,10
+ enddo
+ !$acc loop worker(0) ! { dg-warning "must be positive" }
+ do i = 1,10
+ enddo
+ !$acc loop worker() ! { dg-error "Invalid character in name" }
+ do i = 1,10
+ enddo
+ !$acc loop worker(1.5) ! { dg-error "scalar INTEGER expression" }
+ do i = 1,10
+ enddo
+ !$acc loop worker(.true.) ! { dg-error "scalar INTEGER expression" }
+ do i = 1,10
+ enddo
+ !$acc loop worker("1") ! { dg-error "scalar INTEGER expression" }
+ do i = 1,10
+ enddo
+
+
+ !$acc loop vector
+ do i = 1,10
+ enddo
+ !$acc loop vector(3)
+ do i = 1,10
+ enddo
+ !$acc loop vector(i)
+ do i = 1,10
+ enddo
+ !$acc loop vector(i+1)
+ do i = 1,10
+ enddo
+ !$acc loop vector(-1) ! { dg-warning "must be positive" }
+ do i = 1,10
+ enddo
+ !$acc loop vector(0) ! { dg-warning "must be positive" }
+ do i = 1,10
+ enddo
+ !$acc loop vector() ! { dg-error "Invalid character in name" }
+ do i = 1,10
+ enddo
+ !$acc loop vector(1.5) ! { dg-error "scalar INTEGER expression" }
+ do i = 1,10
+ enddo
+ !$acc loop vector(.true.) ! { dg-error "scalar INTEGER expression" }
+ do i = 1,10
+ enddo
+ !$acc loop vector("1") ! { dg-error "scalar INTEGER expression" }
+ do i = 1,10
+ enddo
+
+end program test
\ No newline at end of file
--
1.8.3.2
^ permalink raw reply [flat|nested] 89+ messages in thread
* Re: [PATCH 3/4] [GOMP4] [Fortran] OpenACC 1.0+ support in fortran front-end
2014-03-07 10:46 ` [PATCH 3/4] " Ilmir Usmanov
2014-03-07 10:47 ` [PATCH 4/4] " Ilmir Usmanov
@ 2014-03-08 17:19 ` Tobias Burnus
1 sibling, 0 replies; 89+ messages in thread
From: Tobias Burnus @ 2014-03-08 17:19 UTC (permalink / raw)
To: Ilmir Usmanov
Cc: Thomas Schwinge, Evgeny Gavrin, GarbuzovViacheslav,
Dmitri Botcharnikov, gcc-patches, jakub, fortran
Ilmir Usmanov wrote:
> OpenACC 1.0 fortran FE support -- translation to GENERIC.
This part of the patch set looks good to me. Thanks.
Tobias
> gcc/fortran/
> * trans-decl.c
> (gfc_generate_function_code): Insert OACC_DECLARE GENERIC node.
> * trans-openmp.c (gfc_convert_expr_to_tree): New helper function.
> (gfc_trans_omp_array_reduction): Support also OpenACC. Add parameter.
> (gfc_trans_omp_reduction_list): Update.
> (gfc_trans_oacc_construct): New transform function.
> (gfc_trans_omp_map_clause_list): Likewise.
> (gfc_trans_oacc_executable_directive): Likewise.
> (gfc_trans_oacc_combined_directive, gfc_trans_oacc_declare):
> Likewise.
> (gfc_trans_oacc_directive): Use them.
> (gfc_trans_oacc_loop): Stub.
> (gfc_trans_omp_clauses): Transform OpenACC clauses.
> * trans-stmt.h (gfc_trans_oacc_directive): New function prototype.
> (gfc_trans_oacc_declare): Likewise.
> * trans.c (trans_code): Transform also OpenACC directives.
^ permalink raw reply [flat|nested] 89+ messages in thread
* Re: [PATCH 4/4] [GOMP4] [Fortran] OpenACC 1.0+ support in fortran front-end
2014-03-07 10:47 ` [PATCH 4/4] " Ilmir Usmanov
@ 2014-03-08 17:55 ` Tobias Burnus
2014-03-20 10:53 ` Thomas Schwinge
1 sibling, 0 replies; 89+ messages in thread
From: Tobias Burnus @ 2014-03-08 17:55 UTC (permalink / raw)
To: Ilmir Usmanov
Cc: Thomas Schwinge, Evgeny Gavrin, GarbuzovViacheslav,
Dmitri Botcharnikov, gcc-patches, jakub, fortran
Ilmir Usmanov wrote:
> OpenACC 1.0 fortran FE support -- tests.
I browsed through the patches and it looked good to me.
Tobias
> gcc/testsuite/gfortran.dg/goacc/
> * assumed.f95: New test
> * branch.f95: Likewise
> * coarray.f95: Likewise
> * continuation-free-form.f95: Likewise
> * cray.f95: Likewise
> * critical.f95: Likewise
> * data-clauses.f95: Likewise
> * data-tree.f95: Likewise
> * declare-1.f95: Likewise
> * enter-exit-data.f95: Likewise
> * goacc.exp: Likewise
> * host_data-tree.f95: Likewise
> * if.f95: Likewise
> * kernels-tree.f95: Likewise
> * list.f95: Likewise
> * literal.f95: Likewise
> * loop-1.f95: Likewise
> * loop-2.f95: Likewise
> * loop-3.f95: Likewise
> * omp.f95: Likewise
> * parallel-kernels-clauses.f95: Likewise
> * parallel-kernels-regions.f95: Likewise
> * parallel-tree.f95: Likewise
> * parameter.f95: Likewise
> * pure-elemental-procedures.f95: Likewise
> * reduction.f95: Likewise
> * sentinel-free-form.f95: Likewise
> * several-directives.f95: Likewise
> * sie.f95: Likewise
^ permalink raw reply [flat|nested] 89+ messages in thread
* Re: [PATCH 2/4] [GOMP4] [Fortran] OpenACC 1.0+ support in fortran front-end
2014-03-07 10:46 ` [PATCH 2/4] " Ilmir Usmanov
2014-03-07 10:46 ` [PATCH 3/4] " Ilmir Usmanov
@ 2014-03-08 19:55 ` Tobias Burnus
2014-03-11 12:04 ` Ilmir Usmanov
1 sibling, 1 reply; 89+ messages in thread
From: Tobias Burnus @ 2014-03-08 19:55 UTC (permalink / raw)
To: Ilmir Usmanov
Cc: Thomas Schwinge, Evgeny Gavrin, GarbuzovViacheslav,
Dmitri Botcharnikov, gcc-patches, jakub, fortran
[Resend as it was initially HTML - sorry for those who are CCed.]
Ilmir Usmanov wrote:
> OpenACC 1.0 fortran FE support -- matching and resolving.
> +gfc_match_oacc_cache (void)
> +{
...
> + if (gfc_current_state() != COMP_DO)
> {
> - gfc_free_omp_clauses (c);
> + gfc_error ("ACC CACHE directive must be inside of loop %C");
> + gfc_free_omp_clauses(c);
> return MATCH_ERROR;
> }
Shouldn't it also be supported in DO CONCURRENT? The following is
currently rejected:
real :: b
!$acc loop
outer: do concurrent(i=1:5)
!$acc cache(b)
end do outer
end
(Side question: Is !$acc permitted in DO ... WHILE? If so, you need to
also add EXEC_DO_WHILE.)
> +static void
> +resolve_oacc_positive_int_expr (gfc_expr *expr, const char *clause)
> +{
> + resolve_oacc_scalar_int_expr (expr, clause);
> + if (expr->expr_type == EXPR_CONSTANT && expr->ts.type == BT_INTEGER
> + && expr->value.integer->_mp_size <= 0)
> + gfc_warning ("INTEGER expression of %s clause at %L must be positive",
> + clause, &expr->where);
You shouldn't access internal variables of mpz_t. Use mpz_sgn() instead:
https://gmplib.org/manual/Integer-Comparisons.html
> + if ((sym->ts.type == BT_ASSUMED && sym->attr.pointer)
> + || (sym->ts.type == BT_ASSUMED && CLASS_DATA (sym)
> + && CLASS_DATA (sym)->attr.pointer))
The second line should use BT_CLASS instead of BT_ASSUMED.
> + gfc_error ("POINTER object '%s' of polymorphic type in %s clause at %L",
> + sym->name, name, &loc);
> + if ((sym->ts.type == BT_ASSUMED && sym->attr.cray_pointer)
> + || (sym->ts.type == BT_ASSUMED && CLASS_DATA (sym)
> + && CLASS_DATA (sym)->attr.cray_pointer))
Ditto.
> + gfc_error ("Cray pointer object of polymorphic type '%s' in %s clause at %L",
> + sym->name, name, &loc);
> + if ((sym->ts.type == BT_ASSUMED && sym->attr.cray_pointee)
> + || (sym->ts.type == BT_ASSUMED && CLASS_DATA (sym)
> + && CLASS_DATA (sym)->attr.cray_pointee))
> + gfc_error ("Cray pointee object of polymorphic type '%s' in %s clause at %L",
> + sym->name, name, &loc);
Ditto.
> +static void
> +check_array_not_assumed (gfc_symbol *sym, locus loc, const char *name)
> +{
> + if (sym->as && sym->as->type == AS_ASSUMED_SIZE)
> + gfc_error ("Assumed size array '%s' in %s clause at %L",
> + sym->name, name, &loc);
> + if (sym->as && sym->as->type == AS_ASSUMED_SHAPE)
> + gfc_error ("Assumed shape array '%s' in %s clause at %L",
> + sym->name, name, &loc);
> + if (sym->as && sym->as->type == AS_ASSUMED_RANK)
> + gfc_error ("Assumed rank array '%s' in %s clause at %L",
> + sym->name, name, &loc);
> +}
Actually, I wonder whether one needs to reject assumed-shape: I don't
know what OpenACC says, but my impression is that the problem is that
those can be noncontiguous. However, if they are marked as contiguous
["attr.contiguous"] Â…
On the other hand, your code seems to permit deferred-shape arrays like:
real, pointer :: b(:)
!$acc data copyin(b)
end
The problem is that pointers to deferred-shape arrays can be
noncontiguous. But deferred-shape array are always contiguous when they
are either attr.allocatable or have the "attr.contiguous" attribute.
> + if ((sym->ts.type == BT_ASSUMED && sym->attr.allocatable)
> + || (sym->ts.type == BT_ASSUMED && CLASS_DATA (sym)
> + && CLASS_DATA (sym)->attr.allocatable))
As above: BT_CLASS in the second line.
> +resolve_oacc_deviceptr_clause (gfc_symbol *sym, locus loc, const char *name)
> +{
> + if (sym->ts.type == BT_DERIVED && sym->attr.allocatable)
> + gfc_error ("ALLOCATABLE object '%s' of derived type in %s clause at %L",
> + sym->name, name, &loc);
> + if ((sym->ts.type == BT_ASSUMED && sym->attr.allocatable)
> + || (sym->ts.type == BT_ASSUMED && CLASS_DATA (sym)
> + && CLASS_DATA (sym)->attr.allocatable))
Ditto.
> + gfc_error ("ALLOCATABLE object '%s' of polymorphic type "
> + "in %s clause at %L", sym->name, name, &loc);
> + if (sym->attr.pointer)
> + gfc_error ("POINTER object '%s' in %s clause at %L",
> + sym->name, name, &loc);
Shouldn't you also add
|| (sym->ts.type == BT_CLASS && CLASS_DATA (sym) + && CLASS_DATA
(sym)->attr.class_pointer)
here?
> + case OMP_LIST_USE_DEVICE:
> + if (n->sym->attr.allocatable)
> + gfc_error ("ALLOCATABLE object '%s' in %s clause at %L",
> + n->sym->name, name, &code->loc);
> + if (n->sym->attr.pointer)
> + gfc_error ("POINTER object '%s' in %s clause at %L",
> + n->sym->name, name, &code->loc);
Do you also need to handle BT_CLASS here for allocatable/pointer?
Otherwise, it looks good to me.
Tobias
^ permalink raw reply [flat|nested] 89+ messages in thread
* Re: [PATCH 1/4] [GOMP4] [Fortran] OpenACC 1.0+ support in fortran front-end
2014-03-07 10:44 ` Ilmir Usmanov
2014-03-07 10:45 ` Ilmir Usmanov
@ 2014-03-10 15:44 ` Thomas Schwinge
1 sibling, 0 replies; 89+ messages in thread
From: Thomas Schwinge @ 2014-03-10 15:44 UTC (permalink / raw)
To: Ilmir Usmanov, Tobias Burnus
Cc: Evgeny Gavrin, GarbuzovViacheslav, Dmitri Botcharnikov,
gcc-patches, jakub, fortran
[-- Attachment #1: Type: text/plain, Size: 370 bytes --]
Hi!
On Fri, 7 Mar 2014 14:44:25 +0400, Ilmir Usmanov <i.usmanov@samsung.com> wrote:
> Hi Tobias!
>
> Thanks a lot for your review!
Yes, indeed, thanks for working together on improving the patches!
> OK for gomp4 branch?
For avoidance of doubt, once Tobias is fine with them, these patches are
good to go into gomp-4_0-branch.
Grüße,
Thomas
[-- Attachment #2: Type: application/pgp-signature, Size: 489 bytes --]
^ permalink raw reply [flat|nested] 89+ messages in thread
* Re: [PATCH 2/4] [GOMP4] [Fortran] OpenACC 1.0+ support in fortran front-end
2014-03-08 19:55 ` [PATCH 2/4] " Tobias Burnus
@ 2014-03-11 12:04 ` Ilmir Usmanov
2014-03-12 18:46 ` Tobias Burnus
0 siblings, 1 reply; 89+ messages in thread
From: Ilmir Usmanov @ 2014-03-11 12:04 UTC (permalink / raw)
To: Tobias Burnus
Cc: Thomas Schwinge, Evgeny Gavrin, GarbuzovViacheslav,
Dmitri Botcharnikov, gcc-patches, jakub, fortran
[-- Attachment #1: Type: text/plain, Size: 1783 bytes --]
Hi Tobias!
Thanks a lot for your review and comments!
I tried to fix the patch according them.
On 08.03.2014 23:48, Tobias Burnus wrote:
>
> (Side question: Is !$acc permitted in DO ... WHILE? If so, you need to
> also add EXEC_DO_WHILE.)
>
No, current implementation rejects DO WHILE loops, just like OpenMP:
static void
resolve_oacc_nested_loops (gfc_code *code, gfc_code* do_code, int collapse,
const char *clause)
...
if (do_code->op == EXEC_DO_WHILE)
{
gfc_error ("!$ACC LOOP cannot be a DO WHILE or DO without loop
control "
"at %L", &do_code->loc);
break;
}
>> +static void
>> +check_array_not_assumed (gfc_symbol *sym, locus loc, const char *name)
>> +{
>> + if (sym->as && sym->as->type == AS_ASSUMED_SIZE)
>> + gfc_error ("Assumed size array '%s' in %s clause at %L",
>> + sym->name, name, &loc);
>> + if (sym->as && sym->as->type == AS_ASSUMED_SHAPE)
>> + gfc_error ("Assumed shape array '%s' in %s clause at %L",
>> + sym->name, name, &loc);
>> + if (sym->as && sym->as->type == AS_ASSUMED_RANK)
>> + gfc_error ("Assumed rank array '%s' in %s clause at %L",
>> + sym->name, name, &loc);
>> +}
>
> Actually, I wonder whether one needs to reject assumed-shape: I don't
> know what OpenACC says, but my impression is that the problem is that
> those can be noncontiguous. However, if they are marked as contiguous
> ["attr.contiguous"] Â…
>
You are right. I found several examples of assumed shape arrays used in
data clauses, like:
subroutine vecaddgpu( r, a, b, n )
real, dimension(:) :: r, a, b
integer :: n
integer :: i
!$acc kernels loop present(r,a,b)
do i = 1, n
r(i) = a(i) + b(i)
enddo
end subroutine
Is it OK now?
--
Ilmir.
[-- Attachment #2: 0001-OpenACC-Fortran-FE-part-2.patch --]
[-- Type: text/x-diff, Size: 42243 bytes --]
From 75e3156a196abb69cd66cb467309d64eb1a637f5 Mon Sep 17 00:00:00 2001
From: Ilmir Usmanov <i.usmanov@samsung.com>
Date: Tue, 11 Mar 2014 15:51:15 +0400
Subject: [PATCH] OpenACC Fortran FE -- part 2
---
gcc/fortran/openmp.c | 1225 +++++++++++++++++++++++++++++++++++++++++++++++++-
1 file changed, 1203 insertions(+), 22 deletions(-)
diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index dff3ab1..db18f10 100644
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -69,11 +69,37 @@ gfc_free_omp_clauses (gfc_omp_clauses *c)
gfc_free_expr (c->final_expr);
gfc_free_expr (c->num_threads);
gfc_free_expr (c->chunk_size);
+ gfc_free_expr (c->async_expr);
+ gfc_free_expr (c->gang_expr);
+ gfc_free_expr (c->worker_expr);
+ gfc_free_expr (c->vector_expr);
+ gfc_free_expr (c->num_gangs_expr);
+ gfc_free_expr (c->num_workers_expr);
+ gfc_free_expr (c->vector_length_expr);
+ gfc_free_expr (c->non_clause_wait_expr);
+
for (i = 0; i < OMP_LIST_NUM; i++)
gfc_free_namelist (c->lists[i]);
+
+ gfc_free_expr_list (c->wait_list);
+ gfc_free_expr_list (c->tile_list);
+
free (c);
}
+/* Free expression list. */
+void
+gfc_free_expr_list (gfc_expr_list *list)
+{
+ gfc_expr_list *n;
+
+ for (; list; list = n)
+ {
+ n = list->next;
+ free (list);
+ }
+}
+
/* Match a variable/common block list and construct a namelist from it. */
static match
@@ -169,6 +195,87 @@ cleanup:
return MATCH_ERROR;
}
+static match
+match_oacc_expr_list (const char *str, gfc_expr_list **list, bool allow_asterisk)
+{
+ gfc_expr_list *head, *tail, *p;
+ locus old_loc;
+ gfc_expr *expr;
+ match m;
+
+ head = tail = NULL;
+
+ old_loc = gfc_current_locus;
+
+ m = gfc_match (str);
+ if (m != MATCH_YES)
+ return m;
+
+ for (;;)
+ {
+ m = gfc_match_expr (&expr);
+ if (m == MATCH_YES || allow_asterisk)
+ {
+ p = gfc_get_expr_list ();
+ if (head == NULL)
+ head = tail = p;
+ else
+ {
+ tail->next = p;
+ tail = tail->next;
+ }
+ if (m == MATCH_YES)
+ tail->expr = expr;
+ else if (gfc_match (" *") != MATCH_YES)
+ goto syntax;
+ goto next_item;
+ }
+ if (m == MATCH_ERROR)
+ goto cleanup;
+ goto syntax;
+
+ next_item:
+ if (gfc_match_char (')') == MATCH_YES)
+ break;
+ if (gfc_match_char (',') != MATCH_YES)
+ goto syntax;
+ }
+
+ while (*list)
+ list = &(*list)->next;
+
+ *list = head;
+ return MATCH_YES;
+
+syntax:
+ gfc_error ("Syntax error in OpenACC expression list at %C");
+
+cleanup:
+ gfc_free_expr_list (head);
+ gfc_current_locus = old_loc;
+ return MATCH_ERROR;
+}
+
+static match
+match_oacc_clause_gang (gfc_omp_clauses *cp)
+{
+ if (gfc_match_char ('(') != 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)
+ {
+ cp->gang_static = true;
+ if (gfc_match (" * )") != MATCH_YES)
+ return gfc_match (" %e )", &cp->gang_expr);
+ return MATCH_YES;
+ }
+ return gfc_match (" %e )", &cp->gang_expr);
+}
+
#define OMP_CLAUSE_PRIVATE (1 << 0)
#define OMP_CLAUSE_FIRSTPRIVATE (1 << 1)
#define OMP_CLAUSE_LASTPRIVATE (1 << 2)
@@ -186,11 +293,40 @@ cleanup:
#define OMP_CLAUSE_FINAL (1 << 14)
#define OMP_CLAUSE_MERGEABLE (1 << 15)
-/* Match OpenMP directive clauses. MASK is a bitmask of
+/* OpenACC 2.0 clauses. */
+#define OMP_CLAUSE_ASYNC (1 << 16)
+#define OMP_CLAUSE_NUM_GANGS (1 << 17)
+#define OMP_CLAUSE_NUM_WORKERS (1 << 18)
+#define OMP_CLAUSE_VECTOR_LENGTH (1 << 19)
+#define OMP_CLAUSE_COPY (1 << 20)
+#define OMP_CLAUSE_COPYOUT (1 << 21)
+#define OMP_CLAUSE_CREATE (1 << 22)
+#define OMP_CLAUSE_PRESENT (1 << 23)
+#define OMP_CLAUSE_PRESENT_OR_COPY (1 << 24)
+#define OMP_CLAUSE_PRESENT_OR_COPYIN (1 << 25)
+#define OMP_CLAUSE_PRESENT_OR_COPYOUT (1 << 26)
+#define OMP_CLAUSE_PRESENT_OR_CREATE (1 << 27)
+#define OMP_CLAUSE_DEVICEPTR (1 << 28)
+#define OMP_CLAUSE_GANG (1 << 29)
+#define OMP_CLAUSE_WORKER (1 << 30)
+#define OMP_CLAUSE_VECTOR (1 << 31)
+#define OMP_CLAUSE_SEQ (1LL << 32)
+#define OMP_CLAUSE_INDEPENDENT (1LL << 33)
+#define OMP_CLAUSE_USE_DEVICE (1LL << 34)
+#define OMP_CLAUSE_DEVICE_RESIDENT (1LL << 35)
+#define OMP_CLAUSE_HOST (1LL << 36)
+#define OMP_CLAUSE_DEVICE (1LL << 37)
+#define OMP_CLAUSE_OACC_COPYIN (1LL << 38)
+#define OMP_CLAUSE_WAIT (1LL << 39)
+#define OMP_CLAUSE_DELETE (1LL << 40)
+#define OMP_CLAUSE_AUTO (1LL << 41)
+#define OMP_CLAUSE_TILE (1LL << 42)
+
+/* Match OpenMP and OpenACC directive clauses. MASK is a bitmask of
clauses that are allowed for a particular directive. */
static match
-gfc_match_omp_clauses (gfc_omp_clauses **cp, int mask)
+gfc_match_omp_clauses (gfc_omp_clauses **cp, long long mask)
{
gfc_omp_clauses *c = gfc_get_omp_clauses ();
locus old_loc;
@@ -205,6 +341,52 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, int mask)
needs_space = false;
first = false;
gfc_gobble_whitespace ();
+ if ((mask & OMP_CLAUSE_ASYNC) && !c->async)
+ if (gfc_match ("async") == MATCH_YES)
+ {
+ c->async = true;
+ if (gfc_match (" ( %e )", &c->async_expr) == MATCH_YES)
+ needs_space = false;
+ else
+ needs_space = true;
+ continue;
+ }
+ if ((mask & OMP_CLAUSE_GANG) && !c->gang)
+ if (gfc_match ("gang") == MATCH_YES)
+ {
+ c->gang = true;
+ if (match_oacc_clause_gang(c) == MATCH_YES)
+ needs_space = false;
+ else
+ needs_space = true;
+ continue;
+ }
+ if ((mask & OMP_CLAUSE_WORKER) && !c->worker)
+ if (gfc_match ("worker") == MATCH_YES)
+ {
+ c->worker = true;
+ if (gfc_match (" ( num : %e )", &c->worker_expr) == MATCH_YES
+ || gfc_match (" ( %e )", &c->worker_expr) == MATCH_YES)
+ needs_space = false;
+ else
+ needs_space = true;
+ continue;
+ }
+ if ((mask & OMP_CLAUSE_VECTOR_LENGTH) && c->vector_length_expr == NULL
+ && gfc_match ("vector_length ( %e )", &c->vector_length_expr)
+ == MATCH_YES)
+ continue;
+ if ((mask & OMP_CLAUSE_VECTOR) && !c->vector)
+ if (gfc_match ("vector") == MATCH_YES)
+ {
+ c->vector = true;
+ if (gfc_match (" ( length : %e )", &c->vector_expr) == MATCH_YES
+ || gfc_match (" ( %e )", &c->vector_expr) == MATCH_YES)
+ needs_space = false;
+ else
+ needs_space = true;
+ continue;
+ }
if ((mask & OMP_CLAUSE_IF) && c->if_expr == NULL
&& gfc_match ("if ( %e )", &c->if_expr) == MATCH_YES)
continue;
@@ -247,6 +429,148 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, int mask)
&c->lists[OMP_LIST_COPYIN], true)
== MATCH_YES)
continue;
+ if ((mask & OMP_CLAUSE_NUM_GANGS) && c->num_gangs_expr == NULL
+ && gfc_match ("num_gangs ( %e )", &c->num_gangs_expr) == MATCH_YES)
+ continue;
+ if ((mask & OMP_CLAUSE_NUM_WORKERS) && c->num_workers_expr == NULL
+ && gfc_match ("num_workers ( %e )", &c->num_workers_expr)
+ == MATCH_YES)
+ continue;
+ if ((mask & OMP_CLAUSE_COPY)
+ && gfc_match_omp_variable_list ("copy (",
+ &c->lists[OMP_LIST_COPY], true)
+ == MATCH_YES)
+ continue;
+ if ((mask & OMP_CLAUSE_OACC_COPYIN)
+ && gfc_match_omp_variable_list ("copyin (",
+ &c->lists[OMP_LIST_OACC_COPYIN], true)
+ == MATCH_YES)
+ continue;
+ if ((mask & OMP_CLAUSE_COPYOUT)
+ && gfc_match_omp_variable_list ("copyout (",
+ &c->lists[OMP_LIST_COPYOUT], true)
+ == MATCH_YES)
+ continue;
+ if ((mask & OMP_CLAUSE_CREATE)
+ && gfc_match_omp_variable_list ("create (",
+ &c->lists[OMP_LIST_CREATE], true)
+ == MATCH_YES)
+ continue;
+ if ((mask & OMP_CLAUSE_DELETE)
+ && gfc_match_omp_variable_list ("delete (",
+ &c->lists[OMP_LIST_DELETE], true)
+ == MATCH_YES)
+ continue;
+ if ((mask & OMP_CLAUSE_PRESENT)
+ && gfc_match_omp_variable_list ("present (",
+ &c->lists[OMP_LIST_PRESENT], true)
+ == MATCH_YES)
+ continue;
+ if ((mask & OMP_CLAUSE_PRESENT_OR_COPY)
+ && gfc_match_omp_variable_list ("present_or_copy (",
+ &c->lists[OMP_LIST_PRESENT_OR_COPY],
+ true)
+ == MATCH_YES)
+ continue;
+ if ((mask & OMP_CLAUSE_PRESENT_OR_COPY)
+ && gfc_match_omp_variable_list ("pcopy (",
+ &c->lists[OMP_LIST_PRESENT_OR_COPY],
+ true)
+ == MATCH_YES)
+ continue;
+ if ((mask & OMP_CLAUSE_PRESENT_OR_COPYIN)
+ && gfc_match_omp_variable_list ("present_or_copyin (",
+ &c->lists[OMP_LIST_PRESENT_OR_COPYIN],
+ true)
+ == MATCH_YES)
+ continue;
+ if ((mask & OMP_CLAUSE_PRESENT_OR_COPYIN)
+ && gfc_match_omp_variable_list ("pcopyin (",
+ &c->lists[OMP_LIST_PRESENT_OR_COPYIN],
+ true)
+ == MATCH_YES)
+ continue;
+ if ((mask & OMP_CLAUSE_PRESENT_OR_COPYOUT)
+ && gfc_match_omp_variable_list ("present_or_copyout (",
+ &c->lists[OMP_LIST_PRESENT_OR_COPYOUT],
+ true)
+ == MATCH_YES)
+ continue;
+ if ((mask & OMP_CLAUSE_PRESENT_OR_COPYOUT)
+ && gfc_match_omp_variable_list ("pcopyout (",
+ &c->lists[OMP_LIST_PRESENT_OR_COPYOUT],
+ true)
+ == MATCH_YES)
+ continue;
+ if ((mask & OMP_CLAUSE_PRESENT_OR_CREATE)
+ && gfc_match_omp_variable_list ("present_or_create (",
+ &c->lists[OMP_LIST_PRESENT_OR_CREATE],
+ true)
+ == MATCH_YES)
+ continue;
+ if ((mask & OMP_CLAUSE_PRESENT_OR_CREATE)
+ && gfc_match_omp_variable_list ("pcreate (",
+ &c->lists[OMP_LIST_PRESENT_OR_CREATE],
+ true)
+ == MATCH_YES)
+ continue;
+ if ((mask & OMP_CLAUSE_DEVICEPTR)
+ && gfc_match_omp_variable_list ("deviceptr (",
+ &c->lists[OMP_LIST_DEVICEPTR], true)
+ == MATCH_YES)
+ continue;
+ if ((mask & OMP_CLAUSE_USE_DEVICE)
+ && gfc_match_omp_variable_list ("use_device (",
+ &c->lists[OMP_LIST_USE_DEVICE], true)
+ == MATCH_YES)
+ continue;
+ if ((mask & OMP_CLAUSE_DEVICE_RESIDENT)
+ && gfc_match_omp_variable_list ("device_resident (",
+ &c->lists[OMP_LIST_DEVICE_RESIDENT],
+ true)
+ == MATCH_YES)
+ continue;
+ if ((mask & OMP_CLAUSE_HOST)
+ && gfc_match_omp_variable_list ("host (",
+ &c->lists[OMP_LIST_HOST], true)
+ == MATCH_YES)
+ continue;
+ if ((mask & OMP_CLAUSE_DEVICE)
+ && gfc_match_omp_variable_list ("device (",
+ &c->lists[OMP_LIST_DEVICE], true)
+ == MATCH_YES)
+ continue;
+ if ((mask & OMP_CLAUSE_TILE)
+ && match_oacc_expr_list ("tile (", &c->tile_list, true) == MATCH_YES)
+ continue;
+ if ((mask & OMP_CLAUSE_SEQ) && !c->seq
+ && gfc_match ("seq") == MATCH_YES)
+ {
+ c->seq = true;
+ needs_space = true;
+ continue;
+ }
+ if ((mask & OMP_CLAUSE_INDEPENDENT) && !c->independent
+ && gfc_match ("independent") == MATCH_YES)
+ {
+ c->independent = true;
+ needs_space = true;
+ continue;
+ }
+ if ((mask & OMP_CLAUSE_AUTO) && !c->par_auto
+ && gfc_match ("auto") == MATCH_YES)
+ {
+ c->par_auto = true;
+ needs_space = true;
+ continue;
+ }
+ if ((mask & OMP_CLAUSE_WAIT) && !c->wait
+ && gfc_match ("wait") == MATCH_YES)
+ {
+ c->wait = true;
+ match_oacc_expr_list (" (", &c->wait_list, false);
+ continue;
+ }
old_loc = gfc_current_locus;
if ((mask & OMP_CLAUSE_REDUCTION)
&& gfc_match ("reduction ( ") == MATCH_YES)
@@ -423,31 +747,258 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, int mask)
break;
}
- if (gfc_match_omp_eos () != MATCH_YES)
+ if (gfc_match_omp_eos () != MATCH_YES)
+ {
+ gfc_free_omp_clauses (c);
+ return MATCH_ERROR;
+ }
+
+ *cp = c;
+ return MATCH_YES;
+}
+
+#define OACC_PARALLEL_CLAUSES \
+ (OMP_CLAUSE_IF | OMP_CLAUSE_ASYNC | OMP_CLAUSE_NUM_GANGS \
+ | OMP_CLAUSE_NUM_WORKERS | OMP_CLAUSE_VECTOR_LENGTH | OMP_CLAUSE_REDUCTION \
+ | OMP_CLAUSE_COPY | OMP_CLAUSE_OACC_COPYIN | OMP_CLAUSE_COPYOUT \
+ | OMP_CLAUSE_CREATE | OMP_CLAUSE_PRESENT | OMP_CLAUSE_PRESENT_OR_COPY \
+ | OMP_CLAUSE_PRESENT_OR_COPYIN | OMP_CLAUSE_PRESENT_OR_COPYOUT \
+ | OMP_CLAUSE_PRESENT_OR_CREATE | OMP_CLAUSE_DEVICEPTR | OMP_CLAUSE_PRIVATE \
+ | OMP_CLAUSE_FIRSTPRIVATE | OMP_CLAUSE_DEFAULT | OMP_CLAUSE_WAIT)
+#define OACC_KERNELS_CLAUSES \
+ (OMP_CLAUSE_IF | OMP_CLAUSE_ASYNC | OMP_CLAUSE_DEVICEPTR \
+ | OMP_CLAUSE_COPY | OMP_CLAUSE_OACC_COPYIN | OMP_CLAUSE_COPYOUT \
+ | OMP_CLAUSE_CREATE | OMP_CLAUSE_PRESENT | OMP_CLAUSE_PRESENT_OR_COPY \
+ | OMP_CLAUSE_PRESENT_OR_COPYIN | OMP_CLAUSE_PRESENT_OR_COPYOUT \
+ | OMP_CLAUSE_PRESENT_OR_CREATE | OMP_CLAUSE_DEFAULT | OMP_CLAUSE_WAIT)
+#define OACC_DATA_CLAUSES \
+ (OMP_CLAUSE_IF | OMP_CLAUSE_DEVICEPTR | OMP_CLAUSE_COPY \
+ | OMP_CLAUSE_OACC_COPYIN | OMP_CLAUSE_COPYOUT | OMP_CLAUSE_CREATE \
+ | OMP_CLAUSE_PRESENT | OMP_CLAUSE_PRESENT_OR_COPY \
+ | OMP_CLAUSE_PRESENT_OR_COPYIN | OMP_CLAUSE_PRESENT_OR_COPYOUT \
+ | OMP_CLAUSE_PRESENT_OR_CREATE)
+#define OACC_LOOP_CLAUSES \
+ (OMP_CLAUSE_COLLAPSE | OMP_CLAUSE_GANG | OMP_CLAUSE_WORKER \
+ | OMP_CLAUSE_VECTOR | OMP_CLAUSE_SEQ | OMP_CLAUSE_INDEPENDENT \
+ | OMP_CLAUSE_PRIVATE | OMP_CLAUSE_REDUCTION | OMP_CLAUSE_AUTO \
+ | OMP_CLAUSE_TILE)
+#define OACC_PARALLEL_LOOP_CLAUSES \
+ (OACC_LOOP_CLAUSES | OACC_PARALLEL_CLAUSES)
+#define OACC_KERNELS_LOOP_CLAUSES \
+ (OACC_LOOP_CLAUSES | OACC_KERNELS_CLAUSES)
+#define OACC_HOST_DATA_CLAUSES OMP_CLAUSE_USE_DEVICE
+#define OACC_DECLARE_CLAUSES \
+ (OMP_CLAUSE_COPY | OMP_CLAUSE_OACC_COPYIN | OMP_CLAUSE_COPYOUT \
+ | OMP_CLAUSE_CREATE | OMP_CLAUSE_DEVICEPTR | OMP_CLAUSE_DEVICE_RESIDENT \
+ | OMP_CLAUSE_PRESENT | OMP_CLAUSE_PRESENT_OR_COPY \
+ | OMP_CLAUSE_PRESENT_OR_COPYIN | OMP_CLAUSE_PRESENT_OR_COPYOUT \
+ | OMP_CLAUSE_PRESENT_OR_CREATE)
+#define OACC_UPDATE_CLAUSES \
+ (OMP_CLAUSE_IF | OMP_CLAUSE_ASYNC | OMP_CLAUSE_HOST | OMP_CLAUSE_DEVICE)
+#define OACC_ENTER_DATA_CLAUSES \
+ (OMP_CLAUSE_IF | OMP_CLAUSE_ASYNC | OMP_CLAUSE_WAIT | OMP_CLAUSE_OACC_COPYIN \
+ | OMP_CLAUSE_CREATE | OMP_CLAUSE_PRESENT_OR_COPYIN \
+ | OMP_CLAUSE_PRESENT_OR_CREATE)
+#define OACC_EXIT_DATA_CLAUSES \
+ (OMP_CLAUSE_IF | OMP_CLAUSE_ASYNC | OMP_CLAUSE_WAIT | OMP_CLAUSE_COPYOUT \
+ | OMP_CLAUSE_DELETE)
+
+#define OMP_PARALLEL_CLAUSES \
+ (OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE | OMP_CLAUSE_SHARED \
+ | OMP_CLAUSE_COPYIN | OMP_CLAUSE_REDUCTION | OMP_CLAUSE_IF \
+ | OMP_CLAUSE_NUM_THREADS | OMP_CLAUSE_DEFAULT)
+#define OMP_DO_CLAUSES \
+ (OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE \
+ | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_REDUCTION \
+ | OMP_CLAUSE_SCHEDULE | OMP_CLAUSE_ORDERED | OMP_CLAUSE_COLLAPSE)
+#define OMP_SECTIONS_CLAUSES \
+ (OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE \
+ | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_REDUCTION)
+#define OMP_TASK_CLAUSES \
+ (OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE | OMP_CLAUSE_SHARED \
+ | OMP_CLAUSE_IF | OMP_CLAUSE_DEFAULT | OMP_CLAUSE_UNTIED \
+ | OMP_CLAUSE_FINAL | OMP_CLAUSE_MERGEABLE)
+
+
+match
+gfc_match_oacc_parallel_loop (void)
+{
+ gfc_omp_clauses *c;
+ if (gfc_match_omp_clauses (&c, OACC_PARALLEL_LOOP_CLAUSES) != MATCH_YES)
+ return MATCH_ERROR;
+
+ new_st.op = EXEC_OACC_PARALLEL_LOOP;
+ new_st.ext.omp_clauses = c;
+ return MATCH_YES;
+}
+
+
+match
+gfc_match_oacc_parallel (void)
+{
+ gfc_omp_clauses *c;
+ if (gfc_match_omp_clauses (&c, OACC_PARALLEL_CLAUSES) != MATCH_YES)
+ return MATCH_ERROR;
+
+ new_st.op = EXEC_OACC_PARALLEL;
+ new_st.ext.omp_clauses = c;
+ return MATCH_YES;
+}
+
+
+match
+gfc_match_oacc_kernels_loop (void)
+{
+ gfc_omp_clauses *c;
+ if (gfc_match_omp_clauses (&c, OACC_KERNELS_LOOP_CLAUSES) != MATCH_YES)
+ return MATCH_ERROR;
+
+ new_st.op = EXEC_OACC_KERNELS_LOOP;
+ new_st.ext.omp_clauses = c;
+ return MATCH_YES;
+}
+
+
+match
+gfc_match_oacc_kernels (void)
+{
+ gfc_omp_clauses *c;
+ if (gfc_match_omp_clauses (&c, OACC_KERNELS_CLAUSES) != MATCH_YES)
+ return MATCH_ERROR;
+
+ new_st.op = EXEC_OACC_KERNELS;
+ new_st.ext.omp_clauses = c;
+ return MATCH_YES;
+}
+
+
+match
+gfc_match_oacc_data (void)
+{
+ gfc_omp_clauses *c;
+ if (gfc_match_omp_clauses (&c, OACC_DATA_CLAUSES) != MATCH_YES)
+ return MATCH_ERROR;
+
+ new_st.op = EXEC_OACC_DATA;
+ new_st.ext.omp_clauses = c;
+ return MATCH_YES;
+}
+
+
+match
+gfc_match_oacc_host_data (void)
+{
+ gfc_omp_clauses *c;
+ if (gfc_match_omp_clauses (&c, OACC_HOST_DATA_CLAUSES) != MATCH_YES)
+ return MATCH_ERROR;
+
+ new_st.op = EXEC_OACC_HOST_DATA;
+ new_st.ext.omp_clauses = c;
+ return MATCH_YES;
+}
+
+
+match
+gfc_match_oacc_loop (void)
+{
+ gfc_omp_clauses *c;
+ if (gfc_match_omp_clauses (&c, OACC_LOOP_CLAUSES) != MATCH_YES)
+ return MATCH_ERROR;
+
+ new_st.op = EXEC_OACC_LOOP;
+ new_st.ext.omp_clauses = c;
+ return MATCH_YES;
+}
+
+
+match
+gfc_match_oacc_declare (void)
+{
+ gfc_omp_clauses *c;
+ if (gfc_match_omp_clauses (&c, OACC_DECLARE_CLAUSES) != MATCH_YES)
+ return MATCH_ERROR;
+
+ new_st.ext.omp_clauses = c;
+ new_st.ext.omp_clauses->ext.loc = gfc_current_locus;
+ return MATCH_YES;
+}
+
+
+match
+gfc_match_oacc_update (void)
+{
+ gfc_omp_clauses *c;
+ if (gfc_match_omp_clauses (&c, OACC_UPDATE_CLAUSES) != MATCH_YES)
+ return MATCH_ERROR;
+
+ new_st.op = EXEC_OACC_UPDATE;
+ new_st.ext.omp_clauses = c;
+ return MATCH_YES;
+}
+
+
+match
+gfc_match_oacc_enter_data (void)
+{
+ gfc_omp_clauses *c;
+ if (gfc_match_omp_clauses (&c, OACC_ENTER_DATA_CLAUSES) != MATCH_YES)
+ return MATCH_ERROR;
+
+ new_st.op = EXEC_OACC_ENTER_DATA;
+ new_st.ext.omp_clauses = c;
+ return MATCH_YES;
+}
+
+
+match
+gfc_match_oacc_exit_data (void)
+{
+ gfc_omp_clauses *c;
+ if (gfc_match_omp_clauses (&c, OACC_EXIT_DATA_CLAUSES) != MATCH_YES)
+ return MATCH_ERROR;
+
+ new_st.op = EXEC_OACC_EXIT_DATA;
+ new_st.ext.omp_clauses = c;
+ return MATCH_YES;
+}
+
+
+match
+gfc_match_oacc_wait (void)
+{
+ gfc_omp_clauses *c = gfc_get_omp_clauses ();
+ gfc_match (" ( %e )", &c->non_clause_wait_expr);
+
+ new_st.op = EXEC_OACC_WAIT;
+ new_st.ext.omp_clauses = c;
+ return MATCH_YES;
+}
+
+
+match
+gfc_match_oacc_cache (void)
+{
+ gfc_omp_clauses *c = gfc_get_omp_clauses ();
+ match m = gfc_match_omp_variable_list (" (",&c->lists[OMP_LIST_CACHE], true);
+ if (m != MATCH_YES)
+ {
+ gfc_free_omp_clauses(c);
+ return m;
+ }
+
+ if (gfc_current_state() != COMP_DO
+ && gfc_current_state() != COMP_DO_CONCURRENT)
{
- gfc_free_omp_clauses (c);
+ gfc_error ("ACC CACHE directive must be inside of loop %C");
+ gfc_free_omp_clauses(c);
return MATCH_ERROR;
}
- *cp = c;
+ new_st.op = EXEC_OACC_CACHE;
+ new_st.ext.omp_clauses = c;
return MATCH_YES;
}
-#define OMP_PARALLEL_CLAUSES \
- (OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE | OMP_CLAUSE_SHARED \
- | OMP_CLAUSE_COPYIN | OMP_CLAUSE_REDUCTION | OMP_CLAUSE_IF \
- | OMP_CLAUSE_NUM_THREADS | OMP_CLAUSE_DEFAULT)
-#define OMP_DO_CLAUSES \
- (OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE \
- | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_REDUCTION \
- | OMP_CLAUSE_SCHEDULE | OMP_CLAUSE_ORDERED | OMP_CLAUSE_COLLAPSE)
-#define OMP_SECTIONS_CLAUSES \
- (OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE \
- | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_REDUCTION)
-#define OMP_TASK_CLAUSES \
- (OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE | OMP_CLAUSE_SHARED \
- | OMP_CLAUSE_IF | OMP_CLAUSE_DEFAULT | OMP_CLAUSE_UNTIED \
- | OMP_CLAUSE_FINAL | OMP_CLAUSE_MERGEABLE)
match
gfc_match_omp_parallel (void)
@@ -793,6 +1344,124 @@ gfc_match_omp_end_single (void)
}
+static bool
+oacc_is_loop (gfc_code *code)
+{
+ return code->op == EXEC_OACC_PARALLEL_LOOP
+ || code->op == EXEC_OACC_KERNELS_LOOP
+ || code->op == EXEC_OACC_LOOP;
+}
+
+static void
+resolve_oacc_scalar_int_expr (gfc_expr *expr, const char *clause)
+{
+ if (!gfc_resolve_expr (expr)
+ || expr->ts.type != BT_INTEGER || expr->rank != 0)
+ gfc_error ("%s clause at %L requires a scalar INTEGER expression",
+ clause, &expr->where);
+}
+
+
+static void
+resolve_oacc_positive_int_expr (gfc_expr *expr, const char *clause)
+{
+ resolve_oacc_scalar_int_expr (expr, clause);
+ if (expr->expr_type == EXPR_CONSTANT && expr->ts.type == BT_INTEGER
+ && mpz_sgn(expr->value.integer) <= 0)
+ gfc_warning ("INTEGER expression of %s clause at %L must be positive",
+ clause, &expr->where);
+}
+
+/* Emits error when symbol is pointer, cray pointer or cray pointee
+ of derived of polymorphic type. */
+
+static void
+check_symbol_not_pointer (gfc_symbol *sym, locus loc, const char *name)
+{
+ if (sym->ts.type == BT_DERIVED && sym->attr.pointer)
+ gfc_error ("POINTER object '%s' of derived type in %s clause at %L",
+ sym->name, name, &loc);
+ if (sym->ts.type == BT_DERIVED && sym->attr.cray_pointer)
+ gfc_error ("Cray pointer object of derived type '%s' in %s clause at %L",
+ sym->name, name, &loc);
+ if (sym->ts.type == BT_DERIVED && sym->attr.cray_pointee)
+ gfc_error ("Cray pointee object of derived type '%s' in %s clause at %L",
+ sym->name, name, &loc);
+
+ if ((sym->ts.type == BT_ASSUMED && sym->attr.pointer)
+ || (sym->ts.type == BT_CLASS && CLASS_DATA (sym)
+ && CLASS_DATA (sym)->attr.pointer))
+ gfc_error ("POINTER object '%s' of polymorphic type in %s clause at %L",
+ sym->name, name, &loc);
+ if ((sym->ts.type == BT_ASSUMED && sym->attr.cray_pointer)
+ || (sym->ts.type == BT_CLASS && CLASS_DATA (sym)
+ && CLASS_DATA (sym)->attr.cray_pointer))
+ gfc_error ("Cray pointer object of polymorphic type '%s' in %s clause at %L",
+ sym->name, name, &loc);
+ if ((sym->ts.type == BT_ASSUMED && sym->attr.cray_pointee)
+ || (sym->ts.type == BT_CLASS && CLASS_DATA (sym)
+ && CLASS_DATA (sym)->attr.cray_pointee))
+ gfc_error ("Cray pointee object of polymorphic type '%s' in %s clause at %L",
+ sym->name, name, &loc);
+}
+
+/* Emits error when symbol represents assumed size/rank array. */
+
+static void
+check_array_not_assumed (gfc_symbol *sym, locus loc, const char *name)
+{
+ if (sym->as && sym->as->type == AS_ASSUMED_SIZE)
+ gfc_error ("Assumed size array '%s' in %s clause at %L",
+ sym->name, name, &loc);
+ if (sym->as && sym->as->type == AS_ASSUMED_RANK)
+ gfc_error ("Assumed rank array '%s' in %s clause at %L",
+ sym->name, name, &loc);
+}
+
+static void
+resolve_oacc_data_clauses (gfc_symbol *sym, locus loc, const char *name)
+{
+ if (sym->ts.type == BT_DERIVED && sym->attr.allocatable)
+ gfc_error ("ALLOCATABLE object '%s' of derived type in %s clause at %L",
+ sym->name, name, &loc);
+ if ((sym->ts.type == BT_ASSUMED && sym->attr.allocatable)
+ || (sym->ts.type == BT_CLASS && CLASS_DATA (sym)
+ && CLASS_DATA (sym)->attr.allocatable))
+ gfc_error ("ALLOCATABLE object '%s' of polymorphic type "
+ "in %s clause at %L", sym->name, name, &loc);
+ check_symbol_not_pointer (sym, loc, name);
+ check_array_not_assumed (sym, loc, name);
+}
+
+static void
+resolve_oacc_deviceptr_clause (gfc_symbol *sym, locus loc, const char *name)
+{
+ if (sym->attr.pointer
+ || (sym->ts.type == BT_CLASS && CLASS_DATA (sym)
+ && CLASS_DATA (sym)->attr.class_pointer))
+ gfc_error ("POINTER object '%s' in %s clause at %L",
+ sym->name, name, &loc);
+ if (sym->attr.cray_pointer
+ || (sym->ts.type == BT_CLASS && CLASS_DATA (sym)
+ && CLASS_DATA (sym)->attr.cray_pointer))
+ gfc_error ("Cray pointer object '%s' in %s clause at %L",
+ sym->name, name, &loc);
+ if (sym->attr.cray_pointee
+ || (sym->ts.type == BT_CLASS && CLASS_DATA (sym)
+ && CLASS_DATA (sym)->attr.cray_pointee))
+ gfc_error ("Cray pointee object '%s' in %s clause at %L",
+ sym->name, name, &loc);
+ if (sym->attr.allocatable
+ || (sym->ts.type == BT_CLASS && CLASS_DATA (sym)
+ && CLASS_DATA (sym)->attr.allocatable))
+ gfc_error ("ALLOCATABLE object '%s' in %s clause at %L",
+ sym->name, name, &loc);
+ if (sym->attr.value)
+ gfc_error ("VALUE object '%s' in %s clause at %L",
+ sym->name, name, &loc);
+ check_array_not_assumed (sym, loc, name);
+}
+
/* OpenMP directive resolving routines. */
static void
@@ -800,10 +1469,14 @@ resolve_omp_clauses (gfc_code *code)
{
gfc_omp_clauses *omp_clauses = code->ext.omp_clauses;
gfc_namelist *n;
+ gfc_expr_list *el;
int list;
static const char *clause_names[]
= { "PRIVATE", "FIRSTPRIVATE", "LASTPRIVATE", "COPYPRIVATE", "SHARED",
- "COPYIN", "REDUCTION" };
+ "COPYIN", "COPY", "COPYIN", "COPYOUT", "CREATE", "DELETE",
+ "PRESENT", "PRESENT_OR_COPY", "PRESENT_OR_COPYIN", "PRESENT_OR_COPYOUT",
+ "PRESENT_OR_CREATE", "DEVICEPTR", "DEVICE_RESIDENT", "USE_DEVICE",
+ "HOST", "DEVICE", "CACHE", "REDUCTION"};
if (omp_clauses == NULL)
return;
@@ -996,7 +1669,9 @@ resolve_omp_clauses (gfc_code *code)
gfc_error ("Cray pointer '%s' in %s clause at %L",
n->sym->name, name, &code->loc);
}
- if (n->sym->as && n->sym->as->type == AS_ASSUMED_SIZE)
+ if (oacc_is_loop (code) || code->op == EXEC_OACC_PARALLEL)
+ check_array_not_assumed (n->sym, code->loc, name);
+ else if (n->sym->as && n->sym->as->type == AS_ASSUMED_SIZE)
gfc_error ("Assumed size array '%s' in %s clause at %L",
n->sym->name, name, &code->loc);
if (n->sym->attr.in_namelist
@@ -1005,6 +1680,17 @@ resolve_omp_clauses (gfc_code *code)
gfc_error ("Variable '%s' in %s clause is used in "
"NAMELIST statement at %L",
n->sym->name, name, &code->loc);
+
+ if (list >= OMP_LIST_DATA_CLAUSE_FIRST
+ && list < OMP_LIST_DATA_CLAUSE_LAST)
+ resolve_oacc_data_clauses (n->sym, code->loc, name);
+
+ if (list > OMP_LIST_DATA_CLAUSE_LAST
+ && list < OMP_LIST_REDUCTION_FIRST)
+ {
+ check_symbol_not_pointer (n->sym, code->loc, name);
+ check_array_not_assumed (n->sym, code->loc, name);
+ }
switch (list)
{
case OMP_LIST_PLUS:
@@ -1052,6 +1738,28 @@ resolve_omp_clauses (gfc_code *code)
to be done here for OMP_LIST_PRIVATE. */
case OMP_LIST_PRIVATE:
gcc_assert (code->op != EXEC_NOP);
+ break;
+ case OMP_LIST_DEVICEPTR:
+ resolve_oacc_deviceptr_clause (n->sym, code->loc, name);
+ break;
+ case OMP_LIST_USE_DEVICE:
+ if (n->sym->attr.allocatable
+ || (n->sym->ts.type == BT_CLASS && CLASS_DATA (n->sym)
+ && CLASS_DATA (n->sym)->attr.allocatable))
+ gfc_error ("ALLOCATABLE object '%s' in %s clause at %L",
+ n->sym->name, name, &code->loc);
+ if (n->sym->attr.pointer
+ || (n->sym->ts.type == BT_CLASS && CLASS_DATA (n->sym)
+ && CLASS_DATA (n->sym)->attr.class_pointer))
+ gfc_error ("POINTER object '%s' in %s clause at %L",
+ n->sym->name, name, &code->loc);
+ if (n->sym->attr.cray_pointer)
+ gfc_error ("Cray pointer object '%s' in %s clause at %L",
+ n->sym->name, name, &code->loc);
+ if (n->sym->attr.cray_pointee)
+ gfc_error ("Cray pointee object '%s' in %s clause at %L",
+ n->sym->name, name, &code->loc);
+ break;
default:
break;
}
@@ -1059,6 +1767,25 @@ resolve_omp_clauses (gfc_code *code)
break;
}
}
+ if (omp_clauses->async)
+ if (omp_clauses->async_expr)
+ resolve_oacc_scalar_int_expr (omp_clauses->async_expr, "ASYNC");
+ 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");
+ 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");
+ if (omp_clauses->worker_expr)
+ resolve_oacc_positive_int_expr (omp_clauses->worker_expr, "WORKER");
+ if (omp_clauses->vector_expr)
+ resolve_oacc_positive_int_expr (omp_clauses->vector_expr, "VECTOR");
+ if (omp_clauses->wait)
+ if (omp_clauses->wait_list)
+ for (el = omp_clauses->wait_list; el; el = el->next)
+ resolve_oacc_positive_int_expr (el->expr, "WAIT");
}
@@ -1727,6 +2454,458 @@ resolve_omp_do (gfc_code *code)
}
}
+typedef struct omp_context oacc_context;
+oacc_context *oacc_current_ctx;
+
+static bool
+oacc_is_parallel (gfc_code *code)
+{
+ return code->op == EXEC_OACC_PARALLEL || code->op == EXEC_OACC_PARALLEL_LOOP;
+}
+
+static bool
+oacc_is_kernels (gfc_code *code)
+{
+ return code->op == EXEC_OACC_KERNELS || code->op == EXEC_OACC_KERNELS_LOOP;
+}
+
+static gfc_statement
+omp_code_to_statement (gfc_code *code)
+{
+switch (code->op)
+ {
+ case EXEC_OMP_PARALLEL:
+ return ST_OMP_PARALLEL;
+ case EXEC_OMP_PARALLEL_SECTIONS:
+ return ST_OMP_PARALLEL_SECTIONS;
+ case EXEC_OMP_SECTIONS:
+ return ST_OMP_SECTIONS;
+ case EXEC_OMP_ORDERED:
+ return ST_OMP_ORDERED;
+ case EXEC_OMP_CRITICAL:
+ return ST_OMP_CRITICAL;
+ case EXEC_OMP_MASTER:
+ return ST_OMP_MASTER;
+ case EXEC_OMP_SINGLE:
+ return ST_OMP_SINGLE;
+ case EXEC_OMP_TASK:
+ return ST_OMP_TASK;
+ case EXEC_OMP_WORKSHARE:
+ return ST_OMP_WORKSHARE;
+ case EXEC_OMP_PARALLEL_WORKSHARE:
+ return ST_OMP_PARALLEL_WORKSHARE;
+ case EXEC_OMP_DO:
+ return ST_OMP_DO;
+ default:
+ gcc_unreachable ();
+ }
+}
+
+static gfc_statement
+oacc_code_to_statement (gfc_code *code)
+{
+switch (code->op)
+ {
+ case EXEC_OACC_PARALLEL:
+ return ST_OACC_PARALLEL;
+ case EXEC_OACC_KERNELS:
+ return ST_OACC_KERNELS;
+ case EXEC_OACC_DATA:
+ return ST_OACC_DATA;
+ case EXEC_OACC_HOST_DATA:
+ return ST_OACC_HOST_DATA;
+ case EXEC_OACC_PARALLEL_LOOP:
+ return ST_OACC_PARALLEL_LOOP;
+ case EXEC_OACC_KERNELS_LOOP:
+ return ST_OACC_KERNELS_LOOP;
+ case EXEC_OACC_LOOP:
+ return ST_OACC_LOOP;
+ default:
+ gcc_unreachable ();
+ }
+}
+
+static void
+resolve_oacc_directive_inside_omp_region (gfc_code *code)
+{
+ if (omp_current_ctx != NULL)
+ {
+ gfc_statement st = omp_code_to_statement (omp_current_ctx->code);
+ gfc_statement oacc_st = oacc_code_to_statement (code);
+ gfc_error ("The %s directive cannot be specified within "
+ "a %s region at %L", gfc_ascii_statement (oacc_st),
+ gfc_ascii_statement (st), &code->loc);
+ }
+}
+
+static void
+resolve_omp_directive_inside_oacc_region (gfc_code *code)
+{
+ if (oacc_current_ctx != NULL)
+ {
+ gfc_statement st = oacc_code_to_statement (oacc_current_ctx->code);
+ gfc_statement omp_st = omp_code_to_statement (code);
+ gfc_error ("The %s directive cannot be specified within "
+ "a %s region at %L", gfc_ascii_statement (omp_st),
+ gfc_ascii_statement (st), &code->loc);
+ }
+}
+
+
+static void
+resolve_oacc_nested_loops (gfc_code *code, gfc_code* do_code, int collapse,
+ const char *clause)
+{
+ gfc_symbol *dovar;
+ gfc_code *c;
+ int i;
+
+ for (i = 1; i <= collapse; i++)
+ {
+ if (do_code->op == EXEC_DO_WHILE)
+ {
+ gfc_error ("!$ACC LOOP cannot be a DO WHILE or DO without loop control "
+ "at %L", &do_code->loc);
+ break;
+ }
+ gcc_assert (do_code->op == EXEC_DO || do_code->op == EXEC_DO_CONCURRENT);
+ if (do_code->ext.iterator->var->ts.type != BT_INTEGER)
+ gfc_error ("!$ACC LOOP iteration variable must be of type integer at %L",
+ &do_code->loc);
+ dovar = do_code->ext.iterator->var->symtree->n.sym;
+ if (i > 1)
+ {
+ gfc_code *do_code2 = code->block->next;
+ int j;
+
+ for (j = 1; j < i; j++)
+ {
+ gfc_symbol *ivar = do_code2->ext.iterator->var->symtree->n.sym;
+ if (dovar == ivar
+ || gfc_find_sym_in_expr (ivar, do_code->ext.iterator->start)
+ || gfc_find_sym_in_expr (ivar, do_code->ext.iterator->end)
+ || gfc_find_sym_in_expr (ivar, do_code->ext.iterator->step))
+ {
+ gfc_error ("!$ACC LOOP %s loops don't form rectangular iteration space at %L",
+ clause, &do_code->loc);
+ break;
+ }
+ if (j < i)
+ break;
+ do_code2 = do_code2->block->next;
+ }
+ }
+ if (i == collapse)
+ break;
+ for (c = do_code->next; c; c = c->next)
+ if (c->op != EXEC_NOP && c->op != EXEC_CONTINUE)
+ {
+ gfc_error ("%s !$ACC LOOP loops not perfectly nested at %L",
+ clause, &c->loc);
+ break;
+ }
+ if (c)
+ break;
+ do_code = do_code->block;
+ if (do_code->op != EXEC_DO && do_code->op != EXEC_DO_WHILE
+ && do_code->op != EXEC_DO_CONCURRENT)
+ {
+ gfc_error ("not enough DO loops for %s !$ACC LOOP at %L",
+ clause, &code->loc);
+ break;
+ }
+ do_code = do_code->next;
+ if (do_code == NULL
+ || (do_code->op != EXEC_DO && do_code->op != EXEC_DO_WHILE
+ && do_code->op != EXEC_DO_CONCURRENT))
+ {
+ gfc_error ("not enough DO loops for %s !$ACC LOOP at %L",
+ clause, &code->loc);
+ break;
+ }
+ }
+}
+
+
+static void
+resolve_oacc_params_in_parallel (gfc_code *code, const char *clause)
+{
+ oacc_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);
+ for (c = oacc_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);
+ }
+}
+
+
+static void
+resolve_oacc_loop_blocks (gfc_code *code)
+{
+ oacc_context *c;
+
+ if (!oacc_is_loop (code))
+ return;
+
+ if (code->op == EXEC_OACC_LOOP)
+ for (c = oacc_current_ctx; c; c = c->previous)
+ {
+ if (oacc_is_loop (c->code))
+ {
+ if (code->ext.omp_clauses->gang)
+ {
+ if (c->code->ext.omp_clauses->gang)
+ gfc_error ("Loop parallelized across gangs is not allowed "
+ "inside another loop parallelized across gangs at %L",
+ &code->loc);
+ 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",
+ &code->loc);
+ }
+ if (code->ext.omp_clauses->worker)
+ {
+ if (c->code->ext.omp_clauses->worker)
+ gfc_error ("Loop parallelized across workers is not allowed "
+ "inside another loop parallelized across workers at %L",
+ &code->loc);
+ if (c->code->ext.omp_clauses->vector)
+ gfc_error ("Loop parallelized across workers is not allowed "
+ "inside another loop parallelized across vectors at %L",
+ &code->loc);
+ }
+ if (code->ext.omp_clauses->vector)
+ if (c->code->ext.omp_clauses->vector)
+ gfc_error ("Loop parallelized across vectors is not allowed "
+ "inside another loop parallelized across vectors at %L",
+ &code->loc);
+ }
+
+ if (oacc_is_parallel (c->code) || oacc_is_kernels (c->code))
+ break;
+ }
+
+ if (code->ext.omp_clauses->seq)
+ {
+ if (code->ext.omp_clauses->independent)
+ gfc_error ("Clause SEQ conflicts with INDEPENDENT at %L", &code->loc);
+ if (code->ext.omp_clauses->gang)
+ gfc_error ("Clause SEQ conflicts with GANG at %L", &code->loc);
+ if (code->ext.omp_clauses->worker)
+ gfc_error ("Clause SEQ conflicts with WORKER at %L", &code->loc);
+ if (code->ext.omp_clauses->vector)
+ gfc_error ("Clause SEQ conflicts with VECTOR at %L", &code->loc);
+ if (code->ext.omp_clauses->par_auto)
+ gfc_error ("Clause SEQ conflicts with AUTO at %L", &code->loc);
+ }
+ if (code->ext.omp_clauses->par_auto)
+ {
+ if (code->ext.omp_clauses->gang)
+ gfc_error ("Clause AUTO conflicts with GANG at %L", &code->loc);
+ if (code->ext.omp_clauses->worker)
+ gfc_error ("Clause AUTO conflicts with WORKER at %L", &code->loc);
+ if (code->ext.omp_clauses->vector)
+ gfc_error ("Clause AUTO conflicts with VECTOR at %L", &code->loc);
+ }
+ if (!code->ext.omp_clauses->tile_list)
+ {
+ if (code->ext.omp_clauses->gang)
+ {
+ if (code->ext.omp_clauses->worker)
+ gfc_error ("Clause GANG conflicts with WORKER at %L", &code->loc);
+ if (code->ext.omp_clauses->vector)
+ gfc_error ("Clause GANG conflicts with VECTOR at %L", &code->loc);
+ }
+ if (code->ext.omp_clauses->worker)
+ if (code->ext.omp_clauses->vector)
+ gfc_error ("Clause WORKER conflicts with VECTOR at %L", &code->loc);
+ }
+ else if (code->ext.omp_clauses->gang
+ && code->ext.omp_clauses->worker
+ && code->ext.omp_clauses->vector)
+ gfc_error ("Tiled loop cannot be parallelized across gangs, workers and "
+ "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");
+
+ if (code->ext.omp_clauses->worker
+ && code->ext.omp_clauses->worker_expr)
+ resolve_oacc_params_in_parallel (code, "WORKER");
+
+ if (code->ext.omp_clauses->tile_list)
+ {
+ gfc_expr_list *el;
+ int num = 0;
+ for (el = code->ext.omp_clauses->tile_list; el; el = el->next)
+ {
+ num++;
+ if (el->expr == NULL)
+ continue;
+ resolve_oacc_positive_int_expr (el->expr, "TILE");
+ if (el->expr->expr_type != EXPR_CONSTANT)
+ gfc_error ("TILE requires constant expression at %L", &code->loc);
+ }
+ resolve_oacc_nested_loops (code, code->block->next, num, "tiled");
+ }
+}
+
+
+void
+gfc_resolve_oacc_blocks (gfc_code *code, gfc_namespace *ns)
+{
+ oacc_context ctx;
+
+ resolve_oacc_loop_blocks (code);
+
+ ctx.code = code;
+ ctx.previous = oacc_current_ctx;
+ oacc_current_ctx = &ctx;
+
+ gfc_resolve_blocks (code->block, ns);
+
+ oacc_current_ctx = ctx.previous;
+}
+
+
+static void
+resolve_oacc_loop(gfc_code *code)
+{
+ gfc_code *do_code;
+ int collapse;
+
+ if (code->ext.omp_clauses)
+ resolve_omp_clauses (code);
+
+ do_code = code->block->next;
+ collapse = code->ext.omp_clauses->collapse;
+
+ if (collapse <= 0)
+ collapse = 1;
+ resolve_oacc_nested_loops (code, do_code, collapse, "collapsed");
+}
+
+
+static void
+resolve_oacc_cache (gfc_code *code)
+{
+ gfc_error ("Sorry, !$ACC cache unimplemented yet at %L", &code->loc);
+}
+
+
+static void
+resolve_oacc_wait (gfc_code *code)
+{
+ gfc_expr_list* el;
+
+ for (el = code->ext.omp_clauses->wait_list; el; el = el->next)
+ resolve_oacc_positive_int_expr (el->expr, "WAIT");
+}
+
+
+void
+gfc_resolve_oacc_declare (gfc_namespace *ns)
+{
+ int list;
+ gfc_namelist *n;
+ locus loc;
+ static const char *clause_names[] = {"COPY", "COPYIN", "COPYOUT", "CREATE",
+ "DELETE", "PRESENT", "PRESENT_OR_COPY", "PRESENT_OR_COPYIN",
+ "PRESENT_OR_COPYOUT", "PRESENT_OR_CREATE", "DEVICEPTR",
+ "DEVICE_RESIDENT"};
+
+ if (ns->oacc_declare_clauses == NULL)
+ return;
+
+ loc = ns->oacc_declare_clauses->ext.loc;
+
+ for (list = OMP_LIST_DATA_CLAUSE_FIRST;
+ list <= OMP_LIST_DEVICE_RESIDENT; list++)
+ for (n = ns->oacc_declare_clauses->lists[list]; n; n = n->next)
+ {
+ n->sym->mark = 0;
+ if (n->sym->attr.flavor == FL_PARAMETER)
+ gfc_error ("PARAMETER object '%s' is not allowed at %L", n->sym->name, &loc);
+ }
+
+ for (list = OMP_LIST_DATA_CLAUSE_FIRST;
+ list <= OMP_LIST_DEVICE_RESIDENT; list++)
+ for (n = ns->oacc_declare_clauses->lists[list]; n; n = n->next)
+ {
+ if (n->sym->mark)
+ gfc_error ("Symbol '%s' present on multiple clauses at %L",
+ n->sym->name, &loc);
+ else
+ n->sym->mark = 1;
+ }
+
+ for (list = OMP_LIST_DATA_CLAUSE_FIRST;
+ list < OMP_LIST_DATA_CLAUSE_LAST; /* Skip deviceptr clause. */
+ list++)
+ {
+ const char *name = clause_names[list - OMP_LIST_DATA_CLAUSE_FIRST];
+ for (n = ns->oacc_declare_clauses->lists[list]; n; n = n->next)
+ resolve_oacc_data_clauses (n->sym, loc, name);
+ }
+
+ for (n = ns->oacc_declare_clauses->lists[OMP_LIST_DEVICEPTR]; n; n = n->next)
+ resolve_oacc_deviceptr_clause (n->sym, loc,
+ clause_names[OMP_LIST_DEVICEPTR -
+ OMP_LIST_DATA_CLAUSE_FIRST]);
+
+ for (n = ns->oacc_declare_clauses->lists[OMP_LIST_DEVICE_RESIDENT]; n;
+ n = n->next)
+ check_array_not_assumed (n->sym, loc,
+ clause_names[OMP_LIST_DEVICE_RESIDENT -
+ OMP_LIST_DATA_CLAUSE_FIRST]);
+}
+
+
+void
+gfc_resolve_oacc_directive (gfc_code *code, gfc_namespace *ns ATTRIBUTE_UNUSED)
+{
+ resolve_oacc_directive_inside_omp_region (code);
+
+ switch (code->op)
+ {
+ case EXEC_OACC_PARALLEL:
+ case EXEC_OACC_KERNELS:
+ case EXEC_OACC_DATA:
+ case EXEC_OACC_HOST_DATA:
+ case EXEC_OACC_UPDATE:
+ case EXEC_OACC_ENTER_DATA:
+ case EXEC_OACC_EXIT_DATA:
+ resolve_omp_clauses (code);
+ break;
+ case EXEC_OACC_PARALLEL_LOOP:
+ case EXEC_OACC_KERNELS_LOOP:
+ case EXEC_OACC_LOOP:
+ resolve_oacc_loop (code);
+ break;
+ case EXEC_OACC_CACHE:
+ resolve_oacc_cache (code);
+ break;
+ case EXEC_OACC_WAIT:
+ resolve_oacc_wait (code);
+ break;
+ default:
+ break;
+ }
+}
+
/* Resolve OpenMP directive clauses and check various requirements
of each directive. */
@@ -1734,6 +2913,8 @@ resolve_omp_do (gfc_code *code)
void
gfc_resolve_omp_directive (gfc_code *code, gfc_namespace *ns ATTRIBUTE_UNUSED)
{
+ resolve_omp_directive_inside_oacc_region (code);
+
if (code->op != EXEC_OMP_ATOMIC)
gfc_maybe_initialize_eh ();
--
1.8.3.2
^ permalink raw reply [flat|nested] 89+ messages in thread
* Re: [PATCH 1/4] [GOMP4] [Fortran] OpenACC 1.0+ support in fortran front-end
2014-03-07 10:45 ` Ilmir Usmanov
2014-03-07 10:46 ` [PATCH 2/4] " Ilmir Usmanov
@ 2014-03-12 18:27 ` Tobias Burnus
2014-03-13 9:41 ` Ilmir Usmanov
1 sibling, 1 reply; 89+ messages in thread
From: Tobias Burnus @ 2014-03-12 18:27 UTC (permalink / raw)
To: Ilmir Usmanov
Cc: Thomas Schwinge, Evgeny Gavrin, GarbuzovViacheslav,
Dmitri Botcharnikov, gcc-patches, jakub, fortran
On March 7, 2014 11:45, Ilmir Usmanov wrote:
> OpenACC 1.0 support to fortran FE -- core.
Looks good to me. As Thomas is also fine with the patch set [1], the
patch can now go into the branch :-)
Previously and still approved are Part 3 and 4 [2] of the series. I will
separately reply to Part 2.
Tobias
[1] http://gcc.gnu.org/ml/gcc-patches/2014-03/msg00472.html
[2] http://gcc.gnu.org/ml/gcc-patches/2014-03/msg00399.html ,
http://gcc.gnu.org/ml/gcc-patches/2014-03/msg00400.html
> gcc/fortran/
> * dump-parse-tree.c
> (show_omp_node): Dump also OpenACC executable statements.
> (show_code_node): Call it.
> (show_namespace): Dump !$ACC DECLARE directive.
> * gfortran.h
> (ST_OACC_PARALLEL_LOOP, ST_OACC_END_PARALLEL_LOOP, ST_OACC_PARALLEL,
> ST_OACC_END_PARALLEL, ST_OACC_KERNELS, ST_OACC_END_KERNELS,
> ST_OACC_DATA, ST_OACC_END_DATA, ST_OACC_HOST_DATA,
> ST_OACC_END_HOST_DATA, ST_OACC_LOOP, ST_OACC_DECLARE, ST_OACC_UPDATE,
> ST_OACC_WAIT, ST_OACC_CACHE, ST_OACC_KERNELS_LOOP,
> ST_OACC_END_KERNELS_LOOP, ST_OACC_ENTER_DATA,
> ST_OACC_EXIT_DATA, ST_OACC_END_LOOP): New statements.
> (gfc_expr_list): New structure to hold list of expressions.
> (OMP_LIST_COPY, OMP_LIST_DATA_CLAUSE_FIRST,
> OMP_LIST_OACC_COPYIN, OMP_LIST_COPYOUT, OMP_LIST_CREATE,
> OMP_LIST_DELETE,
> OMP_LIST_PRESENT, OMP_LIST_PRESENT_OR_COPY,
> OMP_LIST_PRESENT_OR_COPYIN, OMP_LIST_PRESENT_OR_COPYOUT,
> OMP_LIST_PRESENT_OR_CREATE, OMP_LIST_DEVICEPTR,
> OMP_LIST_DATA_CLAUSE_LAST, OMP_LIST_USE_DEVICE,
> OMP_LIST_DEVICE_RESIDENT, OMP_LIST_HOST, OMP_LIST_DEVICE,
> OMP_LIST_CACHE): New types of list, allowed in clauses.
> (gfc_omp_clauses): Add OpenACC clauses.
> (gfc_namespace): Add OpenACC declare directive clauses.
> (EXEC_OACC_KERNELS_LOOP, EXEC_OACC_PARALLEL_LOOP, 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): New executable statements.
> (gfc_free_expr_list): New function declaration.
> (gfc_resolve_oacc_directive): Likewise.
> (gfc_resolve_oacc_parallel_loop_blocks): Likewise.
> (gfc_resolve_oacc_blocks): Likewise.
> * match.c (match_exit_cycle): Add support of OpenACC regions and
> loops.
> * match.h (gfc_match_oacc_cache): New function declaration.
> (gfc_match_oacc_wait, gfc_match_oacc_update): Likewise.
> (gfc_match_oacc_declare, gfc_match_oacc_loop): Likewise.
> (gfc_match_oacc_host_data, gfc_match_oacc_data): Likewise.
> (gfc_match_oacc_kernels, gfc_match_oacc_kernels_loop): Likewise.
> (gfc_match_oacc_parallel, gfc_match_oacc_parallel_loop): Likewise.
> (gfc_match_oacc_enter_data, gfc_match_oacc_exit_data): Likewise.
> * parse.c (decode_oacc_directive): New function.
> (verify_token_free, verify_token_fixed): New helper functions.
> (next_free, next_fixed): Decode !$ACC sentinel.
> (case_executable): Add ST_OACC_UPDATE, ST_OACC_WAIT, ST_OACC_CACHE,
> ST_OACC_ENTER_DATA and ST_OACC_EXIT_DATA directives.
> (case_exec_markers): Add ST_OACC_PARALLEL_LOOP, ST_OACC_PARALLEL,
> ST_OACC_KERNELS, ST_OACC_DATA, ST_OACC_HOST_DATA, ST_OACC_LOOP and
> ST_OACC_KERNELS_LOOP directives.
> (push_state): Initialize OpenACC declare clauses.
> (gfc_ascii_statement): Dump names of OpenACC directives.
> (verify_st_order): Verify OpenACC declare directive as declarative.
> (parse_spec): Push clauses to state stack when declare directive is
> parsed.
> (parse_oacc_structured_block, parse_oacc_loop): New functions.
> (parse_executable): Call them.
> (parse_progunit): Move declare clauses from state stack to namespace.
> * parse.h (gfc_state_data): Add declare directive's clauses.
> * resolve.c (gfc_resolve_blocks): Resolve OpenACC directives.
> (resolve_code): Likewise.
> * scanner.c (openacc_flag, openacc_locus): New static variables.
> (skip_oacc_attribute, skip_omp_attribute): New helper functions.
> (skip_free_comments, skip_fixed_comments): Don't skip !$ACC sentinel.
> (gfc_next_char_literal): Support OpenACC directives.
> * st.c (gfc_free_statement): Free also OpenACC directives.
^ permalink raw reply [flat|nested] 89+ messages in thread
* Re: [PATCH 2/4] [GOMP4] [Fortran] OpenACC 1.0+ support in fortran front-end
2014-03-11 12:04 ` Ilmir Usmanov
@ 2014-03-12 18:46 ` Tobias Burnus
0 siblings, 0 replies; 89+ messages in thread
From: Tobias Burnus @ 2014-03-12 18:46 UTC (permalink / raw)
To: Ilmir Usmanov
Cc: Thomas Schwinge, Evgeny Gavrin, GarbuzovViacheslav,
Dmitri Botcharnikov, gcc-patches, jakub, fortran
Hi Ilmir,
Ilmir Usmanov wrote:
> Is it OK now?
Yes. Thanks for the patches - and the patience!
Tobias
^ permalink raw reply [flat|nested] 89+ messages in thread
* Re: [PATCH 1/4] [GOMP4] [Fortran] OpenACC 1.0+ support in fortran front-end
2014-03-12 18:27 ` [PATCH 1/4] " Tobias Burnus
@ 2014-03-13 9:41 ` Ilmir Usmanov
2014-03-13 11:43 ` Thomas Schwinge
0 siblings, 1 reply; 89+ messages in thread
From: Ilmir Usmanov @ 2014-03-13 9:41 UTC (permalink / raw)
To: Thomas Schwinge
Cc: Tobias Burnus, Evgeny Gavrin, GarbuzovViacheslav,
Dmitri Botcharnikov, gcc-patches, jakub, fortran
Committed as r208533.
--
Ilmir.
^ permalink raw reply [flat|nested] 89+ messages in thread
* Re: [PATCH 1/4] [GOMP4] [Fortran] OpenACC 1.0+ support in fortran front-end
2014-03-13 9:41 ` Ilmir Usmanov
@ 2014-03-13 11:43 ` Thomas Schwinge
2014-03-13 13:24 ` Ilmir Usmanov
0 siblings, 1 reply; 89+ messages in thread
From: Thomas Schwinge @ 2014-03-13 11:43 UTC (permalink / raw)
To: Ilmir Usmanov
Cc: Tobias Burnus, Evgeny Gavrin, GarbuzovViacheslav,
Dmitri Botcharnikov, gcc-patches, jakub, fortran
[-- Attachment #1: Type: text/plain, Size: 3360 bytes --]
Hi Ilmir!
On Thu, 13 Mar 2014 13:34:54 +0400, Ilmir Usmanov <i.usmanov@samsung.com> wrote:
> Committed as r208533.
Yay! \o/
Three minor things:
Please move the entries from gcc/ChangeLog.gomp to the more specific
gcc/[...]/ChangeLog.gomp files. Generally, we need to locate and then
put ChangeLog snippets into the most specific ChangeLog file (so, for
example, gcc/testsuite/ChangeLog for
gcc/testsuite/gfortran.dg/goacc/assumed.f95), and as this is on the
gomp-4_0-branch, then use (or create, if not yet present) the
ChangeLog.gomp file instead of plain ChangeLog.
The following change seems the right thing to do -- but why doesn't the
current code trigger a GCC ICE due to a failing subcode check? (At least
I thought you had test cases exercising the respective OpenACC vector
clauses?) Can you please check that? If it's just missing a test case,
feel free to commit that together with my patch.
commit ee65334ec81b092111e9b2b34a0ee3ceb933b643
Author: Thomas Schwinge <thomas@codesourcery.com>
Date: Thu Mar 13 12:26:47 2014 +0100
Fix OMP_CLAUSE_VECTOR_EXPR subcode check.
gcc/
* tree.h (OMP_CLAUSE_VECTOR_EXPR): Check for OMP_CLAUSE_VECTOR
instead of OMP_CLAUSE_VECTOR_LENGTH.
diff --git gcc/tree.h gcc/tree.h
index bd70680..5ef2a0a 100644
--- gcc/tree.h
+++ gcc/tree.h
@@ -1323,7 +1323,7 @@ extern void protected_set_expr_location (tree, location_t);
OMP_CLAUSE_SUBCODE_CHECK (NODE, OMP_CLAUSE_WAIT), 0)
#define OMP_CLAUSE_VECTOR_EXPR(NODE) \
OMP_CLAUSE_OPERAND ( \
- OMP_CLAUSE_SUBCODE_CHECK (NODE, OMP_CLAUSE_VECTOR_LENGTH), 0)
+ OMP_CLAUSE_SUBCODE_CHECK (NODE, OMP_CLAUSE_VECTOR), 0)
#define OMP_CLAUSE_WORKER_EXPR(NODE) \
OMP_CLAUSE_OPERAND ( \
OMP_CLAUSE_SUBCODE_CHECK (NODE, OMP_CLAUSE_WORKER), 0)
The following cleanup should be fine to check in, or is there a reason
for using OMP_WAIT_EXPR instead of OMP_CLAUSE_WAIT_EXPR?
commit 7d69bdf8471e512791d4b7e0121efde7725a0cb9
Author: Thomas Schwinge <thomas@codesourcery.com>
Date: Thu Mar 13 12:25:14 2014 +0100
Rename OMP_WAIT_EXPR to OMP_CLAUSE_WAIT_EXPR.
gcc/
* tree.h (OMP_WAIT_EXPR): Rename to OMP_CLAUSE_WAIT_EXPR. Change
all users.
diff --git gcc/fortran/trans-openmp.c gcc/fortran/trans-openmp.c
index a1abd66..29364f4 100644
--- gcc/fortran/trans-openmp.c
+++ gcc/fortran/trans-openmp.c
@@ -1191,7 +1191,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
tree wait_var =
gfc_convert_expr_to_tree (block, clauses->non_clause_wait_expr);
c = build_omp_clause (where.lb->location, OMP_CLAUSE_WAIT);
- OMP_WAIT_EXPR (c)= wait_var;
+ OMP_CLAUSE_WAIT_EXPR (c)= wait_var;
omp_clauses = gfc_trans_add_clause (c, omp_clauses);
}
diff --git gcc/tree.h gcc/tree.h
index fbac81b..bd70680 100644
--- gcc/tree.h
+++ gcc/tree.h
@@ -1318,7 +1318,7 @@ extern void protected_set_expr_location (tree, location_t);
#define OMP_CLAUSE_ASYNC_EXPR(NODE) \
OMP_CLAUSE_OPERAND ( \
OMP_CLAUSE_SUBCODE_CHECK (NODE, OMP_CLAUSE_ASYNC), 0)
-#define OMP_WAIT_EXPR(NODE) \
+#define OMP_CLAUSE_WAIT_EXPR(NODE) \
OMP_CLAUSE_OPERAND ( \
OMP_CLAUSE_SUBCODE_CHECK (NODE, OMP_CLAUSE_WAIT), 0)
#define OMP_CLAUSE_VECTOR_EXPR(NODE) \
Grüße,
Thomas
[-- Attachment #2: Type: application/pgp-signature, Size: 489 bytes --]
^ permalink raw reply [flat|nested] 89+ messages in thread
* Re: [PATCH 1/4] [GOMP4] [Fortran] OpenACC 1.0+ support in fortran front-end
2014-03-13 11:43 ` Thomas Schwinge
@ 2014-03-13 13:24 ` Ilmir Usmanov
2014-03-13 14:13 ` Ilmir Usmanov
0 siblings, 1 reply; 89+ messages in thread
From: Ilmir Usmanov @ 2014-03-13 13:24 UTC (permalink / raw)
To: Thomas Schwinge
Cc: Tobias Burnus, Evgeny Gavrin, GarbuzovViacheslav, gcc-patches,
jakub, fortran
Hi Thomas!
On 13.03.2014 15:38, Thomas Schwinge wrote:
> Hi Ilmir!
>
> On Thu, 13 Mar 2014 13:34:54 +0400, Ilmir Usmanov <i.usmanov@samsung.com> wrote:
>> Committed as r208533.
> Yay! \o/
Thanks! Yay indeed.
And thanks a lot for your comments.
>
> The following change seems the right thing to do -- but why doesn't the
> current code trigger a GCC ICE due to a failing subcode check? (At least
> I thought you had test cases exercising the respective OpenACC vector
> clauses?) Can you please check that? If it's just missing a test case,
> feel free to commit that together with my patch.
>
Unfortunally, I can't check this using a test right now, since OpenACC
loop directive is not implemented yet.
>
> The following cleanup should be fine to check in, or is there a reason
> for using OMP_WAIT_EXPR instead of OMP_CLAUSE_WAIT_EXPR?
No, there is no reason for using OMP_WAIT_EXPR. Thanks!
--
Ilmir.
^ permalink raw reply [flat|nested] 89+ messages in thread
* Re: [PATCH 1/4] [GOMP4] [Fortran] OpenACC 1.0+ support in fortran front-end
2014-03-13 13:24 ` Ilmir Usmanov
@ 2014-03-13 14:13 ` Ilmir Usmanov
2014-03-16 19:46 ` Tobias Burnus
0 siblings, 1 reply; 89+ messages in thread
From: Ilmir Usmanov @ 2014-03-13 14:13 UTC (permalink / raw)
To: Thomas Schwinge
Cc: Tobias Burnus, Evgeny Gavrin, GarbuzovViacheslav, gcc-patches,
jakub, fortran
On 13.03.2014 16:19, Ilmir Usmanov wrote:
>
>>
>> The following change seems the right thing to do -- but why doesn't the
>> current code trigger a GCC ICE due to a failing subcode check? (At least
>> I thought you had test cases exercising the respective OpenACC vector
>> clauses?) Can you please check that? If it's just missing a test case,
>> feel free to commit that together with my patch.
>>
> Unfortunally, I can't check this using a test right now, since OpenACC
> loop directive is not implemented yet.
>
>>
>> The following cleanup should be fine to check in, or is there a reason
>> for using OMP_WAIT_EXPR instead of OMP_CLAUSE_WAIT_EXPR?
> No, there is no reason for using OMP_WAIT_EXPR. Thanks!
>
Committed as r208541.
--
Ilmir.
^ permalink raw reply [flat|nested] 89+ messages in thread
* Re: [PATCH 1/4] [GOMP4] [Fortran] OpenACC 1.0+ support in fortran front-end
2014-03-13 14:13 ` Ilmir Usmanov
@ 2014-03-16 19:46 ` Tobias Burnus
2014-03-16 20:44 ` Thomas Schwinge
2014-04-05 10:40 ` Thomas Schwinge
0 siblings, 2 replies; 89+ messages in thread
From: Tobias Burnus @ 2014-03-16 19:46 UTC (permalink / raw)
To: Ilmir Usmanov, Thomas Schwinge
Cc: Evgeny Gavrin, GarbuzovViacheslav, gcc-patches, fortran
Ilmir Usmanov wrote:
> Committed as r208541.
Thanks. Can you or Thomas apply the following patch after my patch* has
been committed to the trunk and the branch has been updated? Please
mention PR fortran/60283 in the ChangeLog.
* http://gcc.gnu.org/ml/gcc-patches/2014-03/msg00782.html
Tobias
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -550,8 +550,7 @@ decode_oacc_directive (void)
return ST_NONE;
}
- if (gfc_implicit_pure (NULL))
- gfc_current_ns->proc_name->attr.implicit_pure = 0;
+ gfc_unset_implicit_pure (NULL);
old_locus = gfc_current_locus;
^ permalink raw reply [flat|nested] 89+ messages in thread
* Re: [PATCH 1/4] [GOMP4] [Fortran] OpenACC 1.0+ support in fortran front-end
2014-03-16 19:46 ` Tobias Burnus
@ 2014-03-16 20:44 ` Thomas Schwinge
2014-04-05 10:40 ` Thomas Schwinge
1 sibling, 0 replies; 89+ messages in thread
From: Thomas Schwinge @ 2014-03-16 20:44 UTC (permalink / raw)
To: Tobias Burnus, Ilmir Usmanov
Cc: Evgeny Gavrin, GarbuzovViacheslav, gcc-patches, fortran
[-- Attachment #1: Type: text/plain, Size: 406 bytes --]
Hi!
On Sun, 16 Mar 2014 20:23:48 +0100, Tobias Burnus <burnus@net-b.de> wrote:
> Can you or Thomas apply the following patch after my patch* has
> been committed to the trunk and the branch has been updated? Please
> mention PR fortran/60283 in the ChangeLog.
>
> * http://gcc.gnu.org/ml/gcc-patches/2014-03/msg00782.html
Thanks; I've put it onto my merge tasks list.
Grüße,
Thomas
[-- Attachment #2: Type: application/pgp-signature, Size: 489 bytes --]
^ permalink raw reply [flat|nested] 89+ messages in thread
* Re: [PATCH 4/4] [GOMP4] [Fortran] OpenACC 1.0+ support in fortran front-end
2014-03-07 10:47 ` [PATCH 4/4] " Ilmir Usmanov
2014-03-08 17:55 ` Tobias Burnus
@ 2014-03-20 10:53 ` Thomas Schwinge
2014-03-20 12:48 ` Ilmir Usmanov
2014-03-20 14:43 ` Jakub Jelinek
1 sibling, 2 replies; 89+ messages in thread
From: Thomas Schwinge @ 2014-03-20 10:53 UTC (permalink / raw)
To: Ilmir Usmanov, Tobias Burnus
Cc: Evgeny Gavrin, GarbuzovViacheslav, Dmitri Botcharnikov,
gcc-patches, jakub, fortran
[-- Attachment #1: Type: text/plain, Size: 14561 bytes --]
Hi Ilmir!
On Fri, 7 Mar 2014 14:47:14 +0400, Ilmir Usmanov <i.usmanov@samsung.com> wrote:
> OpenACC 1.0 fortran FE support -- tests.
> --- /dev/null
> +++ b/gcc/testsuite/gfortran.dg/goacc/coarray.f95
> @@ -0,0 +1,35 @@
> +! { dg-do compile }
> +! { dg-excess-errors "Unimplemented" }
> +! { dg-excess-errors "ACC LOOP" }
> \ No newline at end of file
As in
<http://news.gmane.org/find-root.php?message_id=%3C87mwglf9vq.fsf%40schwinge.name%3E>,
this is wrong usage of the dg-excess-errors directive, for this one will
absorb *all* remaining errors, whereas you just wanted to mask out any
»sorry, unimplemented: [...]« ones.
OK to fix as follows?
commit 6d27a0605bd914a1b51e467e340221c5b018e129
Author: Thomas Schwinge <thomas@codesourcery.com>
Date: Thu Mar 20 11:04:30 2014 +0100
Replace dg-excess-errors usage with dg-prune-output.
gcc/testsuite/
* gfortran.dg/goacc/cache-1.f95: Replace dg-excess-errors usage
with dg-prune-output.
* gfortran.dg/goacc/coarray.f95: Likewise.
* gfortran.dg/goacc/cray.f95: Likewise.
* gfortran.dg/goacc/data-tree.f95: Likewise.
* gfortran.dg/goacc/declare-1.f95: Likewise.
* gfortran.dg/goacc/host_data-tree.f95: Likewise.
* gfortran.dg/goacc/kernels-tree.f95: Likewise.
* gfortran.dg/goacc/loop-1.f95: Likewise.
* gfortran.dg/goacc/parallel-kernels-regions.f95: Likewise.
* gfortran.dg/goacc/parallel-tree.f95: Likewise.
* gfortran.dg/goacc/parameter.f95: Likewise.
diff --git gcc/testsuite/gfortran.dg/goacc/cache-1.f95 gcc/testsuite/gfortran.dg/goacc/cache-1.f95
index 6d7f60a..746cf02 100644
--- gcc/testsuite/gfortran.dg/goacc/cache-1.f95
+++ gcc/testsuite/gfortran.dg/goacc/cache-1.f95
@@ -9,4 +9,4 @@ program test
!$acc cache (d)
enddo
end
-! { dg-excess-errors "unimplemented" }
\ No newline at end of file
+! { dg-prune-output "unimplemented" }
diff --git gcc/testsuite/gfortran.dg/goacc/coarray.f95 gcc/testsuite/gfortran.dg/goacc/coarray.f95
index 7afb4bc..ab13157 100644
--- gcc/testsuite/gfortran.dg/goacc/coarray.f95
+++ gcc/testsuite/gfortran.dg/goacc/coarray.f95
@@ -31,5 +31,4 @@ contains
!$acc update device (a)
end subroutine oacc1
end module test
-! { dg-excess-errors "Unimplemented" }
-! { dg-excess-errors "ACC LOOP" }
\ No newline at end of file
+! { dg-prune-output "ACC cache unimplemented" }
diff --git gcc/testsuite/gfortran.dg/goacc/cray.f95 gcc/testsuite/gfortran.dg/goacc/cray.f95
index 509f61b..3225b28 100644
--- gcc/testsuite/gfortran.dg/goacc/cray.f95
+++ gcc/testsuite/gfortran.dg/goacc/cray.f95
@@ -51,4 +51,4 @@ contains
!$acc update device (ptr)
end subroutine oacc1
end module test
-! { dg-excess-errors "unimplemented" }
\ No newline at end of file
+! { dg-prune-output "unimplemented" }
diff --git gcc/testsuite/gfortran.dg/goacc/data-tree.f95 gcc/testsuite/gfortran.dg/goacc/data-tree.f95
index d29c060..a5c012a 100644
--- gcc/testsuite/gfortran.dg/goacc/data-tree.f95
+++ gcc/testsuite/gfortran.dg/goacc/data-tree.f95
@@ -12,7 +12,7 @@ program test
!$acc end data
end program test
-! { dg-excess-errors "unimplemented" }
+! { dg-prune-output "unimplemented" }
! { dg-final { scan-tree-dump-times "pragma acc data" 1 "original" } }
! { dg-final { scan-tree-dump-times "if" 1 "original" } }
@@ -28,4 +28,4 @@ end program test
! { dg-final { scan-tree-dump-times "map\\(alloc:t\\)" 1 "original" } }
! { dg-final { scan-tree-dump-times "map\\(force_deviceptr:u\\)" 1 "original" } }
-! { dg-final { cleanup-tree-dump "original" } }
\ No newline at end of file
+! { dg-final { cleanup-tree-dump "original" } }
diff --git gcc/testsuite/gfortran.dg/goacc/declare-1.f95 gcc/testsuite/gfortran.dg/goacc/declare-1.f95
index aec3ae8..03540f1 100644
--- gcc/testsuite/gfortran.dg/goacc/declare-1.f95
+++ gcc/testsuite/gfortran.dg/goacc/declare-1.f95
@@ -15,6 +15,6 @@ contains
END BLOCK
end function foo
end program test
-! { dg-excess-errors "unimplemented" }
+! { dg-prune-output "unimplemented" }
! { dg-final { scan-tree-dump-times "pragma acc declare map\\(force_tofrom:i\\)" 2 "original" } }
! { dg-final { cleanup-tree-dump "original" } }
diff --git gcc/testsuite/gfortran.dg/goacc/host_data-tree.f95 gcc/testsuite/gfortran.dg/goacc/host_data-tree.f95
index 1c24fe7..19e7411 100644
--- gcc/testsuite/gfortran.dg/goacc/host_data-tree.f95
+++ gcc/testsuite/gfortran.dg/goacc/host_data-tree.f95
@@ -8,6 +8,6 @@ program test
!$acc host_data use_device(i)
!$acc end host_data
end program test
-! { dg-excess-errors "unimplemented" }
+! { dg-prune-output "unimplemented" }
! { dg-final { scan-tree-dump-times "pragma acc host_data use_device\\(i\\)" 1 "original" } }
! { dg-final { cleanup-tree-dump "original" } }
diff --git gcc/testsuite/gfortran.dg/goacc/kernels-tree.f95 gcc/testsuite/gfortran.dg/goacc/kernels-tree.f95
index 5c65d2a..73f172c 100644
--- gcc/testsuite/gfortran.dg/goacc/kernels-tree.f95
+++ gcc/testsuite/gfortran.dg/goacc/kernels-tree.f95
@@ -12,7 +12,7 @@ program test
!$acc end kernels
end program test
-! { dg-excess-errors "unimplemented" }
+! { dg-prune-output "unimplemented" }
! { dg-final { scan-tree-dump-times "pragma acc kernels" 1 "original" } }
! { dg-final { scan-tree-dump-times "if" 1 "original" } }
diff --git gcc/testsuite/gfortran.dg/goacc/loop-1.f95 gcc/testsuite/gfortran.dg/goacc/loop-1.f95
index af4f537..e1b2dfd 100644
--- gcc/testsuite/gfortran.dg/goacc/loop-1.f95
+++ gcc/testsuite/gfortran.dg/goacc/loop-1.f95
@@ -167,4 +167,5 @@ subroutine test1
end subroutine test1
end module test
-! { dg-excess-errors "Deleted" }
+! { dg-prune-output "Deleted" }
+! { dg-prune-output "ACC cache unimplemented" }
diff --git gcc/testsuite/gfortran.dg/goacc/parallel-kernels-regions.f95 gcc/testsuite/gfortran.dg/goacc/parallel-kernels-regions.f95
index 5cd4d6c..f31aa54 100644
--- gcc/testsuite/gfortran.dg/goacc/parallel-kernels-regions.f95
+++ gcc/testsuite/gfortran.dg/goacc/parallel-kernels-regions.f95
@@ -53,4 +53,4 @@ program test
!$acc end kernels
end program test
-! { dg-excess-errors "unimplemented" }
\ No newline at end of file
+! { dg-prune-output "error: may not be nested" }
diff --git gcc/testsuite/gfortran.dg/goacc/parallel-tree.f95 gcc/testsuite/gfortran.dg/goacc/parallel-tree.f95
index a92de4e..f004702 100644
--- gcc/testsuite/gfortran.dg/goacc/parallel-tree.f95
+++ gcc/testsuite/gfortran.dg/goacc/parallel-tree.f95
@@ -15,7 +15,7 @@ program test
!$acc end parallel
end program test
-! { dg-excess-errors "unimplemented" }
+! { dg-prune-output "unimplemented" }
! { dg-final { scan-tree-dump-times "pragma acc parallel" 1 "original" } }
! { dg-final { scan-tree-dump-times "if" 1 "original" } }
diff --git gcc/testsuite/gfortran.dg/goacc/parameter.f95 gcc/testsuite/gfortran.dg/goacc/parameter.f95
index 917f772..785d7f9 100644
--- gcc/testsuite/gfortran.dg/goacc/parameter.f95
+++ gcc/testsuite/gfortran.dg/goacc/parameter.f95
@@ -28,4 +28,4 @@ contains
!$acc update device (a) ! { dg-error "not a variable" }
end subroutine oacc1
end module test
-! { dg-excess-errors "unimplemented" }
\ No newline at end of file
+! { dg-prune-output "unimplemented" }
This changes the test results as follows:
@@ -30,8 +30,8 @@ PASS: gfortran.dg/goacc/branch.f95 -O (test for errors, line 16)
PASS: gfortran.dg/goacc/branch.f95 -O (test for errors, line 22)
PASS: gfortran.dg/goacc/branch.f95 -O (test for errors, line 28)
PASS: gfortran.dg/goacc/branch.f95 -O (test for excess errors)
-XFAIL: gfortran.dg/goacc/cache-1.f95 -O (test for excess errors)
-XFAIL: gfortran.dg/goacc/coarray.f95 -O (test for excess errors)
+PASS: gfortran.dg/goacc/cache-1.f95 -O (test for excess errors)
+PASS: gfortran.dg/goacc/coarray.f95 -O (test for excess errors)
PASS: gfortran.dg/goacc/continuation-free-form.f95 -O (test for errors, line 19)
PASS: gfortran.dg/goacc/continuation-free-form.f95 -O (test for excess errors)
PASS: gfortran.dg/goacc/cray.f95 -O (test for errors, line 13)
@@ -44,7 +44,7 @@ PASS: gfortran.dg/goacc/cray.f95 -O (test for errors, line 32)
PASS: gfortran.dg/goacc/cray.f95 -O (test for errors, line 35)
PASS: gfortran.dg/goacc/cray.f95 -O (test for errors, line 39)
PASS: gfortran.dg/goacc/cray.f95 -O (test for errors, line 41)
-XFAIL: gfortran.dg/goacc/cray.f95 -O (test for excess errors)
+PASS: gfortran.dg/goacc/cray.f95 -O (test for excess errors)
PASS: gfortran.dg/goacc/critical.f95 -O (test for errors, line 11)
PASS: gfortran.dg/goacc/critical.f95 -O (test for errors, line 22)
PASS: gfortran.dg/goacc/critical.f95 -O (test for excess errors)
@@ -115,7 +115,7 @@ PASS: gfortran.dg/goacc/data-clauses.f95 -O (test for errors, line 244)
PASS: gfortran.dg/goacc/data-clauses.f95 -O (test for errors, line 246)
PASS: gfortran.dg/goacc/data-clauses.f95 -O (test for errors, line 248)
PASS: gfortran.dg/goacc/data-clauses.f95 -O (test for excess errors)
-XFAIL: gfortran.dg/goacc/data-tree.f95 -O (test for excess errors)
+PASS: gfortran.dg/goacc/data-tree.f95 -O (test for excess errors)
PASS: gfortran.dg/goacc/data-tree.f95 -O scan-tree-dump-times original "pragma acc data" 1
PASS: gfortran.dg/goacc/data-tree.f95 -O scan-tree-dump-times original "if" 1
PASS: gfortran.dg/goacc/data-tree.f95 -O scan-tree-dump-times original "map\\(force_tofrom:i\\)" 1
@@ -128,7 +128,7 @@ PASS: gfortran.dg/goacc/data-tree.f95 -O scan-tree-dump-times original "map\\
PASS: gfortran.dg/goacc/data-tree.f95 -O scan-tree-dump-times original "map\\(from:s\\)" 1
PASS: gfortran.dg/goacc/data-tree.f95 -O scan-tree-dump-times original "map\\(alloc:t\\)" 1
PASS: gfortran.dg/goacc/data-tree.f95 -O scan-tree-dump-times original "map\\(force_deviceptr:u\\)" 1
-XFAIL: gfortran.dg/goacc/declare-1.f95 -O (test for excess errors)
+PASS: gfortran.dg/goacc/declare-1.f95 -O (test for excess errors)
PASS: gfortran.dg/goacc/declare-1.f95 -O scan-tree-dump-times original "pragma acc declare map\\(force_tofrom:i\\)" 2
PASS: gfortran.dg/goacc/enter-exit-data.f95 -O (test for errors, line 31)
PASS: gfortran.dg/goacc/enter-exit-data.f95 -O (test for errors, line 32)
@@ -176,7 +176,7 @@ PASS: gfortran.dg/goacc/enter-exit-data.f95 -O (test for errors, line 84)
PASS: gfortran.dg/goacc/enter-exit-data.f95 -O (test for errors, line 85)
PASS: gfortran.dg/goacc/enter-exit-data.f95 -O (test for errors, line 86)
PASS: gfortran.dg/goacc/enter-exit-data.f95 -O (test for excess errors)
-XFAIL: gfortran.dg/goacc/host_data-tree.f95 -O (test for excess errors)
+PASS: gfortran.dg/goacc/host_data-tree.f95 -O (test for excess errors)
PASS: gfortran.dg/goacc/host_data-tree.f95 -O scan-tree-dump-times original "pragma acc host_data use_device\\(i\\)" 1
PASS: gfortran.dg/goacc/if.f95 -O (test for errors, line 9)
PASS: gfortran.dg/goacc/if.f95 -O (test for errors, line 10)
@@ -194,7 +194,7 @@ PASS: gfortran.dg/goacc/if.f95 -O (test for errors, line 29)
PASS: gfortran.dg/goacc/if.f95 -O (test for errors, line 30)
PASS: gfortran.dg/goacc/if.f95 -O (test for errors, line 31)
PASS: gfortran.dg/goacc/if.f95 -O (test for excess errors)
-XFAIL: gfortran.dg/goacc/kernels-tree.f95 -O (test for excess errors)
+PASS: gfortran.dg/goacc/kernels-tree.f95 -O (test for excess errors)
PASS: gfortran.dg/goacc/kernels-tree.f95 -O scan-tree-dump-times original "pragma acc kernels" 1
PASS: gfortran.dg/goacc/kernels-tree.f95 -O scan-tree-dump-times original "if" 1
PASS: gfortran.dg/goacc/kernels-tree.f95 -O scan-tree-dump-times original "async" 1
@@ -264,7 +264,7 @@ PASS: gfortran.dg/goacc/loop-1.f95 -O (test for errors, line 142)
PASS: gfortran.dg/goacc/loop-1.f95 -O (test for errors, line 147)
PASS: gfortran.dg/goacc/loop-1.f95 -O (test for errors, line 152)
PASS: gfortran.dg/goacc/loop-1.f95 -O (test for errors, line 157)
-XFAIL: gfortran.dg/goacc/loop-1.f95 -O (test for excess errors)
+PASS: gfortran.dg/goacc/loop-1.f95 -O (test for excess errors)
PASS: gfortran.dg/goacc/loop-2.f95 -O (test for errors, line 37)
PASS: gfortran.dg/goacc/loop-2.f95 -O (test for errors, line 41)
PASS: gfortran.dg/goacc/loop-2.f95 -O (test for errors, line 59)
@@ -393,8 +393,8 @@ PASS: gfortran.dg/goacc/parallel-kernels-clauses.f95 -O (test for excess error
PASS: gfortran.dg/goacc/parallel-kernels-regions.f95 -O (test for errors, line 17)
PASS: gfortran.dg/goacc/parallel-kernels-regions.f95 -O (test for errors, line 22)
PASS: gfortran.dg/goacc/parallel-kernels-regions.f95 -O (test for errors, line 46)
-XFAIL: gfortran.dg/goacc/parallel-kernels-regions.f95 -O (test for excess errors)
-XFAIL: gfortran.dg/goacc/parallel-tree.f95 -O (test for excess errors)
+PASS: gfortran.dg/goacc/parallel-kernels-regions.f95 -O (test for excess errors)
+PASS: gfortran.dg/goacc/parallel-tree.f95 -O (test for excess errors)
PASS: gfortran.dg/goacc/parallel-tree.f95 -O scan-tree-dump-times original "pragma acc parallel" 1
PASS: gfortran.dg/goacc/parallel-tree.f95 -O scan-tree-dump-times original "if" 1
PASS: gfortran.dg/goacc/parallel-tree.f95 -O scan-tree-dump-times original "async" 1
@@ -422,7 +422,7 @@ PASS: gfortran.dg/goacc/parameter.f95 -O (test for errors, line 16)
PASS: gfortran.dg/goacc/parameter.f95 -O (test for errors, line 18)
PASS: gfortran.dg/goacc/parameter.f95 -O (test for errors, line 27)
PASS: gfortran.dg/goacc/parameter.f95 -O (test for errors, line 28)
-XFAIL: gfortran.dg/goacc/parameter.f95 -O (test for excess errors)
+PASS: gfortran.dg/goacc/parameter.f95 -O (test for excess errors)
PASS: gfortran.dg/goacc/pure-elemental-procedures.f95 -O (test for errors, line 8)
PASS: gfortran.dg/goacc/pure-elemental-procedures.f95 -O (test for errors, line 12)
PASS: gfortran.dg/goacc/pure-elemental-procedures.f95 -O (test for errors, line 18)
Grüße,
Thomas
[-- Attachment #2: Type: application/pgp-signature, Size: 489 bytes --]
^ permalink raw reply [flat|nested] 89+ messages in thread
* Re: [PATCH 4/4] [GOMP4] [Fortran] OpenACC 1.0+ support in fortran front-end
2014-03-20 10:53 ` Thomas Schwinge
@ 2014-03-20 12:48 ` Ilmir Usmanov
2014-03-20 14:43 ` Jakub Jelinek
1 sibling, 0 replies; 89+ messages in thread
From: Ilmir Usmanov @ 2014-03-20 12:48 UTC (permalink / raw)
To: Thomas Schwinge, Tobias Burnus
Cc: Evgeny Gavrin, GarbuzovViacheslav, Dmitri Botcharnikov,
gcc-patches, jakub, fortran
Hi Thomas!
On 20.03.2014 14:22, Thomas Schwinge wrote:
>
> As in
> <http://news.gmane.org/find-root.php?message_id=%3C87mwglf9vq.fsf%40schwinge.name%3E>,
> this is wrong usage of the dg-excess-errors directive, for this one will
> absorb *all* remaining errors, whereas you just wanted to mask out any
> »sorry, unimplemented: [...]« ones.
>
> OK to fix as follows?
>
Sure. Thanks!
--
Ilmir.
^ permalink raw reply [flat|nested] 89+ messages in thread
* Re: [PATCH 4/4] [GOMP4] [Fortran] OpenACC 1.0+ support in fortran front-end
2014-03-20 10:53 ` Thomas Schwinge
2014-03-20 12:48 ` Ilmir Usmanov
@ 2014-03-20 14:43 ` Jakub Jelinek
1 sibling, 0 replies; 89+ messages in thread
From: Jakub Jelinek @ 2014-03-20 14:43 UTC (permalink / raw)
To: Thomas Schwinge
Cc: Ilmir Usmanov, Tobias Burnus, Evgeny Gavrin, GarbuzovViacheslav,
Dmitri Botcharnikov, gcc-patches, fortran
On Thu, Mar 20, 2014 at 11:22:59AM +0100, Thomas Schwinge wrote:
> > --- /dev/null
> > +++ b/gcc/testsuite/gfortran.dg/goacc/coarray.f95
> > @@ -0,0 +1,35 @@
> > +! { dg-do compile }
>
> > +! { dg-excess-errors "Unimplemented" }
> > +! { dg-excess-errors "ACC LOOP" }
> > \ No newline at end of file
Note, in any case, please avoid files without trailing newline unless
strictly necessary (primarily, testing that compiler handles those).
Jakub
^ permalink raw reply [flat|nested] 89+ messages in thread
* Re: [PATCH 1/4] [GOMP4] [Fortran] OpenACC 1.0+ support in fortran front-end
2014-03-16 19:46 ` Tobias Burnus
2014-03-16 20:44 ` Thomas Schwinge
@ 2014-04-05 10:40 ` Thomas Schwinge
1 sibling, 0 replies; 89+ messages in thread
From: Thomas Schwinge @ 2014-04-05 10:40 UTC (permalink / raw)
To: Tobias Burnus
Cc: Evgeny Gavrin, GarbuzovViacheslav, gcc-patches, fortran, Ilmir Usmanov
[-- Attachment #1: Type: text/plain, Size: 1982 bytes --]
Hi!
On Sun, 16 Mar 2014 20:23:48 +0100, Tobias Burnus <burnus@net-b.de> wrote:
> Can you or Thomas apply the following patch after my patch* has
> been committed to the trunk and the branch has been updated? Please
> mention PR fortran/60283 in the ChangeLog.
>
> * http://gcc.gnu.org/ml/gcc-patches/2014-03/msg00782.html
> --- a/gcc/fortran/parse.c
> +++ b/gcc/fortran/parse.c
> @@ -550,8 +550,7 @@ decode_oacc_directive (void)
> return ST_NONE;
> }
>
> - if (gfc_implicit_pure (NULL))
> - gfc_current_ns->proc_name->attr.implicit_pure = 0;
> + gfc_unset_implicit_pure (NULL);
>
> old_locus = gfc_current_locus;
After the trunk merge, committed in r209150:
commit 83a3b119255d0913d088d652e6caa26026aacb32
Author: tschwinge <tschwinge@138bc75d-0d04-0410-961f-82ee72b054a4>
Date: Sat Apr 5 10:36:58 2014 +0000
Use gfc_unset_implicit_pure.
PR fortran/60283
gcc/fortran/
* parse.c (decode_oacc_directive): Use gfc_unset_implicit_pure.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/branches/gomp-4_0-branch@209150 138bc75d-0d04-0410-961f-82ee72b054a4
diff --git gcc/fortran/ChangeLog.gomp gcc/fortran/ChangeLog.gomp
index 1ee6a7c..aff672e 100644
--- gcc/fortran/ChangeLog.gomp
+++ gcc/fortran/ChangeLog.gomp
@@ -1,3 +1,8 @@
+2014-04-05 Tobias Burnus <burnus@net-b.de>
+
+ PR fortran/60283
+ * parse.c (decode_oacc_directive): Use gfc_unset_implicit_pure.
+
2014-03-18 Thomas Schwinge <thomas@codesourcery.com>
* f95-lang.c (DEF_FUNCTION_TYPE_10): Define.
diff --git gcc/fortran/parse.c gcc/fortran/parse.c
index a217c05..79bdc95 100644
--- gcc/fortran/parse.c
+++ gcc/fortran/parse.c
@@ -550,8 +550,7 @@ decode_oacc_directive (void)
return ST_NONE;
}
- if (gfc_implicit_pure (NULL))
- gfc_current_ns->proc_name->attr.implicit_pure = 0;
+ gfc_unset_implicit_pure (NULL);
old_locus = gfc_current_locus;
Grüße,
Thomas
[-- Attachment #2: Type: application/pgp-signature, Size: 489 bytes --]
^ permalink raw reply [flat|nested] 89+ messages in thread
* [gomp4] OpenACC cache directive for C.
@ 2014-11-05 16:29 ` Thomas Schwinge
2014-11-05 16:36 ` [gomp4] OpenACC cache directive maintenance (was: [PATCH 4/6] [GOMP4] OpenACC 1.0+ support in fortran front-end) Thomas Schwinge
` (2 more replies)
0 siblings, 3 replies; 89+ messages in thread
From: Thomas Schwinge @ 2014-11-05 16:29 UTC (permalink / raw)
To: gcc-patches; +Cc: James Norris
[-- Attachment #1: Type: text/plain, Size: 8457 bytes --]
Hi!
In r217145, I applied Jim's patch to gomp-4_0-branch:
commit 4361f9b6b2c74c2961c3a5290a4945abe2d7a444
Author: tschwinge <tschwinge@138bc75d-0d04-0410-961f-82ee72b054a4>
Date: Wed Nov 5 16:26:47 2014 +0000
OpenACC cache directive for C.
gcc/c-family/
* c-pragma.c (oacc_pragmas): Add "cache".
gcc/c/
* c-parser.c (c_parser_omp_variable_list): Handle
OMP_NO_CLAUSE_CACHE.
(c_parser_oacc_cache): New function.
(c_parser_omp_construct): Use it for PRAGMA_OACC_CACHE.
libgomp/
* testsuite/libgomp.oacc-c/cache-1.c: New file.
* testsuite/libgomp.oacc-c++/cache-1.C: Likewise.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/branches/gomp-4_0-branch@217145 138bc75d-0d04-0410-961f-82ee72b054a4
---
gcc/c-family/ChangeLog.gomp | 4 ++
gcc/c-family/c-pragma.c | 1 +
gcc/c/ChangeLog.gomp | 7 +++
gcc/c/c-parser.c | 50 ++++++++++++++++++++
libgomp/ChangeLog.gomp | 5 ++
libgomp/testsuite/libgomp.oacc-c++/cache-1.C | 50 ++++++++++++++++++++
libgomp/testsuite/libgomp.oacc-c/cache-1.c | 69 ++++++++++++++++++++++++++++
7 files changed, 186 insertions(+)
diff --git gcc/c-family/ChangeLog.gomp gcc/c-family/ChangeLog.gomp
index 2f8c8a6..5f3b641 100644
--- gcc/c-family/ChangeLog.gomp
+++ gcc/c-family/ChangeLog.gomp
@@ -1,3 +1,7 @@
+2014-11-05 James Norris <jnorris@codesourcery.com>
+
+ * c-pragma.c (oacc_pragmas): Add "cache".
+
2014-11-03 Cesar Philippidis <cesar@codesourcery.com>
* c-pragma.c (oacc_pragmas): Add entries for PRAGMA_OACC_ENTER_DATA
diff --git gcc/c-family/c-pragma.c gcc/c-family/c-pragma.c
index a28727e..e98b555 100644
--- gcc/c-family/c-pragma.c
+++ gcc/c-family/c-pragma.c
@@ -1181,6 +1181,7 @@ static vec<pragma_ns_name> registered_pp_pragmas;
struct omp_pragma_def { const char *name; unsigned int id; };
static const struct omp_pragma_def oacc_pragmas[] = {
+ { "cache", PRAGMA_OACC_CACHE },
{ "data", PRAGMA_OACC_DATA },
{ "enter", PRAGMA_OACC_ENTER_DATA },
{ "exit", PRAGMA_OACC_EXIT_DATA },
diff --git gcc/c/ChangeLog.gomp gcc/c/ChangeLog.gomp
index f4e2010..7acd7b3 100644
--- gcc/c/ChangeLog.gomp
+++ gcc/c/ChangeLog.gomp
@@ -1,3 +1,10 @@
+2014-11-05 James Norris <jnorris@codesourcery.com>
+
+ * c-parser.c (c_parser_omp_variable_list): Handle
+ OMP_NO_CLAUSE_CACHE.
+ (c_parser_oacc_cache): New function.
+ (c_parser_omp_construct): Use it for PRAGMA_OACC_CACHE.
+
2014-11-03 Cesar Philippidis <cesar@codesourcery.com>
* c-parser.c (c_parser_oacc_enter_exit_data): New function.
diff --git gcc/c/c-parser.c gcc/c/c-parser.c
index 6ac1ace..410b19f 100644
--- gcc/c/c-parser.c
+++ gcc/c/c-parser.c
@@ -10053,6 +10053,14 @@ c_parser_omp_variable_list (c_parser *parser,
{
switch (kind)
{
+ case OMP_NO_CLAUSE_CACHE:
+ if (c_parser_peek_token (parser)->type != CPP_OPEN_SQUARE)
+ {
+ c_parser_error (parser, "expected %<[%>");
+ t = error_mark_node;
+ break;
+ }
+ /* FALL THROUGH. */
case OMP_CLAUSE_MAP:
case OMP_CLAUSE_FROM:
case OMP_CLAUSE_TO:
@@ -10091,6 +10099,29 @@ c_parser_omp_variable_list (c_parser *parser,
t = error_mark_node;
break;
}
+
+ if (kind == OMP_NO_CLAUSE_CACHE)
+ {
+ mark_exp_read (low_bound);
+ mark_exp_read (length);
+
+ if (TREE_CODE (low_bound) != INTEGER_CST
+ && !TREE_READONLY (low_bound))
+ {
+ error_at (clause_loc,
+ "%qD is not a constant", low_bound);
+ t = error_mark_node;
+ }
+
+ if (TREE_CODE (length) != INTEGER_CST
+ && !TREE_READONLY (length))
+ {
+ error_at (clause_loc,
+ "%qD is not a constant", length);
+ t = error_mark_node;
+ }
+ }
+
t = tree_cons (low_bound, length, t);
}
break;
@@ -11864,6 +11895,21 @@ c_parser_omp_structured_block (c_parser *parser)
}
/* OpenACC 2.0:
+ # pragma acc cache (variable-list) new-line
+
+ LOC is the location of the #pragma token.
+*/
+
+static tree
+c_parser_oacc_cache (location_t loc __attribute__((unused)), c_parser *parser)
+{
+ c_parser_omp_var_list_parens (parser, OMP_NO_CLAUSE_CACHE, NULL);
+ c_parser_skip_to_pragma_eol (parser);
+
+ return NULL_TREE;
+}
+
+/* OpenACC 2.0:
# pragma acc data oacc-data-clause[optseq] new-line
structured-block
@@ -14506,6 +14552,10 @@ c_parser_omp_construct (c_parser *parser)
switch (p_kind)
{
+ case PRAGMA_OACC_CACHE:
+ strcpy (p_name, "#pragma acc");
+ stmt = c_parser_oacc_cache (loc, parser);
+ break;
case PRAGMA_OACC_DATA:
stmt = c_parser_oacc_data (loc, parser);
break;
diff --git libgomp/ChangeLog.gomp libgomp/ChangeLog.gomp
index 8dc947d..4ac348d 100644
--- libgomp/ChangeLog.gomp
+++ libgomp/ChangeLog.gomp
@@ -1,3 +1,8 @@
+2014-11-05 James Norris <jnorris@codesourcery.com>
+
+ * testsuite/libgomp.oacc-c/cache-1.c: New file.
+ * testsuite/libgomp.oacc-c++/cache-1.C: Likewise.
+
2014-11-05 Thomas Schwinge <thomas@codesourcery.com>
James Norris <jnorris@codesourcery.com>
diff --git libgomp/testsuite/libgomp.oacc-c++/cache-1.C libgomp/testsuite/libgomp.oacc-c++/cache-1.C
new file mode 100644
index 0000000..eb94a68
--- /dev/null
+++ libgomp/testsuite/libgomp.oacc-c++/cache-1.C
@@ -0,0 +1,50 @@
+/* { dg-do compile } */
+
+#include <stdlib.h>
+
+int
+main (int argc, char **argv)
+{
+#define N 2
+ int a[N], b[N];
+ int i;
+
+ for (i = 0; i < N; i++)
+ {
+ a[i] = 3;
+ b[i] = 0;
+ }
+
+#pragma acc parallel copyin (a[0:N]) copyout (b[0:N])
+{
+ int ii;
+
+ for (ii = 0; ii < N; ii++)
+ {
+ const int idx = ii;
+ int n = 1;
+ const int len = n;
+
+#pragma acc cache /* { dg-error "error: expected '\\(' before end of line" } */
+
+#pragma acc cache (a) /* { dg-error "error: expected '\\\['" } */
+
+#pragma acc cache (a[0:N]) copyin (a[0:N]) /* { dg-error "error: expected end of line before 'copyin'" } */
+
+#pragma acc cache () /* { dg-error "error: expected unqualified-id before '\\)' token" } */
+
+#pragma acc cache (a[0:N] b[0:N}) /* { dg-error "error: expected end of line before '\\\}' token|error: expected '\\)' before 'b'" } */
+
+ b[ii] = a[ii];
+ }
+}
+
+
+ for (i = 0; i < N; i++)
+ {
+ if (a[i] != b[i])
+ abort ();
+ }
+
+ return 0;
+}
diff --git libgomp/testsuite/libgomp.oacc-c/cache-1.c libgomp/testsuite/libgomp.oacc-c/cache-1.c
new file mode 100644
index 0000000..5473475
--- /dev/null
+++ libgomp/testsuite/libgomp.oacc-c/cache-1.c
@@ -0,0 +1,69 @@
+/* { dg-do compile } */
+
+#include <openacc.h>
+#include <stdlib.h>
+
+int
+main (int argc, char **argv)
+{
+#define N 2
+ int a[N], b[N];
+ int i;
+
+ for (i = 0; i < N; i++)
+ {
+ a[i] = 3;
+ b[i] = 0;
+ }
+
+#pragma acc parallel copyin (a[0:N]) copyout (b[0:N])
+{
+ int ii;
+
+ for (ii = 0; ii < N; ii++)
+ {
+ const int idx = ii;
+ int n = 1;
+ const int len = n;
+
+#pragma acc cache /* { dg-error "error: expected '\\(' before end of line" } */
+
+#pragma acc cache (a) /* { dg-error "error: expected '\\\[' before '\\)' token" } */
+
+#pragma acc cache (a[0:N]) copyin (a[0:N]) /* { dg-error "error: expected end of line before 'copyin'" } */
+
+#pragma acc cache () /* { dg-error "error: expected identifier before '\\)' token" } */
+
+#pragma acc cache (a[0:N] b[0:N}) /* { dg-error "error: expected '\\)' before 'b'" } */
+
+#pragma acc cache (a[0:N] /* { dg-error "error: expected '\\)' before end of line" } */
+
+#pragma acc cache (a[ii]) /* { dg-error "error: 'ii' is not a constant" } */
+
+#pragma acc cache (a[idx:n]) /* { dg-error "error: 'n' is not a constant" } */
+
+#pragma acc cache (a[0:N])
+
+#pragma acc cache (a[0:N], b[0:N])
+
+#pragma acc cache (a[0])
+
+#pragma acc cache (a[0], a[1], b[0:N])
+
+#pragma acc cache (a[idx])
+
+#pragma acc cache (a[idx:len])
+
+ b[ii] = a[ii];
+ }
+}
+
+
+ for (i = 0; i < N; i++)
+ {
+ if (a[i] != b[i])
+ abort ();
+ }
+
+ return 0;
+}
Grüße,
Thomas
[-- Attachment #2: Type: application/pgp-signature, Size: 472 bytes --]
^ permalink raw reply [flat|nested] 89+ messages in thread
* [gomp4] OpenACC cache directive maintenance (was: [PATCH 4/6] [GOMP4] OpenACC 1.0+ support in fortran front-end)
2014-11-05 16:29 ` [gomp4] OpenACC cache directive for C Thomas Schwinge
@ 2014-11-05 16:36 ` Thomas Schwinge
2014-11-05 16:45 ` [gomp4] OpenACC cache directive maintenance Thomas Schwinge
2014-11-05 16:49 ` [gomp4] Testing of C/C++ OpenACC cache directive (was: OpenACC cache directive for C) Thomas Schwinge
2016-06-02 11:47 ` [PR c/71381] C/C++ OpenACC cache directive rejects valid syntax (was: [gomp4] OpenACC cache directive for C.) Thomas Schwinge
2 siblings, 1 reply; 89+ messages in thread
From: Thomas Schwinge @ 2014-11-05 16:36 UTC (permalink / raw)
To: gcc-patches; +Cc: James Norris, Cesar Philippidis
[-- Attachment #1: Type: text/plain, Size: 17085 bytes --]
Hi!
On Fri, 24 Jan 2014 20:33:35 +0100, I wrote:
> On Thu, 23 Jan 2014 22:04:45 +0400, Ilmir Usmanov <i.usmanov@samsung.com> wrote:
> > Subject: [PATCH 4/6] OpenACC GENERIC nodes
> > --- a/gcc/tree-core.h
> > +++ b/gcc/tree-core.h
> > @@ -216,12 +216,18 @@ enum omp_clause_code {
> > + /* Internal structure to hold OpenACC cache directive's variable-list.
> > + #pragma acc cache (variable-_ist). */
> > + OACC_NO_CLAUSE_CACHE,
>
> Hmm, yeah, while *_NO_CLAUSE_* perhaps isn't the most beautiful approach,
> I think it's fine at least for now.
In r217146, I applied the following to gomp-4_0-branch:
commit e8e44b733808997d06c0cdf9bf5756ce03530f42
Author: tschwinge <tschwinge@138bc75d-0d04-0410-961f-82ee72b054a4>
Date: Wed Nov 5 16:35:30 2014 +0000
OpenACC cache directive maintenance.
gcc/c/
* c-parser.c (c_parser_oacc_cache): Generate OACC_CACHE.
* c-typeck.c (c_finish_omp_clauses): Handle OMP_CLAUSE__CACHE_.
gcc/cp/
* parser.c (cp_parser_oacc_cache): Generate OACC_CACHE.
* semantics.c (finish_omp_clauses): Handle OMP_CLAUSE__CACHE_.
gcc/
* gimplify.c (gimplify_oacc_cache): New function.
(gimplify_expr): Use it for OACC_CACHE.
(gimplify_scan_omp_clauses, gimplify_adjust_omp_clauses): Handle
OMP_CLAUSE__CACHE_.
gcc/c/
* c-parser.c (c_parser_omp_variable_list) <OMP_CLAUSE__CACHE_>:
Remove explicit mark_exp_read invocations.
gcc/cp/
* parser.c (cp_parser_omp_var_list_no_open) <OMP_CLAUSE__CACHE_>:
Remove explicit mark_exp_read invocations.
gcc/
* tree-core.h (enum omp_clause_code): Move OMP_NO_CLAUSE_CACHE
next to, and handle it like a data clause. Rename it to
OMP_CLAUSE__CACHE_. Update all users.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/branches/gomp-4_0-branch@217146 138bc75d-0d04-0410-961f-82ee72b054a4
---
gcc/ChangeLog.gomp | 9 +++++++++
gcc/c/ChangeLog.gomp | 8 ++++++++
gcc/c/c-parser.c | 23 +++++++++++++++--------
gcc/c/c-typeck.c | 1 +
gcc/cp/ChangeLog.gomp | 6 ++++++
gcc/cp/parser.c | 24 +++++++++++++++---------
gcc/cp/semantics.c | 1 +
gcc/fortran/trans-openmp.c | 2 +-
gcc/gimplify.c | 25 ++++++++++++++++++++++---
gcc/omp-low.c | 4 ++--
gcc/tree-core.h | 8 ++++----
gcc/tree-pretty-print.c | 11 +++++++----
gcc/tree.c | 6 +++---
gcc/tree.def | 5 +++--
gcc/tree.h | 2 +-
15 files changed, 98 insertions(+), 37 deletions(-)
diff --git gcc/ChangeLog.gomp gcc/ChangeLog.gomp
index fc624c8..2c2b349 100644
--- gcc/ChangeLog.gomp
+++ gcc/ChangeLog.gomp
@@ -1,5 +1,14 @@
2014-11-05 Thomas Schwinge <thomas@codesourcery.com>
+ * gimplify.c (gimplify_oacc_cache): New function.
+ (gimplify_expr): Use it for OACC_CACHE.
+ (gimplify_scan_omp_clauses, gimplify_adjust_omp_clauses): Handle
+ OMP_CLAUSE__CACHE_.
+
+ * tree-core.h (enum omp_clause_code): Move OMP_NO_CLAUSE_CACHE
+ next to, and handle it like a data clause. Rename it to
+ OMP_CLAUSE__CACHE_. Update all users.
+
* invoke.texi: Update for OpenACC.
* sourcebuild.texi: Likewise.
diff --git gcc/c/ChangeLog.gomp gcc/c/ChangeLog.gomp
index 7acd7b3..70278b9 100644
--- gcc/c/ChangeLog.gomp
+++ gcc/c/ChangeLog.gomp
@@ -1,3 +1,11 @@
+2014-11-05 Thomas Schwinge <thomas@codesourcery.com>
+
+ * c-parser.c (c_parser_oacc_cache): Generate OACC_CACHE.
+ * c-typeck.c (c_finish_omp_clauses): Handle OMP_CLAUSE__CACHE_.
+
+ * c-parser.c (c_parser_omp_variable_list) <OMP_CLAUSE__CACHE_>:
+ Remove explicit mark_exp_read invocations.
+
2014-11-05 James Norris <jnorris@codesourcery.com>
* c-parser.c (c_parser_omp_variable_list): Handle
diff --git gcc/c/c-parser.c gcc/c/c-parser.c
index 410b19f..40d4314 100644
--- gcc/c/c-parser.c
+++ gcc/c/c-parser.c
@@ -10053,7 +10053,7 @@ c_parser_omp_variable_list (c_parser *parser,
{
switch (kind)
{
- case OMP_NO_CLAUSE_CACHE:
+ case OMP_CLAUSE__CACHE_:
if (c_parser_peek_token (parser)->type != CPP_OPEN_SQUARE)
{
c_parser_error (parser, "expected %<[%>");
@@ -10100,11 +10100,8 @@ c_parser_omp_variable_list (c_parser *parser,
break;
}
- if (kind == OMP_NO_CLAUSE_CACHE)
+ if (kind == OMP_CLAUSE__CACHE_)
{
- mark_exp_read (low_bound);
- mark_exp_read (length);
-
if (TREE_CODE (low_bound) != INTEGER_CST
&& !TREE_READONLY (low_bound))
{
@@ -11901,12 +11898,22 @@ c_parser_omp_structured_block (c_parser *parser)
*/
static tree
-c_parser_oacc_cache (location_t loc __attribute__((unused)), c_parser *parser)
+c_parser_oacc_cache (location_t loc, c_parser *parser)
{
- c_parser_omp_var_list_parens (parser, OMP_NO_CLAUSE_CACHE, NULL);
+ tree stmt, clauses;
+
+ clauses = c_parser_omp_var_list_parens (parser, OMP_CLAUSE__CACHE_, NULL);
+ clauses = c_finish_omp_clauses (clauses);
+
c_parser_skip_to_pragma_eol (parser);
- return NULL_TREE;
+ stmt = make_node (OACC_CACHE);
+ TREE_TYPE (stmt) = void_type_node;
+ OACC_CACHE_CLAUSES (stmt) = clauses;
+ SET_EXPR_LOCATION (stmt, loc);
+ add_stmt (stmt);
+
+ return stmt;
}
/* OpenACC 2.0:
diff --git gcc/c/c-typeck.c gcc/c/c-typeck.c
index 76503e4..e315690d 100644
--- gcc/c/c-typeck.c
+++ gcc/c/c-typeck.c
@@ -12204,6 +12204,7 @@ c_finish_omp_clauses (tree clauses)
case OMP_CLAUSE_MAP:
case OMP_CLAUSE_TO:
case OMP_CLAUSE_FROM:
+ case OMP_CLAUSE__CACHE_:
t = OMP_CLAUSE_DECL (c);
if (TREE_CODE (t) == TREE_LIST)
{
diff --git gcc/cp/ChangeLog.gomp gcc/cp/ChangeLog.gomp
index 024e6a5..46d4912 100644
--- gcc/cp/ChangeLog.gomp
+++ gcc/cp/ChangeLog.gomp
@@ -1,5 +1,11 @@
2014-11-05 Thomas Schwinge <thomas@codesourcery.com>
+ * parser.c (cp_parser_oacc_cache): Generate OACC_CACHE.
+ * semantics.c (finish_omp_clauses): Handle OMP_CLAUSE__CACHE_.
+
+ * parser.c (cp_parser_omp_var_list_no_open) <OMP_CLAUSE__CACHE_>:
+ Remove explicit mark_exp_read invocations.
+
* parser.c (cp_parser_omp_clause_name): Also look for "pcopy",
"pcopyin", "pcopyout", "pcreate". Look for "wait" instead of
"WAIT".
diff --git gcc/cp/parser.c gcc/cp/parser.c
index 3ef2de7..ea4ad2f 100644
--- gcc/cp/parser.c
+++ gcc/cp/parser.c
@@ -27669,7 +27669,7 @@ cp_parser_omp_var_list_no_open (cp_parser *parser, enum omp_clause_code kind,
{
switch (kind)
{
- case OMP_NO_CLAUSE_CACHE:
+ case OMP_CLAUSE__CACHE_:
if (cp_lexer_peek_token (parser->lexer)->type != CPP_OPEN_SQUARE)
{
error_at (token->location, "expected %<[%>");
@@ -27708,11 +27708,8 @@ cp_parser_omp_var_list_no_open (cp_parser *parser, enum omp_clause_code kind,
RT_CLOSE_SQUARE))
goto skip_comma;
- if (kind == OMP_NO_CLAUSE_CACHE)
+ if (kind == OMP_CLAUSE__CACHE_)
{
- mark_exp_read (low_bound);
- mark_exp_read (length);
-
if (TREE_CODE (low_bound) != INTEGER_CST
&& !TREE_READONLY (low_bound))
{
@@ -31410,13 +31407,22 @@ cp_parser_omp_target (cp_parser *parser, cp_token *pragma_tok,
*/
static tree
-cp_parser_oacc_cache (cp_parser *parser,
- cp_token *pragma_tok __attribute__((unused)))
+cp_parser_oacc_cache (cp_parser *parser, cp_token *pragma_tok)
{
- cp_parser_omp_var_list (parser, OMP_NO_CLAUSE_CACHE, NULL_TREE);
+ tree stmt, clauses;
+
+ clauses = cp_parser_omp_var_list (parser, OMP_CLAUSE__CACHE_, NULL_TREE);
+ clauses = finish_omp_clauses (clauses);
+
cp_parser_require_pragma_eol (parser, cp_lexer_peek_token (parser->lexer));
- return NULL_TREE;
+ stmt = make_node (OACC_CACHE);
+ TREE_TYPE (stmt) = void_type_node;
+ OACC_CACHE_CLAUSES (stmt) = clauses;
+ SET_EXPR_LOCATION (stmt, pragma_tok->location);
+ add_stmt (stmt);
+
+ return stmt;
}
/* OpenACC 2.0:
diff --git gcc/cp/semantics.c gcc/cp/semantics.c
index 2457a6f..6e35eef 100644
--- gcc/cp/semantics.c
+++ gcc/cp/semantics.c
@@ -5704,6 +5704,7 @@ finish_omp_clauses (tree clauses)
case OMP_CLAUSE_MAP:
case OMP_CLAUSE_TO:
case OMP_CLAUSE_FROM:
+ case OMP_CLAUSE__CACHE_:
t = OMP_CLAUSE_DECL (c);
if (TREE_CODE (t) == TREE_LIST)
{
diff --git gcc/fortran/trans-openmp.c gcc/fortran/trans-openmp.c
index 97613ae..7dd4498 100644
--- gcc/fortran/trans-openmp.c
+++ gcc/fortran/trans-openmp.c
@@ -1807,7 +1807,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
clause_code = OMP_CLAUSE_DEVICE_RESIDENT;
goto add_clause;
case OMP_LIST_CACHE:
- clause_code = OMP_NO_CLAUSE_CACHE;
+ clause_code = OMP_CLAUSE__CACHE_;
goto add_clause;
add_clause:
diff --git gcc/gimplify.c gcc/gimplify.c
index bfd7f66..d58876f 100644
--- gcc/gimplify.c
+++ gcc/gimplify.c
@@ -6114,6 +6114,7 @@ gimplify_scan_omp_clauses (tree *list_p, gimple_seq *pre_p,
case OMP_CLAUSE_TO:
case OMP_CLAUSE_FROM:
+ case OMP_CLAUSE__CACHE_:
decl = OMP_CLAUSE_DECL (c);
if (error_operand_p (decl))
{
@@ -6294,7 +6295,6 @@ gimplify_scan_omp_clauses (tree *list_p, gimple_seq *pre_p,
case OMP_CLAUSE_GANG:
case OMP_CLAUSE_ASYNC:
case OMP_CLAUSE_WAIT:
- case OMP_NO_CLAUSE_CACHE:
case OMP_CLAUSE_INDEPENDENT:
case OMP_CLAUSE_WORKER:
case OMP_CLAUSE_VECTOR:
@@ -6641,6 +6641,7 @@ gimplify_adjust_omp_clauses (gimple_seq *pre_p, tree *list_p)
case OMP_CLAUSE_TO:
case OMP_CLAUSE_FROM:
+ case OMP_CLAUSE__CACHE_:
decl = OMP_CLAUSE_DECL (c);
if (!DECL_P (decl))
break;
@@ -6698,7 +6699,6 @@ gimplify_adjust_omp_clauses (gimple_seq *pre_p, tree *list_p)
case OMP_CLAUSE_GANG:
case OMP_CLAUSE_ASYNC:
case OMP_CLAUSE_WAIT:
- case OMP_NO_CLAUSE_CACHE:
case OMP_CLAUSE_INDEPENDENT:
case OMP_CLAUSE_WORKER:
case OMP_CLAUSE_VECTOR:
@@ -6722,6 +6722,21 @@ gimplify_adjust_omp_clauses (gimple_seq *pre_p, tree *list_p)
delete_omp_context (ctx);
}
+/* Gimplify OACC_CACHE. */
+
+static void
+gimplify_oacc_cache (tree *expr_p, gimple_seq *pre_p)
+{
+ tree expr = *expr_p;
+
+ gimplify_scan_omp_clauses (&OACC_CACHE_CLAUSES (expr), pre_p, ORT_WORKSHARE);
+ gimplify_adjust_omp_clauses (pre_p, &OACC_CACHE_CLAUSES (expr));
+
+ /* TODO: Do something sensible with this information. */
+
+ *expr_p = NULL_TREE;
+}
+
/* Gimplify the contents of an OMP_PARALLEL statement. This involves
gimplification of the body, as well as scanning the body for used
variables. We need to do this scan now, because variable-sized
@@ -8312,7 +8327,6 @@ gimplify_expr (tree *expr_p, gimple_seq *pre_p, gimple_seq *post_p,
case OACC_HOST_DATA:
case OACC_DECLARE:
- case OACC_CACHE:
sorry ("directive not yet implemented");
ret = GS_ALL_DONE;
break;
@@ -8352,6 +8366,11 @@ gimplify_expr (tree *expr_p, gimple_seq *pre_p, gimple_seq *post_p,
ret = GS_ALL_DONE;
break;
+ case OACC_CACHE:
+ gimplify_oacc_cache (expr_p, pre_p);
+ ret = GS_ALL_DONE;
+ break;
+
case OACC_DATA:
case OMP_SECTIONS:
case OMP_SINGLE:
diff --git gcc/omp-low.c gcc/omp-low.c
index 49cf1ab..1c9d942 100644
--- gcc/omp-low.c
+++ gcc/omp-low.c
@@ -1982,7 +1982,7 @@ scan_sharing_clauses (tree clauses, omp_context *ctx)
case OMP_CLAUSE_DEVICE_RESIDENT:
case OMP_CLAUSE_USE_DEVICE:
case OMP_CLAUSE_GANG:
- case OMP_NO_CLAUSE_CACHE:
+ case OMP_CLAUSE__CACHE_:
case OMP_CLAUSE_INDEPENDENT:
case OMP_CLAUSE_WORKER:
case OMP_CLAUSE_VECTOR:
@@ -2130,7 +2130,7 @@ scan_sharing_clauses (tree clauses, omp_context *ctx)
case OMP_CLAUSE_DEVICE_RESIDENT:
case OMP_CLAUSE_USE_DEVICE:
case OMP_CLAUSE_GANG:
- case OMP_NO_CLAUSE_CACHE:
+ case OMP_CLAUSE__CACHE_:
case OMP_CLAUSE_INDEPENDENT:
case OMP_CLAUSE_WORKER:
case OMP_CLAUSE_VECTOR:
diff --git gcc/tree-core.h gcc/tree-core.h
index abdc2c9..42ad6a0 100644
--- gcc/tree-core.h
+++ gcc/tree-core.h
@@ -266,6 +266,10 @@ enum omp_clause_code {
OpenMP clause: map ({alloc:,to:,from:,tofrom:,}variable-list). */
OMP_CLAUSE_MAP,
+ /* Internal structure to hold OpenACC cache directive's variable-list.
+ #pragma acc cache (variable-list). */
+ OMP_CLAUSE__CACHE_,
+
/* OpenACC clause: host (variable_list). */
OMP_CLAUSE_HOST,
@@ -292,10 +296,6 @@ enum omp_clause_code {
/* OpenACC clause/directive: wait [(integer-expression-list)]. */
OMP_CLAUSE_WAIT,
- /* Internal structure to hold OpenACC cache directive's variable-list.
- #pragma acc cache (variable-list). */
- OMP_NO_CLAUSE_CACHE,
-
/* Internal clause: temporary for combined loops expansion. */
OMP_CLAUSE__LOOPTEMP_,
diff --git gcc/tree-pretty-print.c gcc/tree-pretty-print.c
index f311ed9..d678f36 100644
--- gcc/tree-pretty-print.c
+++ gcc/tree-pretty-print.c
@@ -347,9 +347,6 @@ dump_omp_clause (pretty_printer *buffer, tree clause, int spc, int flags)
case OMP_CLAUSE_USE_DEVICE:
name = "use_device";
goto print_remap;
- case OMP_NO_CLAUSE_CACHE:
- name = "_cache_";
- goto print_remap;
print_remap:
pp_string (buffer, name);
pp_left_paren (buffer);
@@ -599,6 +596,12 @@ dump_omp_clause (pretty_printer *buffer, tree clause, int spc, int flags)
spc, flags, false);
goto print_clause_size;
+ case OMP_CLAUSE__CACHE_:
+ pp_string (buffer, "(");
+ dump_generic_node (buffer, OMP_CLAUSE_DECL (clause),
+ spc, flags, false);
+ goto print_clause_size;
+
case OMP_CLAUSE_NUM_TEAMS:
pp_string (buffer, "num_teams(");
dump_generic_node (buffer, OMP_CLAUSE_NUM_TEAMS_EXPR (clause),
@@ -2548,7 +2551,7 @@ dump_generic_node (pretty_printer *buffer, tree node, int spc, int flags,
case OACC_CACHE:
pp_string (buffer, "#pragma acc cache");
- dump_omp_clauses (buffer, OACC_CACHE_CLAUSES(node), spc, flags);
+ dump_omp_clauses (buffer, OACC_CACHE_CLAUSES (node), spc, flags);
break;
case OMP_PARALLEL:
diff --git gcc/tree.c gcc/tree.c
index 0475622..f39c63f 100644
--- gcc/tree.c
+++ gcc/tree.c
@@ -270,6 +270,7 @@ unsigned const char omp_clause_num_ops[] =
2, /* OMP_CLAUSE_FROM */
2, /* OMP_CLAUSE_TO */
2, /* OMP_CLAUSE_MAP */
+ 2, /* OMP_CLAUSE__CACHE_ */
1, /* OMP_CLAUSE_HOST */
1, /* OMP_CLAUSE_OACC_DEVICE */
1, /* OMP_CLAUSE_DEVICE_RESIDENT */
@@ -277,7 +278,6 @@ unsigned const char omp_clause_num_ops[] =
1, /* OMP_CLAUSE_GANG */
1, /* OMP_CLAUSE_ASYNC */
1, /* OMP_CLAUSE_WAIT */
- 1, /* OMP_NO_CLAUSE_CACHE */
1, /* OMP_CLAUSE__LOOPTEMP_ */
1, /* OMP_CLAUSE_IF */
1, /* OMP_CLAUSE_NUM_THREADS */
@@ -329,6 +329,7 @@ const char * const omp_clause_code_name[] =
"from",
"to",
"map",
+ "_cache_",
"host",
"device",
"device_resident",
@@ -336,7 +337,6 @@ const char * const omp_clause_code_name[] =
"gang",
"async",
"wait",
- "_cache_",
"_looptemp_",
"if",
"num_threads",
@@ -11127,7 +11127,6 @@ walk_tree_1 (tree *tp, walk_tree_fn func, void *data,
case OMP_CLAUSE_GANG:
case OMP_CLAUSE_ASYNC:
case OMP_CLAUSE_WAIT:
- case OMP_NO_CLAUSE_CACHE:
case OMP_CLAUSE_WORKER:
case OMP_CLAUSE_VECTOR:
case OMP_CLAUSE_NUM_GANGS:
@@ -11194,6 +11193,7 @@ walk_tree_1 (tree *tp, walk_tree_fn func, void *data,
case OMP_CLAUSE_FROM:
case OMP_CLAUSE_TO:
case OMP_CLAUSE_MAP:
+ case OMP_CLAUSE__CACHE_:
WALK_SUBTREE (OMP_CLAUSE_DECL (*tp));
WALK_SUBTREE (OMP_CLAUSE_OPERAND (*tp, 1));
WALK_SUBTREE_TAIL (OMP_CLAUSE_CHAIN (*tp));
diff --git gcc/tree.def gcc/tree.def
index 871a7fb..f44853a 100644
--- gcc/tree.def
+++ gcc/tree.def
@@ -1163,8 +1163,9 @@ DEFTREECODE (OACC_ENTER_DATA, "oacc_enter_data", tcc_statement, 1)
Operand 0: OACC_EXIT_DATA_CLAUSES: List of clauses. */
DEFTREECODE (OACC_EXIT_DATA, "oacc_exit_data", tcc_statement, 1)
-/* OpenACC - #pragma acc cache [clause1 ... clauseN]
- Operand 0: OACC_CACHE_CLAUSES: List of clauses. */
+/* OpenACC - #pragma acc cache (variable1 ... variableN)
+ Operand 0: OACC_CACHE_CLAUSES: List of variables (transformed into
+ OMP_CLAUSE__CACHE_ clauses). */
DEFTREECODE (OACC_CACHE, "oacc_cache", tcc_statement, 1)
/* OpenMP - #pragma omp target update [clause1 ... clauseN]
diff --git gcc/tree.h gcc/tree.h
index c91e716..e1adbab 100644
--- gcc/tree.h
+++ gcc/tree.h
@@ -1254,7 +1254,7 @@ extern void protected_set_expr_location (tree, location_t);
#define OMP_CLAUSE_SIZE(NODE) \
OMP_CLAUSE_OPERAND (OMP_CLAUSE_RANGE_CHECK (OMP_CLAUSE_CHECK (NODE), \
OMP_CLAUSE_FROM, \
- OMP_CLAUSE_MAP), 1)
+ OMP_CLAUSE__CACHE_), 1)
#define OMP_CLAUSE_CHAIN(NODE) TREE_CHAIN (OMP_CLAUSE_CHECK (NODE))
#define OMP_CLAUSE_DECL(NODE) \
Grüße,
Thomas
[-- Attachment #2: Type: application/pgp-signature, Size: 472 bytes --]
^ permalink raw reply [flat|nested] 89+ messages in thread
* Re: [gomp4] OpenACC cache directive maintenance
2014-11-05 16:36 ` [gomp4] OpenACC cache directive maintenance (was: [PATCH 4/6] [GOMP4] OpenACC 1.0+ support in fortran front-end) Thomas Schwinge
@ 2014-11-05 16:45 ` Thomas Schwinge
2015-10-27 15:26 ` [PR fortran/63865] OpenACC cache directive: match Fortran support with C/C++ (was: [gomp4] OpenACC cache directive maintenance) Thomas Schwinge
0 siblings, 1 reply; 89+ messages in thread
From: Thomas Schwinge @ 2014-11-05 16:45 UTC (permalink / raw)
To: Cesar Philippidis, fortran; +Cc: James Norris, gcc-patches
[-- Attachment #1: Type: text/plain, Size: 8329 bytes --]
Hi Cesar!
On Wed, 05 Nov 2014 17:36:46 +0100, I wrote:
> In r217146, I applied the following to gomp-4_0-branch:
>
> commit e8e44b733808997d06c0cdf9bf5756ce03530f42
> Author: tschwinge <tschwinge@138bc75d-0d04-0410-961f-82ee72b054a4>
> Date: Wed Nov 5 16:35:30 2014 +0000
>
> OpenACC cache directive maintenance.
>
> gcc/c/
> * c-parser.c (c_parser_oacc_cache): Generate OACC_CACHE.
> * c-typeck.c (c_finish_omp_clauses): Handle OMP_CLAUSE__CACHE_.
> gcc/cp/
> * parser.c (cp_parser_oacc_cache): Generate OACC_CACHE.
> * semantics.c (finish_omp_clauses): Handle OMP_CLAUSE__CACHE_.
> gcc/
> * gimplify.c (gimplify_oacc_cache): New function.
> (gimplify_expr): Use it for OACC_CACHE.
> (gimplify_scan_omp_clauses, gimplify_adjust_omp_clauses): Handle
> OMP_CLAUSE__CACHE_.
> --- gcc/c/c-parser.c
> +++ gcc/c/c-parser.c
> static tree
> -c_parser_oacc_cache (location_t loc __attribute__((unused)), c_parser *parser)
> +c_parser_oacc_cache (location_t loc, c_parser *parser)
> {
> - c_parser_omp_var_list_parens (parser, OMP_NO_CLAUSE_CACHE, NULL);
> + tree stmt, clauses;
> +
> + clauses = c_parser_omp_var_list_parens (parser, OMP_CLAUSE__CACHE_, NULL);
> + clauses = c_finish_omp_clauses (clauses);
> +
> c_parser_skip_to_pragma_eol (parser);
>
> - return NULL_TREE;
> + stmt = make_node (OACC_CACHE);
> + TREE_TYPE (stmt) = void_type_node;
> + OACC_CACHE_CLAUSES (stmt) = clauses;
> + SET_EXPR_LOCATION (stmt, loc);
> + add_stmt (stmt);
> +
> + return stmt;
> }
> --- gcc/c/c-typeck.c
> +++ gcc/c/c-typeck.c
> @@ -12204,6 +12204,7 @@ c_finish_omp_clauses (tree clauses)
> case OMP_CLAUSE_MAP:
> case OMP_CLAUSE_TO:
> case OMP_CLAUSE_FROM:
> + case OMP_CLAUSE__CACHE_:
> t = OMP_CLAUSE_DECL (c);
> if (TREE_CODE (t) == TREE_LIST)
> {
[The "same" for C++.]
I also tried to make this work for Fortran, but didn't manage to (in
a reasonable amount of time, which has not been a lot that I allocated)
;-) -- would you please have a look at this (but it's not urgent).
commit 7cf14ddb307a5b271e098f3a3fdb0452f6036f91
Author: Thomas Schwinge <thomas@codesourcery.com>
Date: Wed Nov 5 09:16:12 2014 +0100
cache: Fortran experimenting.
---
gcc/fortran/frontend-passes.c | 3 ++-
gcc/fortran/openmp.c | 12 ++----------
gcc/fortran/trans-openmp.c | 18 ++++++++++++------
gcc/testsuite/gfortran.dg/goacc/cache-1.f95 | 1 -
gcc/testsuite/gfortran.dg/goacc/coarray.f95 | 1 -
gcc/testsuite/gfortran.dg/goacc/cray.f95 | 2 --
gcc/testsuite/gfortran.dg/goacc/loop-1.f95 | 1 -
gcc/testsuite/gfortran.dg/goacc/parameter.f95 | 1 -
8 files changed, 16 insertions(+), 23 deletions(-)
diff --git gcc/fortran/frontend-passes.c gcc/fortran/frontend-passes.c
index 97a9164..729629e 100644
--- gcc/fortran/frontend-passes.c
+++ gcc/fortran/frontend-passes.c
@@ -2190,7 +2190,8 @@ gfc_code_walker (gfc_code **c, walk_code_fn_t codefn, walk_expr_fn_t exprfn,
gfc_omp_namelist *n;
static int list_types[]
= { OMP_LIST_ALIGNED, OMP_LIST_LINEAR, OMP_LIST_DEPEND,
- OMP_LIST_MAP, OMP_LIST_TO, OMP_LIST_FROM };
+ OMP_LIST_MAP, OMP_LIST_TO, OMP_LIST_FROM,
+ OMP_LIST_CACHE };
size_t idx;
WALK_SUBEXPR (co->ext.omp_clauses->if_expr);
WALK_SUBEXPR (co->ext.omp_clauses->final_expr);
diff --git gcc/fortran/openmp.c gcc/fortran/openmp.c
index 959798a..167331a 100644
--- gcc/fortran/openmp.c
+++ gcc/fortran/openmp.c
@@ -3102,6 +3102,7 @@ resolve_omp_clauses (gfc_code *code, locus *where,
case OMP_LIST_MAP:
case OMP_LIST_TO:
case OMP_LIST_FROM:
+ case OMP_LIST_CACHE:
for (; n != NULL; n = n->next)
{
if (n->expr)
@@ -4594,13 +4595,6 @@ resolve_oacc_loop(gfc_code *code)
}
-static void
-resolve_oacc_cache (gfc_code *code)
-{
- gfc_error ("Sorry, !$ACC cache unimplemented yet at %L", &code->loc);
-}
-
-
void
gfc_resolve_oacc_declare (gfc_namespace *ns)
{
@@ -4675,6 +4669,7 @@ gfc_resolve_oacc_directive (gfc_code *code, gfc_namespace *ns ATTRIBUTE_UNUSED)
case EXEC_OACC_ENTER_DATA:
case EXEC_OACC_EXIT_DATA:
case EXEC_OACC_WAIT:
+ case EXEC_OACC_CACHE:
resolve_omp_clauses (code, &code->loc, code->ext.omp_clauses, NULL,
true);
break;
@@ -4683,9 +4678,6 @@ gfc_resolve_oacc_directive (gfc_code *code, gfc_namespace *ns ATTRIBUTE_UNUSED)
case EXEC_OACC_LOOP:
resolve_oacc_loop (code);
break;
- case EXEC_OACC_CACHE:
- resolve_oacc_cache (code);
- break;
default:
break;
}
diff --git gcc/fortran/trans-openmp.c gcc/fortran/trans-openmp.c
index 7dd4498..e39e903 100644
--- gcc/fortran/trans-openmp.c
+++ gcc/fortran/trans-openmp.c
@@ -1806,9 +1806,9 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
case OMP_LIST_DEVICE_RESIDENT:
clause_code = OMP_CLAUSE_DEVICE_RESIDENT;
goto add_clause;
- case OMP_LIST_CACHE:
- clause_code = OMP_CLAUSE__CACHE_;
- goto add_clause;
+// case OMP_LIST_CACHE:
+// clause_code = OMP_CLAUSE__CACHE_;
+// goto add_clause;
add_clause:
omp_clauses
@@ -2178,14 +2178,20 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
break;
case OMP_LIST_TO:
case OMP_LIST_FROM:
+ case OMP_LIST_CACHE:
for (; n != NULL; n = n->next)
{
if (!n->sym->attr.referenced)
continue;
- tree node = build_omp_clause (input_location,
- list == OMP_LIST_TO
- ? OMP_CLAUSE_TO : OMP_CLAUSE_FROM);
+ switch (list)
+ {
+ case OMP_LIST_TO: clause_code = OMP_CLAUSE_TO; break;
+ case OMP_LIST_FROM: clause_code = OMP_CLAUSE_FROM; break;
+ case OMP_LIST_CACHE: clause_code = OMP_CLAUSE__CACHE_; break;
+ default: gcc_unreachable ();
+ }
+ tree node = build_omp_clause (input_location, clause_code);
if (n->expr == NULL || n->expr->ref->u.ar.type == AR_FULL)
{
tree decl = gfc_get_symbol_decl (n->sym);
diff --git gcc/testsuite/gfortran.dg/goacc/cache-1.f95 gcc/testsuite/gfortran.dg/goacc/cache-1.f95
index 746cf02..74ab332 100644
--- gcc/testsuite/gfortran.dg/goacc/cache-1.f95
+++ gcc/testsuite/gfortran.dg/goacc/cache-1.f95
@@ -9,4 +9,3 @@ program test
!$acc cache (d)
enddo
end
-! { dg-prune-output "unimplemented" }
diff --git gcc/testsuite/gfortran.dg/goacc/coarray.f95 gcc/testsuite/gfortran.dg/goacc/coarray.f95
index 4f1224e..f0adac6 100644
--- gcc/testsuite/gfortran.dg/goacc/coarray.f95
+++ gcc/testsuite/gfortran.dg/goacc/coarray.f95
@@ -32,4 +32,3 @@ contains
!$acc update self (a)
end subroutine oacc1
end module test
-! { dg-prune-output "ACC cache unimplemented" }
diff --git gcc/testsuite/gfortran.dg/goacc/cray.f95 gcc/testsuite/gfortran.dg/goacc/cray.f95
index 8f2c077..1ed40fd 100644
--- gcc/testsuite/gfortran.dg/goacc/cray.f95
+++ gcc/testsuite/gfortran.dg/goacc/cray.f95
@@ -24,7 +24,6 @@ contains
!$acc end parallel loop
!$acc parallel loop
do i = 1,5
- ! Subarrays are not implemented yet
!$acc cache (pointee) ! TODO: This must fail, as in openacc-1_0-branch
enddo
!$acc end parallel loop
@@ -53,4 +52,3 @@ contains
!$acc update self (ptr)
end subroutine oacc1
end module test
-! { dg-prune-output "unimplemented" }
diff --git gcc/testsuite/gfortran.dg/goacc/loop-1.f95 gcc/testsuite/gfortran.dg/goacc/loop-1.f95
index e1b2dfd..817039f 100644
--- gcc/testsuite/gfortran.dg/goacc/loop-1.f95
+++ gcc/testsuite/gfortran.dg/goacc/loop-1.f95
@@ -168,4 +168,3 @@ subroutine test1
end subroutine test1
end module test
! { dg-prune-output "Deleted" }
-! { dg-prune-output "ACC cache unimplemented" }
diff --git gcc/testsuite/gfortran.dg/goacc/parameter.f95 gcc/testsuite/gfortran.dg/goacc/parameter.f95
index 1364181..82c25ba 100644
--- gcc/testsuite/gfortran.dg/goacc/parameter.f95
+++ gcc/testsuite/gfortran.dg/goacc/parameter.f95
@@ -29,4 +29,3 @@ contains
!$acc update self (a) ! { dg-error "not a variable" }
end subroutine oacc1
end module test
-! { dg-prune-output "unimplemented" }
Grüße,
Thomas
[-- Attachment #2: Type: application/pgp-signature, Size: 472 bytes --]
^ permalink raw reply [flat|nested] 89+ messages in thread
* [gomp4] Testing of C/C++ OpenACC cache directive (was: OpenACC cache directive for C)
2014-11-05 16:29 ` [gomp4] OpenACC cache directive for C Thomas Schwinge
2014-11-05 16:36 ` [gomp4] OpenACC cache directive maintenance (was: [PATCH 4/6] [GOMP4] OpenACC 1.0+ support in fortran front-end) Thomas Schwinge
@ 2014-11-05 16:49 ` Thomas Schwinge
2016-06-02 11:47 ` [PR c/71381] C/C++ OpenACC cache directive rejects valid syntax (was: [gomp4] OpenACC cache directive for C.) Thomas Schwinge
2 siblings, 0 replies; 89+ messages in thread
From: Thomas Schwinge @ 2014-11-05 16:49 UTC (permalink / raw)
To: gcc-patches; +Cc: James Norris
[-- Attachment #1: Type: text/plain, Size: 9492 bytes --]
Hi!
On Wed, 05 Nov 2014 17:29:19 +0100, I wrote:
> In r217145, I applied Jim's patch to gomp-4_0-branch:
> * testsuite/libgomp.oacc-c/cache-1.c: New file.
> * testsuite/libgomp.oacc-c++/cache-1.C: Likewise.
Applied to gomp-4_0-branch in r217147:
commit 267cffc4105255a8372fb5788fdcbb54560f493b
Author: tschwinge <tschwinge@138bc75d-0d04-0410-961f-82ee72b054a4>
Date: Wed Nov 5 16:46:23 2014 +0000
Testing of C/C++ OpenACC cache directive.
gcc/testsuite/
* c-c++-common/goacc/cache-1.c: New file.
libgomp/
* testsuite/libgomp.oacc-c/cache-1.c: Remove directives that are
expected to fail, and rename the file to...
* testsuite/libgomp.oacc-c-c++-common/cache-1.c: ... this.
* testsuite/libgomp.oacc-c++/cache-1.C: Remove file.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/branches/gomp-4_0-branch@217147 138bc75d-0d04-0410-961f-82ee72b054a4
---
gcc/testsuite/ChangeLog.gomp | 2 +
gcc/testsuite/c-c++-common/goacc/cache-1.c | 88 ++++++++++++++++++++++
libgomp/ChangeLog.gomp | 7 ++
libgomp/testsuite/libgomp.oacc-c++/cache-1.C | 50 ------------
.../testsuite/libgomp.oacc-c-c++-common/cache-1.c | 48 ++++++++++++
libgomp/testsuite/libgomp.oacc-c/cache-1.c | 69 -----------------
6 files changed, 145 insertions(+), 119 deletions(-)
diff --git gcc/testsuite/ChangeLog.gomp gcc/testsuite/ChangeLog.gomp
index 25be821..1faf0fa 100644
--- gcc/testsuite/ChangeLog.gomp
+++ gcc/testsuite/ChangeLog.gomp
@@ -1,5 +1,7 @@
2014-11-05 Thomas Schwinge <thomas@codesourcery.com>
+ * c-c++-common/goacc/cache-1.c: New file.
+
* gfortran.dg/goacc/data-tree.f95: Remove dg-prune-output directive.
* gfortran.dg/goacc/kernels-tree.f95: Likewise.
* gfortran.dg/goacc/loop-tree-1.f90: Likewise.
diff --git gcc/testsuite/c-c++-common/goacc/cache-1.c gcc/testsuite/c-c++-common/goacc/cache-1.c
new file mode 100644
index 0000000..9503341
--- /dev/null
+++ gcc/testsuite/c-c++-common/goacc/cache-1.c
@@ -0,0 +1,88 @@
+int
+main (int argc, char **argv)
+{
+#define N 2
+ int a[N], b[N];
+ int i;
+
+ for (i = 0; i < N; i++)
+ {
+ a[i] = 3;
+ b[i] = 0;
+ }
+
+#pragma acc parallel copyin (a[0:N]) copyout (b[0:N])
+{
+ int ii;
+
+ for (ii = 0; ii < N; ii++)
+ {
+ const int idx = ii;
+ int n = 1;
+ const int len = n;
+
+#pragma acc cache /* { dg-error "expected '\\\(' before end of line" } */
+
+#pragma acc cache a[0:N] /* { dg-error "expected '\\\(' before 'a'" } */
+ /* { dg-bogus "expected end of line before 'a'" "" { xfail c++ } 26 } */
+
+#pragma acc cache (a) /* { dg-error "expected '\\\['" } */
+
+#pragma acc cache ( /* { dg-error "expected (identifier|unqualified-id) before end of line" } */
+
+#pragma acc cache () /* { dg-error "expected (identifier|unqualified-id) before '\\\)' token" } */
+
+#pragma acc cache (,) /* { dg-error "expected (identifier|unqualified-id) before '(,|\\\))' token" } */
+
+#pragma acc cache (a[0:N] /* { dg-error "expected '\\\)' before end of line" } */
+
+#pragma acc cache (a[0:N],) /* { dg-error "expected (identifier|unqualified-id) before '(,|\\\))' token" "" { xfail c } } */
+
+#pragma acc cache (a[0:N]) copyin (a[0:N]) /* { dg-error "expected end of line before 'copyin'" } */
+
+#pragma acc cache () /* { dg-error "expected (identifier|unqualified-id) before '\\\)' token" } */
+
+#pragma acc cache (a[0:N] b[0:N]) /* { dg-error "expected '\\\)' before 'b'" } */
+
+#pragma acc cache (a[0:N] b[0:N}) /* { dg-error "expected '\\\)' before 'b'" } */
+ /* { dg-bogus "expected end of line before '\\\}' token" "" { xfail c++ } 47 } */
+
+#pragma acc cache (a[0:N] /* { dg-error "expected '\\\)' before end of line" } */
+
+#pragma acc cache (a[ii]) /* { dg-error "'ii' is not a constant" } */
+
+#pragma acc cache (a[idx:n]) /* { dg-error "'n' is not a constant" } */
+
+#pragma acc cache (a[0:N]) ( /* { dg-error "expected end of line before '\\(' token" } */
+
+#pragma acc cache (a[0:N]) ii /* { dg-error "expected end of line before 'ii'" } */
+
+#pragma acc cache (a[0:N] ii) /* { dg-error "expected '\\)' before 'ii'" } */
+
+#pragma acc cache (a[0:N])
+
+#pragma acc cache (a[0:N], a[0:N])
+
+#pragma acc cache (a[0:N], b[0:N])
+
+#pragma acc cache (a[0])
+
+#pragma acc cache (a[0], a[1], b[0:N])
+
+#pragma acc cache (a[idx])
+
+#pragma acc cache (a[idx:len])
+
+ b[ii] = a[ii];
+ }
+}
+
+
+ for (i = 0; i < N; i++)
+ {
+ if (a[i] != b[i])
+ __builtin_abort ();
+ }
+
+ return 0;
+}
diff --git libgomp/ChangeLog.gomp libgomp/ChangeLog.gomp
index 4ac348d..096a2a9 100644
--- libgomp/ChangeLog.gomp
+++ libgomp/ChangeLog.gomp
@@ -1,3 +1,10 @@
+2014-11-05 Thomas Schwinge <thomas@codesourcery.com>
+
+ * testsuite/libgomp.oacc-c/cache-1.c: Remove directives that are
+ expected to fail, and rename the file to...
+ * testsuite/libgomp.oacc-c-c++-common/cache-1.c: ... this.
+ * testsuite/libgomp.oacc-c++/cache-1.C: Remove file.
+
2014-11-05 James Norris <jnorris@codesourcery.com>
* testsuite/libgomp.oacc-c/cache-1.c: New file.
diff --git libgomp/testsuite/libgomp.oacc-c++/cache-1.C libgomp/testsuite/libgomp.oacc-c++/cache-1.C
deleted file mode 100644
index eb94a68..0000000
--- libgomp/testsuite/libgomp.oacc-c++/cache-1.C
+++ /dev/null
@@ -1,50 +0,0 @@
-/* { dg-do compile } */
-
-#include <stdlib.h>
-
-int
-main (int argc, char **argv)
-{
-#define N 2
- int a[N], b[N];
- int i;
-
- for (i = 0; i < N; i++)
- {
- a[i] = 3;
- b[i] = 0;
- }
-
-#pragma acc parallel copyin (a[0:N]) copyout (b[0:N])
-{
- int ii;
-
- for (ii = 0; ii < N; ii++)
- {
- const int idx = ii;
- int n = 1;
- const int len = n;
-
-#pragma acc cache /* { dg-error "error: expected '\\(' before end of line" } */
-
-#pragma acc cache (a) /* { dg-error "error: expected '\\\['" } */
-
-#pragma acc cache (a[0:N]) copyin (a[0:N]) /* { dg-error "error: expected end of line before 'copyin'" } */
-
-#pragma acc cache () /* { dg-error "error: expected unqualified-id before '\\)' token" } */
-
-#pragma acc cache (a[0:N] b[0:N}) /* { dg-error "error: expected end of line before '\\\}' token|error: expected '\\)' before 'b'" } */
-
- b[ii] = a[ii];
- }
-}
-
-
- for (i = 0; i < N; i++)
- {
- if (a[i] != b[i])
- abort ();
- }
-
- return 0;
-}
diff --git libgomp/testsuite/libgomp.oacc-c-c++-common/cache-1.c libgomp/testsuite/libgomp.oacc-c-c++-common/cache-1.c
new file mode 100644
index 0000000..3f1f0bb
--- /dev/null
+++ libgomp/testsuite/libgomp.oacc-c-c++-common/cache-1.c
@@ -0,0 +1,48 @@
+int
+main (int argc, char **argv)
+{
+#define N 2
+ int a[N], b[N];
+ int i;
+
+ for (i = 0; i < N; i++)
+ {
+ a[i] = 3;
+ b[i] = 0;
+ }
+
+#pragma acc parallel copyin (a[0:N]) copyout (b[0:N])
+{
+ int ii;
+
+ for (ii = 0; ii < N; ii++)
+ {
+ const int idx = ii;
+ int n = 1;
+ const int len = n;
+
+#pragma acc cache (a[0:N])
+
+#pragma acc cache (a[0:N], b[0:N])
+
+#pragma acc cache (a[0])
+
+#pragma acc cache (a[0], a[1], b[0:N])
+
+#pragma acc cache (a[idx])
+
+#pragma acc cache (a[idx:len])
+
+ b[ii] = a[ii];
+ }
+}
+
+
+ for (i = 0; i < N; i++)
+ {
+ if (a[i] != b[i])
+ __builtin_abort ();
+ }
+
+ return 0;
+}
diff --git libgomp/testsuite/libgomp.oacc-c/cache-1.c libgomp/testsuite/libgomp.oacc-c/cache-1.c
deleted file mode 100644
index 5473475..0000000
--- libgomp/testsuite/libgomp.oacc-c/cache-1.c
+++ /dev/null
@@ -1,69 +0,0 @@
-/* { dg-do compile } */
-
-#include <openacc.h>
-#include <stdlib.h>
-
-int
-main (int argc, char **argv)
-{
-#define N 2
- int a[N], b[N];
- int i;
-
- for (i = 0; i < N; i++)
- {
- a[i] = 3;
- b[i] = 0;
- }
-
-#pragma acc parallel copyin (a[0:N]) copyout (b[0:N])
-{
- int ii;
-
- for (ii = 0; ii < N; ii++)
- {
- const int idx = ii;
- int n = 1;
- const int len = n;
-
-#pragma acc cache /* { dg-error "error: expected '\\(' before end of line" } */
-
-#pragma acc cache (a) /* { dg-error "error: expected '\\\[' before '\\)' token" } */
-
-#pragma acc cache (a[0:N]) copyin (a[0:N]) /* { dg-error "error: expected end of line before 'copyin'" } */
-
-#pragma acc cache () /* { dg-error "error: expected identifier before '\\)' token" } */
-
-#pragma acc cache (a[0:N] b[0:N}) /* { dg-error "error: expected '\\)' before 'b'" } */
-
-#pragma acc cache (a[0:N] /* { dg-error "error: expected '\\)' before end of line" } */
-
-#pragma acc cache (a[ii]) /* { dg-error "error: 'ii' is not a constant" } */
-
-#pragma acc cache (a[idx:n]) /* { dg-error "error: 'n' is not a constant" } */
-
-#pragma acc cache (a[0:N])
-
-#pragma acc cache (a[0:N], b[0:N])
-
-#pragma acc cache (a[0])
-
-#pragma acc cache (a[0], a[1], b[0:N])
-
-#pragma acc cache (a[idx])
-
-#pragma acc cache (a[idx:len])
-
- b[ii] = a[ii];
- }
-}
-
-
- for (i = 0; i < N; i++)
- {
- if (a[i] != b[i])
- abort ();
- }
-
- return 0;
-}
Grüße,
Thomas
[-- Attachment #2: Type: application/pgp-signature, Size: 472 bytes --]
^ permalink raw reply [flat|nested] 89+ messages in thread
* [PR fortran/63865] OpenACC cache directive: match Fortran support with C/C++ (was: [gomp4] OpenACC cache directive maintenance)
2014-11-05 16:45 ` [gomp4] OpenACC cache directive maintenance Thomas Schwinge
@ 2015-10-27 15:26 ` Thomas Schwinge
2015-10-27 15:30 ` Jakub Jelinek
0 siblings, 1 reply; 89+ messages in thread
From: Thomas Schwinge @ 2015-10-27 15:26 UTC (permalink / raw)
To: fortran, gcc-patches, Jakub Jelinek
Cc: Cesar Philippidis, James Norris, burnus
[-- Attachment #1: Type: text/plain, Size: 8665 bytes --]
Hi!
On Wed, 05 Nov 2014 17:44:58 +0100, I wrote:
> On Wed, 05 Nov 2014 17:36:46 +0100, I wrote:
> > In r217146, I applied the following to gomp-4_0-branch:
> >
> > [OpenACC cache directive maintenance in C/C++]
> I also tried to make this work for Fortran, but didn't manage to (in
> a reasonable amount of time, which has not been a lot that I allocated)
> ;-) -- would you please have a look at this (but it's not urgent).
>
> [WIP patch]
That never got resolved, so I've now done it myself, directly for trunk.
OK to commit?
commit 1e0a6332eb8b713afaeb43b554d4aae501a78bf9
Author: Thomas Schwinge <thomas@codesourcery.com>
Date: Tue Oct 27 12:20:12 2015 +0100
[PR fortran/63865] OpenACC cache directive: match Fortran support with C/C++
gcc/fortran/
PR fortran/63865
* openmp.c (resolve_oacc_cache): Remove function.
(gfc_match_oacc_cache): Enable array sections.
(resolve_omp_clauses, gfc_resolve_oacc_directive): Change
accordingly.
* trans-openmp.c (gfc_trans_omp_clauses): Likewise.
gcc/testsuite/
PR fortran/63865
* gfortran.dg/goacc/coarray.f95: Expect the OpenACC cache
directive to work.
* gfortran.dg/goacc/loop-1.f95: Likewise.
* gfortran.dg/goacc/cache-1.f95: Likewise, and extend testing.
* gfortran.dg/goacc/cray.f95: Likewise.
* gfortran.dg/goacc/parameter.f95: Likewise.
---
gcc/fortran/openmp.c | 16 ++++------------
gcc/fortran/trans-openmp.c | 22 ++++++++++++++++------
gcc/testsuite/gfortran.dg/goacc/cache-1.f95 | 9 +++++++--
gcc/testsuite/gfortran.dg/goacc/coarray.f95 | 3 ++-
gcc/testsuite/gfortran.dg/goacc/cray.f95 | 4 +---
gcc/testsuite/gfortran.dg/goacc/loop-1.f95 | 1 -
gcc/testsuite/gfortran.dg/goacc/parameter.f95 | 3 +--
7 files changed, 31 insertions(+), 27 deletions(-)
diff --git gcc/fortran/openmp.c gcc/fortran/openmp.c
index 3c12d8e..6c78c97 100644
--- gcc/fortran/openmp.c
+++ gcc/fortran/openmp.c
@@ -1387,7 +1387,8 @@ gfc_match_oacc_cache (void)
{
gfc_omp_clauses *c = gfc_get_omp_clauses ();
match m = gfc_match_omp_variable_list (" (",
- &c->lists[OMP_LIST_CACHE], true);
+ &c->lists[OMP_LIST_CACHE], true,
+ NULL, NULL, true);
if (m != MATCH_YES)
{
gfc_free_omp_clauses(c);
@@ -3107,6 +3108,7 @@ resolve_omp_clauses (gfc_code *code, locus *where,
case OMP_LIST_MAP:
case OMP_LIST_TO:
case OMP_LIST_FROM:
+ case OMP_LIST_CACHE:
for (; n != NULL; n = n->next)
{
if (n->expr)
@@ -3380,7 +3382,6 @@ resolve_omp_clauses (gfc_code *code, locus *where,
n->sym->name, name, where);
/* FALLTHRU */
case OMP_LIST_DEVICE_RESIDENT:
- case OMP_LIST_CACHE:
check_symbol_not_pointer (n->sym, *where, name);
check_array_not_assumed (n->sym, *where, name);
break;
@@ -4597,13 +4598,6 @@ resolve_oacc_loop (gfc_code *code)
}
-static void
-resolve_oacc_cache (gfc_code *code ATTRIBUTE_UNUSED)
-{
- sorry ("Sorry, !$ACC cache unimplemented yet");
-}
-
-
void
gfc_resolve_oacc_declare (gfc_namespace *ns)
{
@@ -4657,6 +4651,7 @@ gfc_resolve_oacc_directive (gfc_code *code, gfc_namespace *ns ATTRIBUTE_UNUSED)
case EXEC_OACC_ENTER_DATA:
case EXEC_OACC_EXIT_DATA:
case EXEC_OACC_WAIT:
+ case EXEC_OACC_CACHE:
resolve_omp_clauses (code, &code->loc, code->ext.omp_clauses, NULL,
true);
break;
@@ -4665,9 +4660,6 @@ gfc_resolve_oacc_directive (gfc_code *code, gfc_namespace *ns ATTRIBUTE_UNUSED)
case EXEC_OACC_LOOP:
resolve_oacc_loop (code);
break;
- case EXEC_OACC_CACHE:
- resolve_oacc_cache (code);
- break;
default:
break;
}
diff --git gcc/fortran/trans-openmp.c gcc/fortran/trans-openmp.c
index def8afb..3be9f51 100644
--- gcc/fortran/trans-openmp.c
+++ gcc/fortran/trans-openmp.c
@@ -1778,9 +1778,6 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
case OMP_LIST_DEVICE_RESIDENT:
clause_code = OMP_CLAUSE_DEVICE_RESIDENT;
goto add_clause;
- case OMP_LIST_CACHE:
- clause_code = OMP_CLAUSE__CACHE_;
- goto add_clause;
add_clause:
omp_clauses
@@ -2159,14 +2156,27 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
break;
case OMP_LIST_TO:
case OMP_LIST_FROM:
+ case OMP_LIST_CACHE:
for (; n != NULL; n = n->next)
{
if (!n->sym->attr.referenced)
continue;
- tree node = build_omp_clause (input_location,
- list == OMP_LIST_TO
- ? OMP_CLAUSE_TO : OMP_CLAUSE_FROM);
+ switch (list)
+ {
+ case OMP_LIST_TO:
+ clause_code = OMP_CLAUSE_TO;
+ break;
+ case OMP_LIST_FROM:
+ clause_code = OMP_CLAUSE_FROM;
+ break;
+ case OMP_LIST_CACHE:
+ clause_code = OMP_CLAUSE__CACHE_;
+ break;
+ default:
+ gcc_unreachable ();
+ }
+ tree node = build_omp_clause (input_location, clause_code);
if (n->expr == NULL || n->expr->ref->u.ar.type == AR_FULL)
{
tree decl = gfc_get_symbol_decl (n->sym);
diff --git gcc/testsuite/gfortran.dg/goacc/cache-1.f95 gcc/testsuite/gfortran.dg/goacc/cache-1.f95
index 746cf02..2aa9e05 100644
--- gcc/testsuite/gfortran.dg/goacc/cache-1.f95
+++ gcc/testsuite/gfortran.dg/goacc/cache-1.f95
@@ -3,10 +3,15 @@
program test
implicit none
- integer :: i, d(10)
+ integer :: i, d(10), e(5,13)
do concurrent (i=1:5)
!$acc cache (d)
+ !$acc cache (d(1:3))
+ !$acc cache (d(i:i+2))
+
+ !$acc cache (e)
+ !$acc cache (e(1:3,2:4))
+ !$acc cache (e(i:i+2,i+1:i+3))
enddo
end
-! { dg-prune-output "unimplemented" }
diff --git gcc/testsuite/gfortran.dg/goacc/coarray.f95 gcc/testsuite/gfortran.dg/goacc/coarray.f95
index 4f1224e..130ffc3 100644
--- gcc/testsuite/gfortran.dg/goacc/coarray.f95
+++ gcc/testsuite/gfortran.dg/goacc/coarray.f95
@@ -9,6 +9,7 @@ contains
implicit none
integer :: i
integer, codimension[*] :: a
+ ! { dg-excess-errors "sorry, unimplemented: directive not yet implemented" }
!$acc declare device_resident (a)
!$acc data copy (a)
!$acc end data
@@ -16,6 +17,7 @@ contains
!$acc end data
!$acc parallel private (a)
!$acc end parallel
+ ! { dg-excess-errors "sorry, unimplemented: directive not yet implemented" }
!$acc host_data use_device (a)
!$acc end host_data
!$acc parallel loop reduction(+:a)
@@ -32,4 +34,3 @@ contains
!$acc update self (a)
end subroutine oacc1
end module test
-! { dg-prune-output "ACC cache unimplemented" }
diff --git gcc/testsuite/gfortran.dg/goacc/cray.f95 gcc/testsuite/gfortran.dg/goacc/cray.f95
index 52789fe..a35ab0d 100644
--- gcc/testsuite/gfortran.dg/goacc/cray.f95
+++ gcc/testsuite/gfortran.dg/goacc/cray.f95
@@ -24,8 +24,7 @@ contains
!$acc end parallel loop
!$acc parallel loop
do i = 1,5
- ! Subarrays are not implemented yet
- !$acc cache (pointee) ! TODO: This must fail, as in openacc-1_0-branch
+ !$acc cache (pointee) ! { dg-error "Cray pointee" }
enddo
!$acc end parallel loop
!$acc update device (pointee) ! { dg-error "Cray pointee" }
@@ -53,4 +52,3 @@ contains
!$acc update self (ptr)
end subroutine oacc1
end module test
-! { dg-prune-output "ACC cache unimplemented" }
diff --git gcc/testsuite/gfortran.dg/goacc/loop-1.f95 gcc/testsuite/gfortran.dg/goacc/loop-1.f95
index e1b2dfd..817039f 100644
--- gcc/testsuite/gfortran.dg/goacc/loop-1.f95
+++ gcc/testsuite/gfortran.dg/goacc/loop-1.f95
@@ -168,4 +168,3 @@ subroutine test1
end subroutine test1
end module test
! { dg-prune-output "Deleted" }
-! { dg-prune-output "ACC cache unimplemented" }
diff --git gcc/testsuite/gfortran.dg/goacc/parameter.f95 gcc/testsuite/gfortran.dg/goacc/parameter.f95
index 454924a..8427461 100644
--- gcc/testsuite/gfortran.dg/goacc/parameter.f95
+++ gcc/testsuite/gfortran.dg/goacc/parameter.f95
@@ -21,7 +21,7 @@ contains
!$acc end parallel loop
!$acc parallel loop
do i = 1,5
- !$acc cache (a) ! TODO: This must fail, as in openacc-1_0-branch
+ !$acc cache (a) ! { dg-error "not a variable" }
enddo
!$acc end parallel loop
!$acc update device (a) ! { dg-error "not a variable" }
@@ -29,4 +29,3 @@ contains
!$acc update self (a) ! { dg-error "not a variable" }
end subroutine oacc1
end module test
-! { dg-prune-output "ACC cache unimplemented" }
Grüße
Thomas
[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 472 bytes --]
^ permalink raw reply [flat|nested] 89+ messages in thread
* Re: [PR fortran/63865] OpenACC cache directive: match Fortran support with C/C++ (was: [gomp4] OpenACC cache directive maintenance)
2015-10-27 15:26 ` [PR fortran/63865] OpenACC cache directive: match Fortran support with C/C++ (was: [gomp4] OpenACC cache directive maintenance) Thomas Schwinge
@ 2015-10-27 15:30 ` Jakub Jelinek
2015-10-27 17:03 ` [PR fortran/63865] OpenACC cache directive: match Fortran support with C/C++ Thomas Schwinge
0 siblings, 1 reply; 89+ messages in thread
From: Jakub Jelinek @ 2015-10-27 15:30 UTC (permalink / raw)
To: Thomas Schwinge
Cc: fortran, gcc-patches, Cesar Philippidis, James Norris, burnus
On Tue, Oct 27, 2015 at 04:19:49PM +0100, Thomas Schwinge wrote:
> On Wed, 05 Nov 2014 17:44:58 +0100, I wrote:
> > On Wed, 05 Nov 2014 17:36:46 +0100, I wrote:
> > > In r217146, I applied the following to gomp-4_0-branch:
> > >
> > > [OpenACC cache directive maintenance in C/C++]
>
> > I also tried to make this work for Fortran, but didn't manage to (in
> > a reasonable amount of time, which has not been a lot that I allocated)
> > ;-) -- would you please have a look at this (but it's not urgent).
> >
> > [WIP patch]
>
> That never got resolved, so I've now done it myself, directly for trunk.
> OK to commit?
Ok.
Jakub
^ permalink raw reply [flat|nested] 89+ messages in thread
* Re: [PR fortran/63865] OpenACC cache directive: match Fortran support with C/C++
2015-10-27 15:30 ` Jakub Jelinek
@ 2015-10-27 17:03 ` Thomas Schwinge
0 siblings, 0 replies; 89+ messages in thread
From: Thomas Schwinge @ 2015-10-27 17:03 UTC (permalink / raw)
To: Jakub Jelinek, fortran, gcc-patches
Cc: Cesar Philippidis, James Norris, burnus
[-- Attachment #1: Type: text/plain, Size: 10438 bytes --]
Hi!
On Tue, 27 Oct 2015 16:26:54 +0100, Jakub Jelinek <jakub@redhat.com> wrote:
> On Tue, Oct 27, 2015 at 04:19:49PM +0100, Thomas Schwinge wrote:
> > On Wed, 05 Nov 2014 17:44:58 +0100, I wrote:
> > > On Wed, 05 Nov 2014 17:36:46 +0100, I wrote:
> > > > In r217146, I applied the following to gomp-4_0-branch:
> > > >
> > > > [OpenACC cache directive maintenance in C/C++]
> >
> > > I also tried to make this work for Fortran, but didn't manage to (in
> > > a reasonable amount of time, which has not been a lot that I allocated)
> > > ;-) -- would you please have a look at this (but it's not urgent).
> > >
> > > [WIP patch]
> >
> > That never got resolved, so I've now done it myself, directly for trunk.
> > OK to commit?
>
> Ok.
Thanks for the speedy review, committed in r229448:
commit 09382f4e948e567fd47a518eeb5484d848898753
Author: tschwinge <tschwinge@138bc75d-0d04-0410-961f-82ee72b054a4>
Date: Tue Oct 27 16:54:52 2015 +0000
[PR fortran/63865] OpenACC cache directive: match Fortran support with C/C++
gcc/fortran/
PR fortran/63865
* openmp.c (resolve_oacc_cache): Remove function.
(gfc_match_oacc_cache): Enable array sections.
(resolve_omp_clauses, gfc_resolve_oacc_directive): Change
accordingly.
* trans-openmp.c (gfc_trans_omp_clauses): Likewise.
gcc/testsuite/
PR fortran/63865
* gfortran.dg/goacc/coarray.f95: Expect the OpenACC cache
directive to work.
* gfortran.dg/goacc/loop-1.f95: Likewise.
* gfortran.dg/goacc/cache-1.f95: Likewise, and extend testing.
* gfortran.dg/goacc/cray.f95: Likewise.
* gfortran.dg/goacc/parameter.f95: Likewise.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@229448 138bc75d-0d04-0410-961f-82ee72b054a4
---
gcc/fortran/ChangeLog | 10 ++++++++++
gcc/fortran/openmp.c | 16 ++++------------
gcc/fortran/trans-openmp.c | 22 ++++++++++++++++------
gcc/testsuite/ChangeLog | 11 +++++++++++
gcc/testsuite/gfortran.dg/goacc/cache-1.f95 | 9 +++++++--
gcc/testsuite/gfortran.dg/goacc/coarray.f95 | 3 ++-
gcc/testsuite/gfortran.dg/goacc/cray.f95 | 4 +---
gcc/testsuite/gfortran.dg/goacc/loop-1.f95 | 1 -
gcc/testsuite/gfortran.dg/goacc/parameter.f95 | 3 +--
9 files changed, 52 insertions(+), 27 deletions(-)
diff --git gcc/fortran/ChangeLog gcc/fortran/ChangeLog
index 37956ce..02564ce 100644
--- gcc/fortran/ChangeLog
+++ gcc/fortran/ChangeLog
@@ -1,3 +1,13 @@
+2015-10-27 Thomas Schwinge <thomas@codesourcery.com>
+ James Norris <jnorris@codesourcery.com>
+
+ PR fortran/63865
+ * openmp.c (resolve_oacc_cache): Remove function.
+ (gfc_match_oacc_cache): Enable array sections.
+ (resolve_omp_clauses, gfc_resolve_oacc_directive): Change
+ accordingly.
+ * trans-openmp.c (gfc_trans_omp_clauses): Likewise.
+
2015-10-27 Steven G. Kargl <kargl@gcc.gnu.org>
PR fortran/68108
diff --git gcc/fortran/openmp.c gcc/fortran/openmp.c
index 3c12d8e..6c78c97 100644
--- gcc/fortran/openmp.c
+++ gcc/fortran/openmp.c
@@ -1387,7 +1387,8 @@ gfc_match_oacc_cache (void)
{
gfc_omp_clauses *c = gfc_get_omp_clauses ();
match m = gfc_match_omp_variable_list (" (",
- &c->lists[OMP_LIST_CACHE], true);
+ &c->lists[OMP_LIST_CACHE], true,
+ NULL, NULL, true);
if (m != MATCH_YES)
{
gfc_free_omp_clauses(c);
@@ -3107,6 +3108,7 @@ resolve_omp_clauses (gfc_code *code, locus *where,
case OMP_LIST_MAP:
case OMP_LIST_TO:
case OMP_LIST_FROM:
+ case OMP_LIST_CACHE:
for (; n != NULL; n = n->next)
{
if (n->expr)
@@ -3380,7 +3382,6 @@ resolve_omp_clauses (gfc_code *code, locus *where,
n->sym->name, name, where);
/* FALLTHRU */
case OMP_LIST_DEVICE_RESIDENT:
- case OMP_LIST_CACHE:
check_symbol_not_pointer (n->sym, *where, name);
check_array_not_assumed (n->sym, *where, name);
break;
@@ -4597,13 +4598,6 @@ resolve_oacc_loop (gfc_code *code)
}
-static void
-resolve_oacc_cache (gfc_code *code ATTRIBUTE_UNUSED)
-{
- sorry ("Sorry, !$ACC cache unimplemented yet");
-}
-
-
void
gfc_resolve_oacc_declare (gfc_namespace *ns)
{
@@ -4657,6 +4651,7 @@ gfc_resolve_oacc_directive (gfc_code *code, gfc_namespace *ns ATTRIBUTE_UNUSED)
case EXEC_OACC_ENTER_DATA:
case EXEC_OACC_EXIT_DATA:
case EXEC_OACC_WAIT:
+ case EXEC_OACC_CACHE:
resolve_omp_clauses (code, &code->loc, code->ext.omp_clauses, NULL,
true);
break;
@@ -4665,9 +4660,6 @@ gfc_resolve_oacc_directive (gfc_code *code, gfc_namespace *ns ATTRIBUTE_UNUSED)
case EXEC_OACC_LOOP:
resolve_oacc_loop (code);
break;
- case EXEC_OACC_CACHE:
- resolve_oacc_cache (code);
- break;
default:
break;
}
diff --git gcc/fortran/trans-openmp.c gcc/fortran/trans-openmp.c
index def8afb..3be9f51 100644
--- gcc/fortran/trans-openmp.c
+++ gcc/fortran/trans-openmp.c
@@ -1778,9 +1778,6 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
case OMP_LIST_DEVICE_RESIDENT:
clause_code = OMP_CLAUSE_DEVICE_RESIDENT;
goto add_clause;
- case OMP_LIST_CACHE:
- clause_code = OMP_CLAUSE__CACHE_;
- goto add_clause;
add_clause:
omp_clauses
@@ -2159,14 +2156,27 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
break;
case OMP_LIST_TO:
case OMP_LIST_FROM:
+ case OMP_LIST_CACHE:
for (; n != NULL; n = n->next)
{
if (!n->sym->attr.referenced)
continue;
- tree node = build_omp_clause (input_location,
- list == OMP_LIST_TO
- ? OMP_CLAUSE_TO : OMP_CLAUSE_FROM);
+ switch (list)
+ {
+ case OMP_LIST_TO:
+ clause_code = OMP_CLAUSE_TO;
+ break;
+ case OMP_LIST_FROM:
+ clause_code = OMP_CLAUSE_FROM;
+ break;
+ case OMP_LIST_CACHE:
+ clause_code = OMP_CLAUSE__CACHE_;
+ break;
+ default:
+ gcc_unreachable ();
+ }
+ tree node = build_omp_clause (input_location, clause_code);
if (n->expr == NULL || n->expr->ref->u.ar.type == AR_FULL)
{
tree decl = gfc_get_symbol_decl (n->sym);
diff --git gcc/testsuite/ChangeLog gcc/testsuite/ChangeLog
index ab53bc1..1185917 100644
--- gcc/testsuite/ChangeLog
+++ gcc/testsuite/ChangeLog
@@ -1,3 +1,14 @@
+2015-10-27 Thomas Schwinge <thomas@codesourcery.com>
+ James Norris <jnorris@codesourcery.com>
+
+ PR fortran/63865
+ * gfortran.dg/goacc/coarray.f95: Expect the OpenACC cache
+ directive to work.
+ * gfortran.dg/goacc/loop-1.f95: Likewise.
+ * gfortran.dg/goacc/cache-1.f95: Likewise, and extend testing.
+ * gfortran.dg/goacc/cray.f95: Likewise.
+ * gfortran.dg/goacc/parameter.f95: Likewise.
+
2015-10-27 Steven G. Kargl <kargl@gcc.gnu.org>
PR fortran/68108
diff --git gcc/testsuite/gfortran.dg/goacc/cache-1.f95 gcc/testsuite/gfortran.dg/goacc/cache-1.f95
index 746cf02..2aa9e05 100644
--- gcc/testsuite/gfortran.dg/goacc/cache-1.f95
+++ gcc/testsuite/gfortran.dg/goacc/cache-1.f95
@@ -3,10 +3,15 @@
program test
implicit none
- integer :: i, d(10)
+ integer :: i, d(10), e(5,13)
do concurrent (i=1:5)
!$acc cache (d)
+ !$acc cache (d(1:3))
+ !$acc cache (d(i:i+2))
+
+ !$acc cache (e)
+ !$acc cache (e(1:3,2:4))
+ !$acc cache (e(i:i+2,i+1:i+3))
enddo
end
-! { dg-prune-output "unimplemented" }
diff --git gcc/testsuite/gfortran.dg/goacc/coarray.f95 gcc/testsuite/gfortran.dg/goacc/coarray.f95
index 4f1224e..130ffc3 100644
--- gcc/testsuite/gfortran.dg/goacc/coarray.f95
+++ gcc/testsuite/gfortran.dg/goacc/coarray.f95
@@ -9,6 +9,7 @@ contains
implicit none
integer :: i
integer, codimension[*] :: a
+ ! { dg-excess-errors "sorry, unimplemented: directive not yet implemented" }
!$acc declare device_resident (a)
!$acc data copy (a)
!$acc end data
@@ -16,6 +17,7 @@ contains
!$acc end data
!$acc parallel private (a)
!$acc end parallel
+ ! { dg-excess-errors "sorry, unimplemented: directive not yet implemented" }
!$acc host_data use_device (a)
!$acc end host_data
!$acc parallel loop reduction(+:a)
@@ -32,4 +34,3 @@ contains
!$acc update self (a)
end subroutine oacc1
end module test
-! { dg-prune-output "ACC cache unimplemented" }
diff --git gcc/testsuite/gfortran.dg/goacc/cray.f95 gcc/testsuite/gfortran.dg/goacc/cray.f95
index 52789fe..a35ab0d 100644
--- gcc/testsuite/gfortran.dg/goacc/cray.f95
+++ gcc/testsuite/gfortran.dg/goacc/cray.f95
@@ -24,8 +24,7 @@ contains
!$acc end parallel loop
!$acc parallel loop
do i = 1,5
- ! Subarrays are not implemented yet
- !$acc cache (pointee) ! TODO: This must fail, as in openacc-1_0-branch
+ !$acc cache (pointee) ! { dg-error "Cray pointee" }
enddo
!$acc end parallel loop
!$acc update device (pointee) ! { dg-error "Cray pointee" }
@@ -53,4 +52,3 @@ contains
!$acc update self (ptr)
end subroutine oacc1
end module test
-! { dg-prune-output "ACC cache unimplemented" }
diff --git gcc/testsuite/gfortran.dg/goacc/loop-1.f95 gcc/testsuite/gfortran.dg/goacc/loop-1.f95
index e1b2dfd..817039f 100644
--- gcc/testsuite/gfortran.dg/goacc/loop-1.f95
+++ gcc/testsuite/gfortran.dg/goacc/loop-1.f95
@@ -168,4 +168,3 @@ subroutine test1
end subroutine test1
end module test
! { dg-prune-output "Deleted" }
-! { dg-prune-output "ACC cache unimplemented" }
diff --git gcc/testsuite/gfortran.dg/goacc/parameter.f95 gcc/testsuite/gfortran.dg/goacc/parameter.f95
index 454924a..8427461 100644
--- gcc/testsuite/gfortran.dg/goacc/parameter.f95
+++ gcc/testsuite/gfortran.dg/goacc/parameter.f95
@@ -21,7 +21,7 @@ contains
!$acc end parallel loop
!$acc parallel loop
do i = 1,5
- !$acc cache (a) ! TODO: This must fail, as in openacc-1_0-branch
+ !$acc cache (a) ! { dg-error "not a variable" }
enddo
!$acc end parallel loop
!$acc update device (a) ! { dg-error "not a variable" }
@@ -29,4 +29,3 @@ contains
!$acc update self (a) ! { dg-error "not a variable" }
end subroutine oacc1
end module test
-! { dg-prune-output "ACC cache unimplemented" }
Grüße
Thomas
[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 472 bytes --]
^ permalink raw reply [flat|nested] 89+ messages in thread
* [PR c/71381] C/C++ OpenACC cache directive rejects valid syntax (was: [gomp4] OpenACC cache directive for C.)
2014-11-05 16:29 ` [gomp4] OpenACC cache directive for C Thomas Schwinge
2014-11-05 16:36 ` [gomp4] OpenACC cache directive maintenance (was: [PATCH 4/6] [GOMP4] OpenACC 1.0+ support in fortran front-end) Thomas Schwinge
2014-11-05 16:49 ` [gomp4] Testing of C/C++ OpenACC cache directive (was: OpenACC cache directive for C) Thomas Schwinge
@ 2016-06-02 11:47 ` Thomas Schwinge
2016-06-08 13:29 ` [PING] [PR c/71381] C/C++ OpenACC cache directive rejects valid syntax Thomas Schwinge
2 siblings, 1 reply; 89+ messages in thread
From: Thomas Schwinge @ 2016-06-02 11:47 UTC (permalink / raw)
To: gcc-patches, Jakub Jelinek; +Cc: James Norris
[-- Attachment #1: Type: text/plain, Size: 19582 bytes --]
Hi!
On Wed, 05 Nov 2014 17:29:19 +0100, I wrote:
> In r217145, I applied Jim's patch to gomp-4_0-branch:
>
> commit 4361f9b6b2c74c2961c3a5290a4945abe2d7a444
> Author: tschwinge <tschwinge@138bc75d-0d04-0410-961f-82ee72b054a4>
> Date: Wed Nov 5 16:26:47 2014 +0000
>
> OpenACC cache directive for C.
(That, and the corresponding C++ changes later made it into trunk.)
> --- gcc/c/c-parser.c
> +++ gcc/c/c-parser.c
> @@ -10053,6 +10053,14 @@ c_parser_omp_variable_list (c_parser *parser,
> {
> switch (kind)
> {
> + case OMP_NO_CLAUSE_CACHE:
> + if (c_parser_peek_token (parser)->type != CPP_OPEN_SQUARE)
> + {
> + c_parser_error (parser, "expected %<[%>");
> + t = error_mark_node;
> + break;
> + }
> + /* FALL THROUGH. */
> case OMP_CLAUSE_MAP:
> case OMP_CLAUSE_FROM:
> case OMP_CLAUSE_TO:
Strictly speaking (OpenACC 2.0a specification), that is correct: the
OpenACC cache directive explicitly only allows "array elements or
subarrays". However, I wonder if it would make sense to allow complete
arrays as a GNU extension? That is, syntactic sugar to allow "cache (a)"
to mean "cache (a[0:LENGTH])"?
> @@ -10091,6 +10099,29 @@ c_parser_omp_variable_list (c_parser *parser,
> t = error_mark_node;
> break;
> }
> +
> + if (kind == OMP_NO_CLAUSE_CACHE)
> + {
> + mark_exp_read (low_bound);
> + mark_exp_read (length);
> +
> + if (TREE_CODE (low_bound) != INTEGER_CST
> + && !TREE_READONLY (low_bound))
> + {
> + error_at (clause_loc,
> + "%qD is not a constant", low_bound);
> + t = error_mark_node;
> + }
WHile OpenACC 2.0a specifies that "the lower bound is a constant", it
also permits the lower bound to be a "loop invariant, or the for loop
index variable plus or minus a constant or loop invariant". So, we're
rejecting valid syntax here.
> +
> + if (TREE_CODE (length) != INTEGER_CST
> + && !TREE_READONLY (length))
> + {
> + error_at (clause_loc,
> + "%qD is not a constant", length);
> + t = error_mark_node;
> + }
> + }
The idea is correct (OpenACC 2.0a: "the length is a constant"), but we
can't reliably check that here; for example:
#pragma acc cache (a[0:n + 1])
... will run into an ICE, "tree check: expected tree that contains 'decl
minimal' structure, have 'plus_expr' in [...]".
Currently we're discarding the OpenACC cache directive in the middle end;
I expect checking of the lower bound and length will come automatically
as soon as we start to do something with OACC_CACHE/OMP_CLAUSE__CACHE_.
Until then, I propose we simple remove these checks from the front ends.
OK for trunk and gcc-6-branch?
commit a620ebe6fa509ec6441ba87276e55078eb2d00fc
Author: Thomas Schwinge <thomas@codesourcery.com>
Date: Thu Jun 2 12:19:49 2016 +0200
[PR c/71381] C/C++ OpenACC cache directive rejects valid syntax
gcc/c/
PR c/71381
* c-parser.c (c_parser_omp_variable_list) <OMP_CLAUSE__CACHE_>:
Loosen checking.
gcc/cp/
PR c/71381
* parser.c (cp_parser_omp_var_list_no_open) <OMP_CLAUSE__CACHE_>:
Loosen checking.
gcc/fortran/
PR c/71381
* openmp.c (gfc_match_oacc_cache): Add comment.
gcc/testsuite/
PR c/71381
* c-c++-common/goacc/cache-1.c: Update. Move invalid usage tests
to...
* c-c++-common/goacc/cache-2.c: ... this new file.
* gfortran.dg/goacc/cache-1.f95: Move invalid usage tests to...
* gfortran.dg/goacc/cache-2.f95: ... this new file.
* gfortran.dg/goacc/coarray.f95: Update OpenACC cache directive
usage.
* gfortran.dg/goacc/cray.f95: Likewise.
* gfortran.dg/goacc/loop-1.f95: Likewise.
libgomp/
PR c/71381
* testsuite/libgomp.oacc-c-c++-common/cache-1.c: #include
"../../../gcc/testsuite/c-c++-common/goacc/cache-1.c".
* testsuite/libgomp.oacc-fortran/cache-1.f95: New file.
gcc/
* omp-low.c (scan_sharing_clauses): Don't expect
OMP_CLAUSE__CACHE_.
---
gcc/c/c-parser.c | 22 +-------
gcc/cp/parser.c | 22 +-------
gcc/fortran/openmp.c | 5 ++
gcc/omp-low.c | 6 --
gcc/testsuite/c-c++-common/goacc/cache-1.c | 66 ++++++++--------------
.../c-c++-common/goacc/{cache-1.c => cache-2.c} | 39 ++-----------
gcc/testsuite/gfortran.dg/goacc/cache-1.f95 | 7 +--
gcc/testsuite/gfortran.dg/goacc/cache-2.f95 | 12 ++++
gcc/testsuite/gfortran.dg/goacc/coarray.f95 | 2 +-
gcc/testsuite/gfortran.dg/goacc/cray.f95 | 3 +-
gcc/testsuite/gfortran.dg/goacc/loop-1.f95 | 7 ++-
.../testsuite/libgomp.oacc-c-c++-common/cache-1.c | 49 +---------------
libgomp/testsuite/libgomp.oacc-fortran/cache-1.f95 | 5 ++
13 files changed, 66 insertions(+), 179 deletions(-)
diff --git gcc/c/c-parser.c gcc/c/c-parser.c
index bca8653..1db1886 100644
--- gcc/c/c-parser.c
+++ gcc/c/c-parser.c
@@ -10601,6 +10601,9 @@ c_parser_omp_variable_list (c_parser *parser,
switch (kind)
{
case OMP_CLAUSE__CACHE_:
+ /* The OpenACC cache directive explicitly only allows "array
+ elements or subarrays". Would it make sense to allow complete
+ arrays as a GNU extension? */
if (c_parser_peek_token (parser)->type != CPP_OPEN_SQUARE)
{
c_parser_error (parser, "expected %<[%>");
@@ -10663,25 +10666,6 @@ c_parser_omp_variable_list (c_parser *parser,
break;
}
- if (kind == OMP_CLAUSE__CACHE_)
- {
- if (TREE_CODE (low_bound) != INTEGER_CST
- && !TREE_READONLY (low_bound))
- {
- error_at (clause_loc,
- "%qD is not a constant", low_bound);
- t = error_mark_node;
- }
-
- if (TREE_CODE (length) != INTEGER_CST
- && !TREE_READONLY (length))
- {
- error_at (clause_loc,
- "%qD is not a constant", length);
- t = error_mark_node;
- }
- }
-
t = tree_cons (low_bound, length, t);
}
break;
diff --git gcc/cp/parser.c gcc/cp/parser.c
index 29a1b80..826277d 100644
--- gcc/cp/parser.c
+++ gcc/cp/parser.c
@@ -29984,6 +29984,9 @@ cp_parser_omp_var_list_no_open (cp_parser *parser, enum omp_clause_code kind,
switch (kind)
{
case OMP_CLAUSE__CACHE_:
+ /* The OpenACC cache directive explicitly only allows "array
+ elements or subarrays". Would it make sense to allow complete
+ arrays as a GNU extension? */
if (cp_lexer_peek_token (parser->lexer)->type != CPP_OPEN_SQUARE)
{
error_at (token->location, "expected %<[%>");
@@ -30035,25 +30038,6 @@ cp_parser_omp_var_list_no_open (cp_parser *parser, enum omp_clause_code kind,
RT_CLOSE_SQUARE))
goto skip_comma;
- if (kind == OMP_CLAUSE__CACHE_)
- {
- if (TREE_CODE (low_bound) != INTEGER_CST
- && !TREE_READONLY (low_bound))
- {
- error_at (token->location,
- "%qD is not a constant", low_bound);
- decl = error_mark_node;
- }
-
- if (TREE_CODE (length) != INTEGER_CST
- && !TREE_READONLY (length))
- {
- error_at (token->location,
- "%qD is not a constant", length);
- decl = error_mark_node;
- }
- }
-
decl = tree_cons (low_bound, length, decl);
}
break;
diff --git gcc/fortran/openmp.c gcc/fortran/openmp.c
index 2689d30..d97c193 100644
--- gcc/fortran/openmp.c
+++ gcc/fortran/openmp.c
@@ -1688,6 +1688,11 @@ match
gfc_match_oacc_cache (void)
{
gfc_omp_clauses *c = gfc_get_omp_clauses ();
+ /* The OpenACC cache directive explicitly only allows "array elements or
+ subarrays", which we're currently not checking here. Either check this
+ after the call of gfc_match_omp_variable_list, or add something like a
+ only_sections variant next to its allow_sections parameter. Or, would it
+ make sense to allow complete arrays as a GNU extension? */
match m = gfc_match_omp_variable_list (" (",
&c->lists[OMP_LIST_CACHE], true,
NULL, NULL, true);
diff --git gcc/omp-low.c gcc/omp-low.c
index 77bdb18..91d5fcf 100644
--- gcc/omp-low.c
+++ gcc/omp-low.c
@@ -2201,9 +2201,6 @@ scan_sharing_clauses (tree clauses, omp_context *ctx,
break;
case OMP_CLAUSE__CACHE_:
- sorry ("Clause not supported yet");
- break;
-
default:
gcc_unreachable ();
}
@@ -2368,9 +2365,6 @@ scan_sharing_clauses (tree clauses, omp_context *ctx,
break;
case OMP_CLAUSE__CACHE_:
- sorry ("Clause not supported yet");
- break;
-
default:
gcc_unreachable ();
}
diff --git gcc/testsuite/c-c++-common/goacc/cache-1.c gcc/testsuite/c-c++-common/goacc/cache-1.c
index 9503341..1d4759e 100644
--- gcc/testsuite/c-c++-common/goacc/cache-1.c
+++ gcc/testsuite/c-c++-common/goacc/cache-1.c
@@ -1,3 +1,7 @@
+/* OpenACC cache directive: valid usage. */
+/* For execution testing, this file is "#include"d from
+ libgomp/testsuite/libgomp.oacc-c-c++-common/cache-1.c. */
+
int
main (int argc, char **argv)
{
@@ -21,57 +25,31 @@ main (int argc, char **argv)
int n = 1;
const int len = n;
-#pragma acc cache /* { dg-error "expected '\\\(' before end of line" } */
-
-#pragma acc cache a[0:N] /* { dg-error "expected '\\\(' before 'a'" } */
- /* { dg-bogus "expected end of line before 'a'" "" { xfail c++ } 26 } */
-
-#pragma acc cache (a) /* { dg-error "expected '\\\['" } */
-
-#pragma acc cache ( /* { dg-error "expected (identifier|unqualified-id) before end of line" } */
-
-#pragma acc cache () /* { dg-error "expected (identifier|unqualified-id) before '\\\)' token" } */
-
-#pragma acc cache (,) /* { dg-error "expected (identifier|unqualified-id) before '(,|\\\))' token" } */
-
-#pragma acc cache (a[0:N] /* { dg-error "expected '\\\)' before end of line" } */
-
-#pragma acc cache (a[0:N],) /* { dg-error "expected (identifier|unqualified-id) before '(,|\\\))' token" "" { xfail c } } */
-
-#pragma acc cache (a[0:N]) copyin (a[0:N]) /* { dg-error "expected end of line before 'copyin'" } */
-
-#pragma acc cache () /* { dg-error "expected (identifier|unqualified-id) before '\\\)' token" } */
-
-#pragma acc cache (a[0:N] b[0:N]) /* { dg-error "expected '\\\)' before 'b'" } */
-
-#pragma acc cache (a[0:N] b[0:N}) /* { dg-error "expected '\\\)' before 'b'" } */
- /* { dg-bogus "expected end of line before '\\\}' token" "" { xfail c++ } 47 } */
-
-#pragma acc cache (a[0:N] /* { dg-error "expected '\\\)' before end of line" } */
-
-#pragma acc cache (a[ii]) /* { dg-error "'ii' is not a constant" } */
-
-#pragma acc cache (a[idx:n]) /* { dg-error "'n' is not a constant" } */
-
-#pragma acc cache (a[0:N]) ( /* { dg-error "expected end of line before '\\(' token" } */
-
-#pragma acc cache (a[0:N]) ii /* { dg-error "expected end of line before 'ii'" } */
-
-#pragma acc cache (a[0:N] ii) /* { dg-error "expected '\\)' before 'ii'" } */
-
+ /* Have at it, GCC! */
#pragma acc cache (a[0:N])
-
#pragma acc cache (a[0:N], a[0:N])
-
#pragma acc cache (a[0:N], b[0:N])
-
#pragma acc cache (a[0])
-
#pragma acc cache (a[0], a[1], b[0:N])
-
+#pragma acc cache (a[i - 5])
+#pragma acc cache (a[i + 5:len])
+#pragma acc cache (a[i + 5:len - 1])
+#pragma acc cache (b[i])
+#pragma acc cache (b[i:len])
+#pragma acc cache (a[ii])
+#pragma acc cache (a[ii:len])
+#pragma acc cache (b[ii - 1])
+#pragma acc cache (b[ii - 1:len])
+#pragma acc cache (b[i - ii + 1])
+#pragma acc cache (b[i + ii - 1:len])
+#pragma acc cache (b[i * ii - 1:len + 1])
+#pragma acc cache (a[idx + 2])
+#pragma acc cache (a[idx:len + 2])
#pragma acc cache (a[idx])
-
#pragma acc cache (a[idx:len])
+#pragma acc cache (a[idx + 2:len])
+#pragma acc cache (a[idx + 2 + i:len])
+#pragma acc cache (a[idx + 2 + i + ii:len])
b[ii] = a[ii];
}
diff --git gcc/testsuite/c-c++-common/goacc/cache-1.c gcc/testsuite/c-c++-common/goacc/cache-2.c
similarity index 83%
copy from gcc/testsuite/c-c++-common/goacc/cache-1.c
copy to gcc/testsuite/c-c++-common/goacc/cache-2.c
index 9503341..f717515 100644
--- gcc/testsuite/c-c++-common/goacc/cache-1.c
+++ gcc/testsuite/c-c++-common/goacc/cache-2.c
@@ -1,3 +1,5 @@
+/* OpenACC cache directive: invalid usage. */
+
int
main (int argc, char **argv)
{
@@ -22,57 +24,24 @@ main (int argc, char **argv)
const int len = n;
#pragma acc cache /* { dg-error "expected '\\\(' before end of line" } */
-
#pragma acc cache a[0:N] /* { dg-error "expected '\\\(' before 'a'" } */
- /* { dg-bogus "expected end of line before 'a'" "" { xfail c++ } 26 } */
-
+ /* { dg-bogus "expected end of line before 'a'" "" { xfail c++ } 27 } */
#pragma acc cache (a) /* { dg-error "expected '\\\['" } */
-
#pragma acc cache ( /* { dg-error "expected (identifier|unqualified-id) before end of line" } */
-
#pragma acc cache () /* { dg-error "expected (identifier|unqualified-id) before '\\\)' token" } */
-
#pragma acc cache (,) /* { dg-error "expected (identifier|unqualified-id) before '(,|\\\))' token" } */
-
#pragma acc cache (a[0:N] /* { dg-error "expected '\\\)' before end of line" } */
-
#pragma acc cache (a[0:N],) /* { dg-error "expected (identifier|unqualified-id) before '(,|\\\))' token" "" { xfail c } } */
-
#pragma acc cache (a[0:N]) copyin (a[0:N]) /* { dg-error "expected end of line before 'copyin'" } */
-
#pragma acc cache () /* { dg-error "expected (identifier|unqualified-id) before '\\\)' token" } */
-
#pragma acc cache (a[0:N] b[0:N]) /* { dg-error "expected '\\\)' before 'b'" } */
-
#pragma acc cache (a[0:N] b[0:N}) /* { dg-error "expected '\\\)' before 'b'" } */
- /* { dg-bogus "expected end of line before '\\\}' token" "" { xfail c++ } 47 } */
-
+ /* { dg-bogus "expected end of line before '\\\}' token" "" { xfail c++ } 38 } */
#pragma acc cache (a[0:N] /* { dg-error "expected '\\\)' before end of line" } */
-
-#pragma acc cache (a[ii]) /* { dg-error "'ii' is not a constant" } */
-
-#pragma acc cache (a[idx:n]) /* { dg-error "'n' is not a constant" } */
-
#pragma acc cache (a[0:N]) ( /* { dg-error "expected end of line before '\\(' token" } */
-
#pragma acc cache (a[0:N]) ii /* { dg-error "expected end of line before 'ii'" } */
-
#pragma acc cache (a[0:N] ii) /* { dg-error "expected '\\)' before 'ii'" } */
-#pragma acc cache (a[0:N])
-
-#pragma acc cache (a[0:N], a[0:N])
-
-#pragma acc cache (a[0:N], b[0:N])
-
-#pragma acc cache (a[0])
-
-#pragma acc cache (a[0], a[1], b[0:N])
-
-#pragma acc cache (a[idx])
-
-#pragma acc cache (a[idx:len])
-
b[ii] = a[ii];
}
}
diff --git gcc/testsuite/gfortran.dg/goacc/cache-1.f95 gcc/testsuite/gfortran.dg/goacc/cache-1.f95
index 2aa9e05..39fbf2c 100644
--- gcc/testsuite/gfortran.dg/goacc/cache-1.f95
+++ gcc/testsuite/gfortran.dg/goacc/cache-1.f95
@@ -1,4 +1,6 @@
-! { dg-do compile }
+! OpenACC cache directive: valid usage.
+! For execution testing, this file is "#include"d from
+! libgomp/testsuite/libgomp.oacc-fortran/cache-1.f95.
! { dg-additional-options "-std=f2008" }
program test
@@ -6,11 +8,8 @@ program test
integer :: i, d(10), e(5,13)
do concurrent (i=1:5)
- !$acc cache (d)
!$acc cache (d(1:3))
!$acc cache (d(i:i+2))
-
- !$acc cache (e)
!$acc cache (e(1:3,2:4))
!$acc cache (e(i:i+2,i+1:i+3))
enddo
diff --git gcc/testsuite/gfortran.dg/goacc/cache-2.f95 gcc/testsuite/gfortran.dg/goacc/cache-2.f95
new file mode 100644
index 0000000..be81878
--- /dev/null
+++ gcc/testsuite/gfortran.dg/goacc/cache-2.f95
@@ -0,0 +1,12 @@
+! OpenACC cache directive: invalid usage.
+! { dg-additional-options "-std=f2008" }
+
+program test
+ implicit none
+ integer :: i, d(10), e(5,13)
+
+ do concurrent (i=1:5)
+ !$acc cache (d) ! { dg-error "" "TODO" { xfail *-*-* } }
+ !$acc cache (e) ! { dg-error "" "TODO" { xfail *-*-* } }
+ enddo
+end
diff --git gcc/testsuite/gfortran.dg/goacc/coarray.f95 gcc/testsuite/gfortran.dg/goacc/coarray.f95
index 932e1f7..f30917b8 100644
--- gcc/testsuite/gfortran.dg/goacc/coarray.f95
+++ gcc/testsuite/gfortran.dg/goacc/coarray.f95
@@ -24,7 +24,7 @@ contains
!$acc end parallel loop
!$acc parallel loop
do i = 1,5
- !$acc cache (a)
+ !$acc cache (a) ! { dg-error "" "TODO" { xfail *-*-* } }
enddo
!$acc end parallel loop
!$acc update device (a)
diff --git gcc/testsuite/gfortran.dg/goacc/cray.f95 gcc/testsuite/gfortran.dg/goacc/cray.f95
index a35ab0d..705c18c 100644
--- gcc/testsuite/gfortran.dg/goacc/cray.f95
+++ gcc/testsuite/gfortran.dg/goacc/cray.f95
@@ -44,7 +44,8 @@ contains
!$acc end parallel loop
!$acc parallel loop
do i = 1,5
- !$acc cache (ptr) ! TODO: This must fail, as in openacc-1_0-branch
+ !TODO: This must fail, as in openacc-1_0-branch.
+ !$acc cache (ptr) ! { dg-error "" "TODO" { xfail *-*-* } }
enddo
!$acc end parallel loop
!$acc update device (ptr)
diff --git gcc/testsuite/gfortran.dg/goacc/loop-1.f95 gcc/testsuite/gfortran.dg/goacc/loop-1.f95
index b5f9e03..a605f03 100644
--- gcc/testsuite/gfortran.dg/goacc/loop-1.f95
+++ gcc/testsuite/gfortran.dg/goacc/loop-1.f95
@@ -158,15 +158,16 @@ subroutine test1
enddo
- !$acc cache (a) ! { dg-error "inside of loop" }
+ !$acc cache (a(1:10)) ! { dg-error "ACC CACHE directive must be inside of loop" }
do i = 1,10
- !$acc cache(a)
+ !$acc cache(a(i:i+1))
enddo
do i = 1,10
+ !$acc cache(a(i:i+1))
a(i) = i
- !$acc cache(a)
+ !$acc cache(a(i+2:i+2+1))
enddo
end subroutine test1
diff --git libgomp/testsuite/libgomp.oacc-c-c++-common/cache-1.c libgomp/testsuite/libgomp.oacc-c-c++-common/cache-1.c
index 3f1f0bb..16aaed5 100644
--- libgomp/testsuite/libgomp.oacc-c-c++-common/cache-1.c
+++ libgomp/testsuite/libgomp.oacc-c-c++-common/cache-1.c
@@ -1,48 +1,3 @@
-int
-main (int argc, char **argv)
-{
-#define N 2
- int a[N], b[N];
- int i;
+/* OpenACC cache directive. */
- for (i = 0; i < N; i++)
- {
- a[i] = 3;
- b[i] = 0;
- }
-
-#pragma acc parallel copyin (a[0:N]) copyout (b[0:N])
-{
- int ii;
-
- for (ii = 0; ii < N; ii++)
- {
- const int idx = ii;
- int n = 1;
- const int len = n;
-
-#pragma acc cache (a[0:N])
-
-#pragma acc cache (a[0:N], b[0:N])
-
-#pragma acc cache (a[0])
-
-#pragma acc cache (a[0], a[1], b[0:N])
-
-#pragma acc cache (a[idx])
-
-#pragma acc cache (a[idx:len])
-
- b[ii] = a[ii];
- }
-}
-
-
- for (i = 0; i < N; i++)
- {
- if (a[i] != b[i])
- __builtin_abort ();
- }
-
- return 0;
-}
+#include "../../../gcc/testsuite/c-c++-common/goacc/cache-1.c"
diff --git libgomp/testsuite/libgomp.oacc-fortran/cache-1.f95 libgomp/testsuite/libgomp.oacc-fortran/cache-1.f95
new file mode 100644
index 0000000..a68c970
--- /dev/null
+++ libgomp/testsuite/libgomp.oacc-fortran/cache-1.f95
@@ -0,0 +1,5 @@
+! OpenACC cache directive.
+! { dg-additional-options "-std=f2008" }
+! { dg-additional-options "-cpp" }
+
+#include "../../../gcc/testsuite/gfortran.dg/goacc/cache-1.f95"
Grüße
Thomas
[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 472 bytes --]
^ permalink raw reply [flat|nested] 89+ messages in thread
* [PING] [PR c/71381] C/C++ OpenACC cache directive rejects valid syntax
2016-06-02 11:47 ` [PR c/71381] C/C++ OpenACC cache directive rejects valid syntax (was: [gomp4] OpenACC cache directive for C.) Thomas Schwinge
@ 2016-06-08 13:29 ` Thomas Schwinge
2016-06-08 14:07 ` Jakub Jelinek
0 siblings, 1 reply; 89+ messages in thread
From: Thomas Schwinge @ 2016-06-08 13:29 UTC (permalink / raw)
To: gcc-patches, Jakub Jelinek; +Cc: James Norris
Hi!
Ping.
On Thu, 2 Jun 2016 13:47:08 +0200, I wrote:
> On Wed, 05 Nov 2014 17:29:19 +0100, I wrote:
> > In r217145, I applied Jim's patch to gomp-4_0-branch:
> >
> > commit 4361f9b6b2c74c2961c3a5290a4945abe2d7a444
> > Author: tschwinge <tschwinge@138bc75d-0d04-0410-961f-82ee72b054a4>
> > Date: Wed Nov 5 16:26:47 2014 +0000
> >
> > OpenACC cache directive for C.
>
> (That, and the corresponding C++ changes later made it into trunk.)
>
> > --- gcc/c/c-parser.c
> > +++ gcc/c/c-parser.c
> > @@ -10053,6 +10053,14 @@ c_parser_omp_variable_list (c_parser *parser,
> > {
> > switch (kind)
> > {
> > + case OMP_NO_CLAUSE_CACHE:
> > + if (c_parser_peek_token (parser)->type != CPP_OPEN_SQUARE)
> > + {
> > + c_parser_error (parser, "expected %<[%>");
> > + t = error_mark_node;
> > + break;
> > + }
> > + /* FALL THROUGH. */
> > case OMP_CLAUSE_MAP:
> > case OMP_CLAUSE_FROM:
> > case OMP_CLAUSE_TO:
>
> Strictly speaking (OpenACC 2.0a specification), that is correct: the
> OpenACC cache directive explicitly only allows "array elements or
> subarrays". However, I wonder if it would make sense to allow complete
> arrays as a GNU extension? That is, syntactic sugar to allow "cache (a)"
> to mean "cache (a[0:LENGTH])"?
>
> > @@ -10091,6 +10099,29 @@ c_parser_omp_variable_list (c_parser *parser,
> > t = error_mark_node;
> > break;
> > }
> > +
> > + if (kind == OMP_NO_CLAUSE_CACHE)
> > + {
> > + mark_exp_read (low_bound);
> > + mark_exp_read (length);
> > +
> > + if (TREE_CODE (low_bound) != INTEGER_CST
> > + && !TREE_READONLY (low_bound))
> > + {
> > + error_at (clause_loc,
> > + "%qD is not a constant", low_bound);
> > + t = error_mark_node;
> > + }
>
> WHile OpenACC 2.0a specifies that "the lower bound is a constant", it
> also permits the lower bound to be a "loop invariant, or the for loop
> index variable plus or minus a constant or loop invariant". So, we're
> rejecting valid syntax here.
>
> > +
> > + if (TREE_CODE (length) != INTEGER_CST
> > + && !TREE_READONLY (length))
> > + {
> > + error_at (clause_loc,
> > + "%qD is not a constant", length);
> > + t = error_mark_node;
> > + }
> > + }
>
> The idea is correct (OpenACC 2.0a: "the length is a constant"), but we
> can't reliably check that here; for example:
>
> #pragma acc cache (a[0:n + 1])
>
> ... will run into an ICE, "tree check: expected tree that contains 'decl
> minimal' structure, have 'plus_expr' in [...]".
>
> Currently we're discarding the OpenACC cache directive in the middle end;
> I expect checking of the lower bound and length will come automatically
> as soon as we start to do something with OACC_CACHE/OMP_CLAUSE__CACHE_.
> Until then, I propose we simple remove these checks from the front ends.
> OK for trunk and gcc-6-branch?
>
> commit a620ebe6fa509ec6441ba87276e55078eb2d00fc
> Author: Thomas Schwinge <thomas@codesourcery.com>
> Date: Thu Jun 2 12:19:49 2016 +0200
>
> [PR c/71381] C/C++ OpenACC cache directive rejects valid syntax
>
> gcc/c/
> PR c/71381
> * c-parser.c (c_parser_omp_variable_list) <OMP_CLAUSE__CACHE_>:
> Loosen checking.
> gcc/cp/
> PR c/71381
> * parser.c (cp_parser_omp_var_list_no_open) <OMP_CLAUSE__CACHE_>:
> Loosen checking.
> gcc/fortran/
> PR c/71381
> * openmp.c (gfc_match_oacc_cache): Add comment.
> gcc/testsuite/
> PR c/71381
> * c-c++-common/goacc/cache-1.c: Update. Move invalid usage tests
> to...
> * c-c++-common/goacc/cache-2.c: ... this new file.
> * gfortran.dg/goacc/cache-1.f95: Move invalid usage tests to...
> * gfortran.dg/goacc/cache-2.f95: ... this new file.
> * gfortran.dg/goacc/coarray.f95: Update OpenACC cache directive
> usage.
> * gfortran.dg/goacc/cray.f95: Likewise.
> * gfortran.dg/goacc/loop-1.f95: Likewise.
> libgomp/
> PR c/71381
> * testsuite/libgomp.oacc-c-c++-common/cache-1.c: #include
> "../../../gcc/testsuite/c-c++-common/goacc/cache-1.c".
> * testsuite/libgomp.oacc-fortran/cache-1.f95: New file.
>
> gcc/
> * omp-low.c (scan_sharing_clauses): Don't expect
> OMP_CLAUSE__CACHE_.
> ---
> gcc/c/c-parser.c | 22 +-------
> gcc/cp/parser.c | 22 +-------
> gcc/fortran/openmp.c | 5 ++
> gcc/omp-low.c | 6 --
> gcc/testsuite/c-c++-common/goacc/cache-1.c | 66 ++++++++--------------
> .../c-c++-common/goacc/{cache-1.c => cache-2.c} | 39 ++-----------
> gcc/testsuite/gfortran.dg/goacc/cache-1.f95 | 7 +--
> gcc/testsuite/gfortran.dg/goacc/cache-2.f95 | 12 ++++
> gcc/testsuite/gfortran.dg/goacc/coarray.f95 | 2 +-
> gcc/testsuite/gfortran.dg/goacc/cray.f95 | 3 +-
> gcc/testsuite/gfortran.dg/goacc/loop-1.f95 | 7 ++-
> .../testsuite/libgomp.oacc-c-c++-common/cache-1.c | 49 +---------------
> libgomp/testsuite/libgomp.oacc-fortran/cache-1.f95 | 5 ++
> 13 files changed, 66 insertions(+), 179 deletions(-)
>
> diff --git gcc/c/c-parser.c gcc/c/c-parser.c
> index bca8653..1db1886 100644
> --- gcc/c/c-parser.c
> +++ gcc/c/c-parser.c
> @@ -10601,6 +10601,9 @@ c_parser_omp_variable_list (c_parser *parser,
> switch (kind)
> {
> case OMP_CLAUSE__CACHE_:
> + /* The OpenACC cache directive explicitly only allows "array
> + elements or subarrays". Would it make sense to allow complete
> + arrays as a GNU extension? */
> if (c_parser_peek_token (parser)->type != CPP_OPEN_SQUARE)
> {
> c_parser_error (parser, "expected %<[%>");
> @@ -10663,25 +10666,6 @@ c_parser_omp_variable_list (c_parser *parser,
> break;
> }
>
> - if (kind == OMP_CLAUSE__CACHE_)
> - {
> - if (TREE_CODE (low_bound) != INTEGER_CST
> - && !TREE_READONLY (low_bound))
> - {
> - error_at (clause_loc,
> - "%qD is not a constant", low_bound);
> - t = error_mark_node;
> - }
> -
> - if (TREE_CODE (length) != INTEGER_CST
> - && !TREE_READONLY (length))
> - {
> - error_at (clause_loc,
> - "%qD is not a constant", length);
> - t = error_mark_node;
> - }
> - }
> -
> t = tree_cons (low_bound, length, t);
> }
> break;
> diff --git gcc/cp/parser.c gcc/cp/parser.c
> index 29a1b80..826277d 100644
> --- gcc/cp/parser.c
> +++ gcc/cp/parser.c
> @@ -29984,6 +29984,9 @@ cp_parser_omp_var_list_no_open (cp_parser *parser, enum omp_clause_code kind,
> switch (kind)
> {
> case OMP_CLAUSE__CACHE_:
> + /* The OpenACC cache directive explicitly only allows "array
> + elements or subarrays". Would it make sense to allow complete
> + arrays as a GNU extension? */
> if (cp_lexer_peek_token (parser->lexer)->type != CPP_OPEN_SQUARE)
> {
> error_at (token->location, "expected %<[%>");
> @@ -30035,25 +30038,6 @@ cp_parser_omp_var_list_no_open (cp_parser *parser, enum omp_clause_code kind,
> RT_CLOSE_SQUARE))
> goto skip_comma;
>
> - if (kind == OMP_CLAUSE__CACHE_)
> - {
> - if (TREE_CODE (low_bound) != INTEGER_CST
> - && !TREE_READONLY (low_bound))
> - {
> - error_at (token->location,
> - "%qD is not a constant", low_bound);
> - decl = error_mark_node;
> - }
> -
> - if (TREE_CODE (length) != INTEGER_CST
> - && !TREE_READONLY (length))
> - {
> - error_at (token->location,
> - "%qD is not a constant", length);
> - decl = error_mark_node;
> - }
> - }
> -
> decl = tree_cons (low_bound, length, decl);
> }
> break;
> diff --git gcc/fortran/openmp.c gcc/fortran/openmp.c
> index 2689d30..d97c193 100644
> --- gcc/fortran/openmp.c
> +++ gcc/fortran/openmp.c
> @@ -1688,6 +1688,11 @@ match
> gfc_match_oacc_cache (void)
> {
> gfc_omp_clauses *c = gfc_get_omp_clauses ();
> + /* The OpenACC cache directive explicitly only allows "array elements or
> + subarrays", which we're currently not checking here. Either check this
> + after the call of gfc_match_omp_variable_list, or add something like a
> + only_sections variant next to its allow_sections parameter. Or, would it
> + make sense to allow complete arrays as a GNU extension? */
> match m = gfc_match_omp_variable_list (" (",
> &c->lists[OMP_LIST_CACHE], true,
> NULL, NULL, true);
> diff --git gcc/omp-low.c gcc/omp-low.c
> index 77bdb18..91d5fcf 100644
> --- gcc/omp-low.c
> +++ gcc/omp-low.c
> @@ -2201,9 +2201,6 @@ scan_sharing_clauses (tree clauses, omp_context *ctx,
> break;
>
> case OMP_CLAUSE__CACHE_:
> - sorry ("Clause not supported yet");
> - break;
> -
> default:
> gcc_unreachable ();
> }
> @@ -2368,9 +2365,6 @@ scan_sharing_clauses (tree clauses, omp_context *ctx,
> break;
>
> case OMP_CLAUSE__CACHE_:
> - sorry ("Clause not supported yet");
> - break;
> -
> default:
> gcc_unreachable ();
> }
> diff --git gcc/testsuite/c-c++-common/goacc/cache-1.c gcc/testsuite/c-c++-common/goacc/cache-1.c
> index 9503341..1d4759e 100644
> --- gcc/testsuite/c-c++-common/goacc/cache-1.c
> +++ gcc/testsuite/c-c++-common/goacc/cache-1.c
> @@ -1,3 +1,7 @@
> +/* OpenACC cache directive: valid usage. */
> +/* For execution testing, this file is "#include"d from
> + libgomp/testsuite/libgomp.oacc-c-c++-common/cache-1.c. */
> +
> int
> main (int argc, char **argv)
> {
> @@ -21,57 +25,31 @@ main (int argc, char **argv)
> int n = 1;
> const int len = n;
>
> -#pragma acc cache /* { dg-error "expected '\\\(' before end of line" } */
> -
> -#pragma acc cache a[0:N] /* { dg-error "expected '\\\(' before 'a'" } */
> - /* { dg-bogus "expected end of line before 'a'" "" { xfail c++ } 26 } */
> -
> -#pragma acc cache (a) /* { dg-error "expected '\\\['" } */
> -
> -#pragma acc cache ( /* { dg-error "expected (identifier|unqualified-id) before end of line" } */
> -
> -#pragma acc cache () /* { dg-error "expected (identifier|unqualified-id) before '\\\)' token" } */
> -
> -#pragma acc cache (,) /* { dg-error "expected (identifier|unqualified-id) before '(,|\\\))' token" } */
> -
> -#pragma acc cache (a[0:N] /* { dg-error "expected '\\\)' before end of line" } */
> -
> -#pragma acc cache (a[0:N],) /* { dg-error "expected (identifier|unqualified-id) before '(,|\\\))' token" "" { xfail c } } */
> -
> -#pragma acc cache (a[0:N]) copyin (a[0:N]) /* { dg-error "expected end of line before 'copyin'" } */
> -
> -#pragma acc cache () /* { dg-error "expected (identifier|unqualified-id) before '\\\)' token" } */
> -
> -#pragma acc cache (a[0:N] b[0:N]) /* { dg-error "expected '\\\)' before 'b'" } */
> -
> -#pragma acc cache (a[0:N] b[0:N}) /* { dg-error "expected '\\\)' before 'b'" } */
> - /* { dg-bogus "expected end of line before '\\\}' token" "" { xfail c++ } 47 } */
> -
> -#pragma acc cache (a[0:N] /* { dg-error "expected '\\\)' before end of line" } */
> -
> -#pragma acc cache (a[ii]) /* { dg-error "'ii' is not a constant" } */
> -
> -#pragma acc cache (a[idx:n]) /* { dg-error "'n' is not a constant" } */
> -
> -#pragma acc cache (a[0:N]) ( /* { dg-error "expected end of line before '\\(' token" } */
> -
> -#pragma acc cache (a[0:N]) ii /* { dg-error "expected end of line before 'ii'" } */
> -
> -#pragma acc cache (a[0:N] ii) /* { dg-error "expected '\\)' before 'ii'" } */
> -
> + /* Have at it, GCC! */
> #pragma acc cache (a[0:N])
> -
> #pragma acc cache (a[0:N], a[0:N])
> -
> #pragma acc cache (a[0:N], b[0:N])
> -
> #pragma acc cache (a[0])
> -
> #pragma acc cache (a[0], a[1], b[0:N])
> -
> +#pragma acc cache (a[i - 5])
> +#pragma acc cache (a[i + 5:len])
> +#pragma acc cache (a[i + 5:len - 1])
> +#pragma acc cache (b[i])
> +#pragma acc cache (b[i:len])
> +#pragma acc cache (a[ii])
> +#pragma acc cache (a[ii:len])
> +#pragma acc cache (b[ii - 1])
> +#pragma acc cache (b[ii - 1:len])
> +#pragma acc cache (b[i - ii + 1])
> +#pragma acc cache (b[i + ii - 1:len])
> +#pragma acc cache (b[i * ii - 1:len + 1])
> +#pragma acc cache (a[idx + 2])
> +#pragma acc cache (a[idx:len + 2])
> #pragma acc cache (a[idx])
> -
> #pragma acc cache (a[idx:len])
> +#pragma acc cache (a[idx + 2:len])
> +#pragma acc cache (a[idx + 2 + i:len])
> +#pragma acc cache (a[idx + 2 + i + ii:len])
>
> b[ii] = a[ii];
> }
> diff --git gcc/testsuite/c-c++-common/goacc/cache-1.c gcc/testsuite/c-c++-common/goacc/cache-2.c
> similarity index 83%
> copy from gcc/testsuite/c-c++-common/goacc/cache-1.c
> copy to gcc/testsuite/c-c++-common/goacc/cache-2.c
> index 9503341..f717515 100644
> --- gcc/testsuite/c-c++-common/goacc/cache-1.c
> +++ gcc/testsuite/c-c++-common/goacc/cache-2.c
> @@ -1,3 +1,5 @@
> +/* OpenACC cache directive: invalid usage. */
> +
> int
> main (int argc, char **argv)
> {
> @@ -22,57 +24,24 @@ main (int argc, char **argv)
> const int len = n;
>
> #pragma acc cache /* { dg-error "expected '\\\(' before end of line" } */
> -
> #pragma acc cache a[0:N] /* { dg-error "expected '\\\(' before 'a'" } */
> - /* { dg-bogus "expected end of line before 'a'" "" { xfail c++ } 26 } */
> -
> + /* { dg-bogus "expected end of line before 'a'" "" { xfail c++ } 27 } */
> #pragma acc cache (a) /* { dg-error "expected '\\\['" } */
> -
> #pragma acc cache ( /* { dg-error "expected (identifier|unqualified-id) before end of line" } */
> -
> #pragma acc cache () /* { dg-error "expected (identifier|unqualified-id) before '\\\)' token" } */
> -
> #pragma acc cache (,) /* { dg-error "expected (identifier|unqualified-id) before '(,|\\\))' token" } */
> -
> #pragma acc cache (a[0:N] /* { dg-error "expected '\\\)' before end of line" } */
> -
> #pragma acc cache (a[0:N],) /* { dg-error "expected (identifier|unqualified-id) before '(,|\\\))' token" "" { xfail c } } */
> -
> #pragma acc cache (a[0:N]) copyin (a[0:N]) /* { dg-error "expected end of line before 'copyin'" } */
> -
> #pragma acc cache () /* { dg-error "expected (identifier|unqualified-id) before '\\\)' token" } */
> -
> #pragma acc cache (a[0:N] b[0:N]) /* { dg-error "expected '\\\)' before 'b'" } */
> -
> #pragma acc cache (a[0:N] b[0:N}) /* { dg-error "expected '\\\)' before 'b'" } */
> - /* { dg-bogus "expected end of line before '\\\}' token" "" { xfail c++ } 47 } */
> -
> + /* { dg-bogus "expected end of line before '\\\}' token" "" { xfail c++ } 38 } */
> #pragma acc cache (a[0:N] /* { dg-error "expected '\\\)' before end of line" } */
> -
> -#pragma acc cache (a[ii]) /* { dg-error "'ii' is not a constant" } */
> -
> -#pragma acc cache (a[idx:n]) /* { dg-error "'n' is not a constant" } */
> -
> #pragma acc cache (a[0:N]) ( /* { dg-error "expected end of line before '\\(' token" } */
> -
> #pragma acc cache (a[0:N]) ii /* { dg-error "expected end of line before 'ii'" } */
> -
> #pragma acc cache (a[0:N] ii) /* { dg-error "expected '\\)' before 'ii'" } */
>
> -#pragma acc cache (a[0:N])
> -
> -#pragma acc cache (a[0:N], a[0:N])
> -
> -#pragma acc cache (a[0:N], b[0:N])
> -
> -#pragma acc cache (a[0])
> -
> -#pragma acc cache (a[0], a[1], b[0:N])
> -
> -#pragma acc cache (a[idx])
> -
> -#pragma acc cache (a[idx:len])
> -
> b[ii] = a[ii];
> }
> }
> diff --git gcc/testsuite/gfortran.dg/goacc/cache-1.f95 gcc/testsuite/gfortran.dg/goacc/cache-1.f95
> index 2aa9e05..39fbf2c 100644
> --- gcc/testsuite/gfortran.dg/goacc/cache-1.f95
> +++ gcc/testsuite/gfortran.dg/goacc/cache-1.f95
> @@ -1,4 +1,6 @@
> -! { dg-do compile }
> +! OpenACC cache directive: valid usage.
> +! For execution testing, this file is "#include"d from
> +! libgomp/testsuite/libgomp.oacc-fortran/cache-1.f95.
> ! { dg-additional-options "-std=f2008" }
>
> program test
> @@ -6,11 +8,8 @@ program test
> integer :: i, d(10), e(5,13)
>
> do concurrent (i=1:5)
> - !$acc cache (d)
> !$acc cache (d(1:3))
> !$acc cache (d(i:i+2))
> -
> - !$acc cache (e)
> !$acc cache (e(1:3,2:4))
> !$acc cache (e(i:i+2,i+1:i+3))
> enddo
> diff --git gcc/testsuite/gfortran.dg/goacc/cache-2.f95 gcc/testsuite/gfortran.dg/goacc/cache-2.f95
> new file mode 100644
> index 0000000..be81878
> --- /dev/null
> +++ gcc/testsuite/gfortran.dg/goacc/cache-2.f95
> @@ -0,0 +1,12 @@
> +! OpenACC cache directive: invalid usage.
> +! { dg-additional-options "-std=f2008" }
> +
> +program test
> + implicit none
> + integer :: i, d(10), e(5,13)
> +
> + do concurrent (i=1:5)
> + !$acc cache (d) ! { dg-error "" "TODO" { xfail *-*-* } }
> + !$acc cache (e) ! { dg-error "" "TODO" { xfail *-*-* } }
> + enddo
> +end
> diff --git gcc/testsuite/gfortran.dg/goacc/coarray.f95 gcc/testsuite/gfortran.dg/goacc/coarray.f95
> index 932e1f7..f30917b8 100644
> --- gcc/testsuite/gfortran.dg/goacc/coarray.f95
> +++ gcc/testsuite/gfortran.dg/goacc/coarray.f95
> @@ -24,7 +24,7 @@ contains
> !$acc end parallel loop
> !$acc parallel loop
> do i = 1,5
> - !$acc cache (a)
> + !$acc cache (a) ! { dg-error "" "TODO" { xfail *-*-* } }
> enddo
> !$acc end parallel loop
> !$acc update device (a)
> diff --git gcc/testsuite/gfortran.dg/goacc/cray.f95 gcc/testsuite/gfortran.dg/goacc/cray.f95
> index a35ab0d..705c18c 100644
> --- gcc/testsuite/gfortran.dg/goacc/cray.f95
> +++ gcc/testsuite/gfortran.dg/goacc/cray.f95
> @@ -44,7 +44,8 @@ contains
> !$acc end parallel loop
> !$acc parallel loop
> do i = 1,5
> - !$acc cache (ptr) ! TODO: This must fail, as in openacc-1_0-branch
> + !TODO: This must fail, as in openacc-1_0-branch.
> + !$acc cache (ptr) ! { dg-error "" "TODO" { xfail *-*-* } }
> enddo
> !$acc end parallel loop
> !$acc update device (ptr)
> diff --git gcc/testsuite/gfortran.dg/goacc/loop-1.f95 gcc/testsuite/gfortran.dg/goacc/loop-1.f95
> index b5f9e03..a605f03 100644
> --- gcc/testsuite/gfortran.dg/goacc/loop-1.f95
> +++ gcc/testsuite/gfortran.dg/goacc/loop-1.f95
> @@ -158,15 +158,16 @@ subroutine test1
> enddo
>
>
> - !$acc cache (a) ! { dg-error "inside of loop" }
> + !$acc cache (a(1:10)) ! { dg-error "ACC CACHE directive must be inside of loop" }
>
> do i = 1,10
> - !$acc cache(a)
> + !$acc cache(a(i:i+1))
> enddo
>
> do i = 1,10
> + !$acc cache(a(i:i+1))
> a(i) = i
> - !$acc cache(a)
> + !$acc cache(a(i+2:i+2+1))
> enddo
>
> end subroutine test1
> diff --git libgomp/testsuite/libgomp.oacc-c-c++-common/cache-1.c libgomp/testsuite/libgomp.oacc-c-c++-common/cache-1.c
> index 3f1f0bb..16aaed5 100644
> --- libgomp/testsuite/libgomp.oacc-c-c++-common/cache-1.c
> +++ libgomp/testsuite/libgomp.oacc-c-c++-common/cache-1.c
> @@ -1,48 +1,3 @@
> -int
> -main (int argc, char **argv)
> -{
> -#define N 2
> - int a[N], b[N];
> - int i;
> +/* OpenACC cache directive. */
>
> - for (i = 0; i < N; i++)
> - {
> - a[i] = 3;
> - b[i] = 0;
> - }
> -
> -#pragma acc parallel copyin (a[0:N]) copyout (b[0:N])
> -{
> - int ii;
> -
> - for (ii = 0; ii < N; ii++)
> - {
> - const int idx = ii;
> - int n = 1;
> - const int len = n;
> -
> -#pragma acc cache (a[0:N])
> -
> -#pragma acc cache (a[0:N], b[0:N])
> -
> -#pragma acc cache (a[0])
> -
> -#pragma acc cache (a[0], a[1], b[0:N])
> -
> -#pragma acc cache (a[idx])
> -
> -#pragma acc cache (a[idx:len])
> -
> - b[ii] = a[ii];
> - }
> -}
> -
> -
> - for (i = 0; i < N; i++)
> - {
> - if (a[i] != b[i])
> - __builtin_abort ();
> - }
> -
> - return 0;
> -}
> +#include "../../../gcc/testsuite/c-c++-common/goacc/cache-1.c"
> diff --git libgomp/testsuite/libgomp.oacc-fortran/cache-1.f95 libgomp/testsuite/libgomp.oacc-fortran/cache-1.f95
> new file mode 100644
> index 0000000..a68c970
> --- /dev/null
> +++ libgomp/testsuite/libgomp.oacc-fortran/cache-1.f95
> @@ -0,0 +1,5 @@
> +! OpenACC cache directive.
> +! { dg-additional-options "-std=f2008" }
> +! { dg-additional-options "-cpp" }
> +
> +#include "../../../gcc/testsuite/gfortran.dg/goacc/cache-1.f95"
Grüße
Thomas
^ permalink raw reply [flat|nested] 89+ messages in thread
* Re: [PING] [PR c/71381] C/C++ OpenACC cache directive rejects valid syntax
2016-06-08 13:29 ` [PING] [PR c/71381] C/C++ OpenACC cache directive rejects valid syntax Thomas Schwinge
@ 2016-06-08 14:07 ` Jakub Jelinek
2016-06-10 10:32 ` Thomas Schwinge
0 siblings, 1 reply; 89+ messages in thread
From: Jakub Jelinek @ 2016-06-08 14:07 UTC (permalink / raw)
To: Thomas Schwinge; +Cc: gcc-patches, James Norris
On Wed, Jun 08, 2016 at 03:28:57PM +0200, Thomas Schwinge wrote:
> > [PR c/71381] C/C++ OpenACC cache directive rejects valid syntax
> >
> > gcc/c/
> > PR c/71381
> > * c-parser.c (c_parser_omp_variable_list) <OMP_CLAUSE__CACHE_>:
> > Loosen checking.
> > gcc/cp/
> > PR c/71381
> > * parser.c (cp_parser_omp_var_list_no_open) <OMP_CLAUSE__CACHE_>:
> > Loosen checking.
> > gcc/fortran/
> > PR c/71381
> > * openmp.c (gfc_match_oacc_cache): Add comment.
> > gcc/testsuite/
> > PR c/71381
> > * c-c++-common/goacc/cache-1.c: Update. Move invalid usage tests
> > to...
> > * c-c++-common/goacc/cache-2.c: ... this new file.
> > * gfortran.dg/goacc/cache-1.f95: Move invalid usage tests to...
> > * gfortran.dg/goacc/cache-2.f95: ... this new file.
> > * gfortran.dg/goacc/coarray.f95: Update OpenACC cache directive
> > usage.
> > * gfortran.dg/goacc/cray.f95: Likewise.
> > * gfortran.dg/goacc/loop-1.f95: Likewise.
> > libgomp/
> > PR c/71381
> > * testsuite/libgomp.oacc-c-c++-common/cache-1.c: #include
> > "../../../gcc/testsuite/c-c++-common/goacc/cache-1.c".
> > * testsuite/libgomp.oacc-fortran/cache-1.f95: New file.
> >
> > gcc/
> > * omp-low.c (scan_sharing_clauses): Don't expect
> > OMP_CLAUSE__CACHE_.
Ok.
> > --- gcc/c/c-parser.c
> > +++ gcc/c/c-parser.c
> > @@ -10601,6 +10601,9 @@ c_parser_omp_variable_list (c_parser *parser,
> > switch (kind)
> > {
> > case OMP_CLAUSE__CACHE_:
> > + /* The OpenACC cache directive explicitly only allows "array
> > + elements or subarrays". Would it make sense to allow complete
> > + arrays as a GNU extension? */
Please try to not add GNU extensions on top of OpenACC, unless strictly
necessary.
It is better if the compiler is strict and there is interoperability.
If you think it should accept something that it doesn't, talk to the OpenACC
committee.
Jakub
^ permalink raw reply [flat|nested] 89+ messages in thread
* Re: [PING] [PR c/71381] C/C++ OpenACC cache directive rejects valid syntax
2016-06-08 14:07 ` Jakub Jelinek
@ 2016-06-10 10:32 ` Thomas Schwinge
2016-06-10 13:14 ` Thomas Schwinge
0 siblings, 1 reply; 89+ messages in thread
From: Thomas Schwinge @ 2016-06-10 10:32 UTC (permalink / raw)
To: gcc-patches, Jakub Jelinek; +Cc: James Norris
[-- Attachment #1: Type: text/plain, Size: 62525 bytes --]
Hi!
On Wed, 8 Jun 2016 16:07:17 +0200, Jakub Jelinek <jakub@redhat.com> wrote:
> On Wed, Jun 08, 2016 at 03:28:57PM +0200, Thomas Schwinge wrote:
> > > [PR c/71381] C/C++ OpenACC cache directive rejects valid syntax
> Ok.
> > > case OMP_CLAUSE__CACHE_:
> > > + /* The OpenACC cache directive explicitly only allows "array
> > > + elements or subarrays". Would it make sense to allow complete
> > > + arrays as a GNU extension? */
>
> Please try to not add GNU extensions on top of OpenACC, unless strictly
> necessary.
> It is better if the compiler is strict and there is interoperability.
> If you think it should accept something that it doesn't, talk to the OpenACC
> committee.
Thanks, that makes sense.
Committed to trunk in r237290, gcc-6-branch in r237295, and
gomp-4_0-branch in r237299:
commit ccfa030f8aab53948549c703fbae7833563520ca
Author: tschwinge <tschwinge@138bc75d-0d04-0410-961f-82ee72b054a4>
Date: Fri Jun 10 09:22:38 2016 +0000
[PR c/71381] C/C++ OpenACC cache directive rejects valid syntax
gcc/c/
PR c/71381
* c-parser.c (c_parser_omp_variable_list) <OMP_CLAUSE__CACHE_>:
Loosen checking.
gcc/cp/
PR c/71381
* parser.c (cp_parser_omp_var_list_no_open) <OMP_CLAUSE__CACHE_>:
Loosen checking.
gcc/fortran/
PR c/71381
* openmp.c (gfc_match_oacc_cache): Add comment.
gcc/testsuite/
PR c/71381
* c-c++-common/goacc/cache-1.c: Update. Move invalid usage tests
to...
* c-c++-common/goacc/cache-2.c: ... this new file.
* gfortran.dg/goacc/cache-1.f95: Move invalid usage tests to...
* gfortran.dg/goacc/cache-2.f95: ... this new file.
* gfortran.dg/goacc/coarray.f95: Update OpenACC cache directive
usage.
* gfortran.dg/goacc/cray.f95: Likewise.
* gfortran.dg/goacc/loop-1.f95: Likewise.
libgomp/
PR c/71381
* testsuite/libgomp.oacc-c-c++-common/cache-1.c: #include
"../../../gcc/testsuite/c-c++-common/goacc/cache-1.c".
* testsuite/libgomp.oacc-fortran/cache-1.f95: New file.
gcc/
* omp-low.c (scan_sharing_clauses): Don't expect
OMP_CLAUSE__CACHE_.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@237290 138bc75d-0d04-0410-961f-82ee72b054a4
---
gcc/ChangeLog | 5 ++
gcc/c/ChangeLog | 6 ++
gcc/c/c-parser.c | 21 +------
gcc/cp/ChangeLog | 6 ++
gcc/cp/parser.c | 21 +------
gcc/fortran/ChangeLog | 5 ++
gcc/fortran/openmp.c | 4 ++
gcc/omp-low.c | 6 --
gcc/testsuite/ChangeLog | 13 +++++
gcc/testsuite/c-c++-common/goacc/cache-1.c | 66 ++++++++--------------
.../c-c++-common/goacc/{cache-1.c => cache-2.c} | 39 ++-----------
gcc/testsuite/gfortran.dg/goacc/cache-1.f95 | 7 +--
gcc/testsuite/gfortran.dg/goacc/cache-2.f95 | 12 ++++
gcc/testsuite/gfortran.dg/goacc/coarray.f95 | 2 +-
gcc/testsuite/gfortran.dg/goacc/cray.f95 | 3 +-
gcc/testsuite/gfortran.dg/goacc/loop-1.f95 | 7 ++-
libgomp/ChangeLog | 7 +++
.../testsuite/libgomp.oacc-c-c++-common/cache-1.c | 49 +---------------
libgomp/testsuite/libgomp.oacc-fortran/cache-1.f95 | 6 ++
19 files changed, 106 insertions(+), 179 deletions(-)
diff --git gcc/ChangeLog gcc/ChangeLog
index 3f7240c..6afbae7 100644
--- gcc/ChangeLog
+++ gcc/ChangeLog
@@ -1,3 +1,8 @@
+2016-06-10 Thomas Schwinge <thomas@codesourcery.com>
+
+ * omp-low.c (scan_sharing_clauses): Don't expect
+ OMP_CLAUSE__CACHE_.
+
2016-06-10 Alan Hayward <alan.hayward@arm.com>
PR tree-optimization/71407
diff --git gcc/c/ChangeLog gcc/c/ChangeLog
index 4d30245..cd9f230 100644
--- gcc/c/ChangeLog
+++ gcc/c/ChangeLog
@@ -1,3 +1,9 @@
+2016-06-10 Thomas Schwinge <thomas@codesourcery.com>
+
+ PR c/71381
+ * c-parser.c (c_parser_omp_variable_list) <OMP_CLAUSE__CACHE_>:
+ Loosen checking.
+
2016-06-08 Martin Sebor <msebor@redhat.com>
Jakub Jelinek <jakub@redhat.com>
diff --git gcc/c/c-parser.c gcc/c/c-parser.c
index 2fef1ac..94078a9 100644
--- gcc/c/c-parser.c
+++ gcc/c/c-parser.c
@@ -10613,6 +10613,8 @@ c_parser_omp_variable_list (c_parser *parser,
switch (kind)
{
case OMP_CLAUSE__CACHE_:
+ /* The OpenACC cache directive explicitly only allows "array
+ elements or subarrays". */
if (c_parser_peek_token (parser)->type != CPP_OPEN_SQUARE)
{
c_parser_error (parser, "expected %<[%>");
@@ -10678,25 +10680,6 @@ c_parser_omp_variable_list (c_parser *parser,
break;
}
- if (kind == OMP_CLAUSE__CACHE_)
- {
- if (TREE_CODE (low_bound) != INTEGER_CST
- && !TREE_READONLY (low_bound))
- {
- error_at (clause_loc,
- "%qD is not a constant", low_bound);
- t = error_mark_node;
- }
-
- if (TREE_CODE (length) != INTEGER_CST
- && !TREE_READONLY (length))
- {
- error_at (clause_loc,
- "%qD is not a constant", length);
- t = error_mark_node;
- }
- }
-
t = tree_cons (low_bound, length, t);
}
break;
diff --git gcc/cp/ChangeLog gcc/cp/ChangeLog
index a94cebe..53d55d3 100644
--- gcc/cp/ChangeLog
+++ gcc/cp/ChangeLog
@@ -1,3 +1,9 @@
+2016-06-10 Thomas Schwinge <thomas@codesourcery.com>
+
+ PR c/71381
+ * parser.c (cp_parser_omp_var_list_no_open) <OMP_CLAUSE__CACHE_>:
+ Loosen checking.
+
2016-06-09 Paolo Carlini <paolo.carlini@oracle.com>
PR c++/71465
diff --git gcc/cp/parser.c gcc/cp/parser.c
index e01353d..632b25f 100644
--- gcc/cp/parser.c
+++ gcc/cp/parser.c
@@ -29984,6 +29984,8 @@ cp_parser_omp_var_list_no_open (cp_parser *parser, enum omp_clause_code kind,
switch (kind)
{
case OMP_CLAUSE__CACHE_:
+ /* The OpenACC cache directive explicitly only allows "array
+ elements or subarrays". */
if (cp_lexer_peek_token (parser->lexer)->type != CPP_OPEN_SQUARE)
{
error_at (token->location, "expected %<[%>");
@@ -30035,25 +30037,6 @@ cp_parser_omp_var_list_no_open (cp_parser *parser, enum omp_clause_code kind,
RT_CLOSE_SQUARE))
goto skip_comma;
- if (kind == OMP_CLAUSE__CACHE_)
- {
- if (TREE_CODE (low_bound) != INTEGER_CST
- && !TREE_READONLY (low_bound))
- {
- error_at (token->location,
- "%qD is not a constant", low_bound);
- decl = error_mark_node;
- }
-
- if (TREE_CODE (length) != INTEGER_CST
- && !TREE_READONLY (length))
- {
- error_at (token->location,
- "%qD is not a constant", length);
- decl = error_mark_node;
- }
- }
-
decl = tree_cons (low_bound, length, decl);
}
break;
diff --git gcc/fortran/ChangeLog gcc/fortran/ChangeLog
index b2354e7..67bc9e8 100644
--- gcc/fortran/ChangeLog
+++ gcc/fortran/ChangeLog
@@ -1,3 +1,8 @@
+2016-06-10 Thomas Schwinge <thomas@codesourcery.com>
+
+ PR c/71381
+ * openmp.c (gfc_match_oacc_cache): Add comment.
+
2016-06-05 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR fortran/71404
diff --git gcc/fortran/openmp.c gcc/fortran/openmp.c
index 2689d30..2c92794 100644
--- gcc/fortran/openmp.c
+++ gcc/fortran/openmp.c
@@ -1688,6 +1688,10 @@ match
gfc_match_oacc_cache (void)
{
gfc_omp_clauses *c = gfc_get_omp_clauses ();
+ /* The OpenACC cache directive explicitly only allows "array elements or
+ subarrays", which we're currently not checking here. Either check this
+ after the call of gfc_match_omp_variable_list, or add something like a
+ only_sections variant next to its allow_sections parameter. */
match m = gfc_match_omp_variable_list (" (",
&c->lists[OMP_LIST_CACHE], true,
NULL, NULL, true);
diff --git gcc/omp-low.c gcc/omp-low.c
index 77bdb18..91d5fcf 100644
--- gcc/omp-low.c
+++ gcc/omp-low.c
@@ -2201,9 +2201,6 @@ scan_sharing_clauses (tree clauses, omp_context *ctx,
break;
case OMP_CLAUSE__CACHE_:
- sorry ("Clause not supported yet");
- break;
-
default:
gcc_unreachable ();
}
@@ -2368,9 +2365,6 @@ scan_sharing_clauses (tree clauses, omp_context *ctx,
break;
case OMP_CLAUSE__CACHE_:
- sorry ("Clause not supported yet");
- break;
-
default:
gcc_unreachable ();
}
diff --git gcc/testsuite/ChangeLog gcc/testsuite/ChangeLog
index ae3f462..e15b009 100644
--- gcc/testsuite/ChangeLog
+++ gcc/testsuite/ChangeLog
@@ -1,3 +1,16 @@
+2016-06-10 Thomas Schwinge <thomas@codesourcery.com>
+
+ PR c/71381
+ * c-c++-common/goacc/cache-1.c: Update. Move invalid usage tests
+ to...
+ * c-c++-common/goacc/cache-2.c: ... this new file.
+ * gfortran.dg/goacc/cache-1.f95: Move invalid usage tests to...
+ * gfortran.dg/goacc/cache-2.f95: ... this new file.
+ * gfortran.dg/goacc/coarray.f95: Update OpenACC cache directive
+ usage.
+ * gfortran.dg/goacc/cray.f95: Likewise.
+ * gfortran.dg/goacc/loop-1.f95: Likewise.
+
2016-06-10 Alan Hayward <alan.hayward@arm.com>
PR tree-optimization/71407
diff --git gcc/testsuite/c-c++-common/goacc/cache-1.c gcc/testsuite/c-c++-common/goacc/cache-1.c
index 9503341..1d4759e 100644
--- gcc/testsuite/c-c++-common/goacc/cache-1.c
+++ gcc/testsuite/c-c++-common/goacc/cache-1.c
@@ -1,3 +1,7 @@
+/* OpenACC cache directive: valid usage. */
+/* For execution testing, this file is "#include"d from
+ libgomp/testsuite/libgomp.oacc-c-c++-common/cache-1.c. */
+
int
main (int argc, char **argv)
{
@@ -21,57 +25,31 @@ main (int argc, char **argv)
int n = 1;
const int len = n;
-#pragma acc cache /* { dg-error "expected '\\\(' before end of line" } */
-
-#pragma acc cache a[0:N] /* { dg-error "expected '\\\(' before 'a'" } */
- /* { dg-bogus "expected end of line before 'a'" "" { xfail c++ } 26 } */
-
-#pragma acc cache (a) /* { dg-error "expected '\\\['" } */
-
-#pragma acc cache ( /* { dg-error "expected (identifier|unqualified-id) before end of line" } */
-
-#pragma acc cache () /* { dg-error "expected (identifier|unqualified-id) before '\\\)' token" } */
-
-#pragma acc cache (,) /* { dg-error "expected (identifier|unqualified-id) before '(,|\\\))' token" } */
-
-#pragma acc cache (a[0:N] /* { dg-error "expected '\\\)' before end of line" } */
-
-#pragma acc cache (a[0:N],) /* { dg-error "expected (identifier|unqualified-id) before '(,|\\\))' token" "" { xfail c } } */
-
-#pragma acc cache (a[0:N]) copyin (a[0:N]) /* { dg-error "expected end of line before 'copyin'" } */
-
-#pragma acc cache () /* { dg-error "expected (identifier|unqualified-id) before '\\\)' token" } */
-
-#pragma acc cache (a[0:N] b[0:N]) /* { dg-error "expected '\\\)' before 'b'" } */
-
-#pragma acc cache (a[0:N] b[0:N}) /* { dg-error "expected '\\\)' before 'b'" } */
- /* { dg-bogus "expected end of line before '\\\}' token" "" { xfail c++ } 47 } */
-
-#pragma acc cache (a[0:N] /* { dg-error "expected '\\\)' before end of line" } */
-
-#pragma acc cache (a[ii]) /* { dg-error "'ii' is not a constant" } */
-
-#pragma acc cache (a[idx:n]) /* { dg-error "'n' is not a constant" } */
-
-#pragma acc cache (a[0:N]) ( /* { dg-error "expected end of line before '\\(' token" } */
-
-#pragma acc cache (a[0:N]) ii /* { dg-error "expected end of line before 'ii'" } */
-
-#pragma acc cache (a[0:N] ii) /* { dg-error "expected '\\)' before 'ii'" } */
-
+ /* Have at it, GCC! */
#pragma acc cache (a[0:N])
-
#pragma acc cache (a[0:N], a[0:N])
-
#pragma acc cache (a[0:N], b[0:N])
-
#pragma acc cache (a[0])
-
#pragma acc cache (a[0], a[1], b[0:N])
-
+#pragma acc cache (a[i - 5])
+#pragma acc cache (a[i + 5:len])
+#pragma acc cache (a[i + 5:len - 1])
+#pragma acc cache (b[i])
+#pragma acc cache (b[i:len])
+#pragma acc cache (a[ii])
+#pragma acc cache (a[ii:len])
+#pragma acc cache (b[ii - 1])
+#pragma acc cache (b[ii - 1:len])
+#pragma acc cache (b[i - ii + 1])
+#pragma acc cache (b[i + ii - 1:len])
+#pragma acc cache (b[i * ii - 1:len + 1])
+#pragma acc cache (a[idx + 2])
+#pragma acc cache (a[idx:len + 2])
#pragma acc cache (a[idx])
-
#pragma acc cache (a[idx:len])
+#pragma acc cache (a[idx + 2:len])
+#pragma acc cache (a[idx + 2 + i:len])
+#pragma acc cache (a[idx + 2 + i + ii:len])
b[ii] = a[ii];
}
diff --git gcc/testsuite/c-c++-common/goacc/cache-1.c gcc/testsuite/c-c++-common/goacc/cache-2.c
similarity index 83%
copy from gcc/testsuite/c-c++-common/goacc/cache-1.c
copy to gcc/testsuite/c-c++-common/goacc/cache-2.c
index 9503341..f717515 100644
--- gcc/testsuite/c-c++-common/goacc/cache-1.c
+++ gcc/testsuite/c-c++-common/goacc/cache-2.c
@@ -1,3 +1,5 @@
+/* OpenACC cache directive: invalid usage. */
+
int
main (int argc, char **argv)
{
@@ -22,57 +24,24 @@ main (int argc, char **argv)
const int len = n;
#pragma acc cache /* { dg-error "expected '\\\(' before end of line" } */
-
#pragma acc cache a[0:N] /* { dg-error "expected '\\\(' before 'a'" } */
- /* { dg-bogus "expected end of line before 'a'" "" { xfail c++ } 26 } */
-
+ /* { dg-bogus "expected end of line before 'a'" "" { xfail c++ } 27 } */
#pragma acc cache (a) /* { dg-error "expected '\\\['" } */
-
#pragma acc cache ( /* { dg-error "expected (identifier|unqualified-id) before end of line" } */
-
#pragma acc cache () /* { dg-error "expected (identifier|unqualified-id) before '\\\)' token" } */
-
#pragma acc cache (,) /* { dg-error "expected (identifier|unqualified-id) before '(,|\\\))' token" } */
-
#pragma acc cache (a[0:N] /* { dg-error "expected '\\\)' before end of line" } */
-
#pragma acc cache (a[0:N],) /* { dg-error "expected (identifier|unqualified-id) before '(,|\\\))' token" "" { xfail c } } */
-
#pragma acc cache (a[0:N]) copyin (a[0:N]) /* { dg-error "expected end of line before 'copyin'" } */
-
#pragma acc cache () /* { dg-error "expected (identifier|unqualified-id) before '\\\)' token" } */
-
#pragma acc cache (a[0:N] b[0:N]) /* { dg-error "expected '\\\)' before 'b'" } */
-
#pragma acc cache (a[0:N] b[0:N}) /* { dg-error "expected '\\\)' before 'b'" } */
- /* { dg-bogus "expected end of line before '\\\}' token" "" { xfail c++ } 47 } */
-
+ /* { dg-bogus "expected end of line before '\\\}' token" "" { xfail c++ } 38 } */
#pragma acc cache (a[0:N] /* { dg-error "expected '\\\)' before end of line" } */
-
-#pragma acc cache (a[ii]) /* { dg-error "'ii' is not a constant" } */
-
-#pragma acc cache (a[idx:n]) /* { dg-error "'n' is not a constant" } */
-
#pragma acc cache (a[0:N]) ( /* { dg-error "expected end of line before '\\(' token" } */
-
#pragma acc cache (a[0:N]) ii /* { dg-error "expected end of line before 'ii'" } */
-
#pragma acc cache (a[0:N] ii) /* { dg-error "expected '\\)' before 'ii'" } */
-#pragma acc cache (a[0:N])
-
-#pragma acc cache (a[0:N], a[0:N])
-
-#pragma acc cache (a[0:N], b[0:N])
-
-#pragma acc cache (a[0])
-
-#pragma acc cache (a[0], a[1], b[0:N])
-
-#pragma acc cache (a[idx])
-
-#pragma acc cache (a[idx:len])
-
b[ii] = a[ii];
}
}
diff --git gcc/testsuite/gfortran.dg/goacc/cache-1.f95 gcc/testsuite/gfortran.dg/goacc/cache-1.f95
index 2aa9e05..39fbf2c 100644
--- gcc/testsuite/gfortran.dg/goacc/cache-1.f95
+++ gcc/testsuite/gfortran.dg/goacc/cache-1.f95
@@ -1,4 +1,6 @@
-! { dg-do compile }
+! OpenACC cache directive: valid usage.
+! For execution testing, this file is "#include"d from
+! libgomp/testsuite/libgomp.oacc-fortran/cache-1.f95.
! { dg-additional-options "-std=f2008" }
program test
@@ -6,11 +8,8 @@ program test
integer :: i, d(10), e(5,13)
do concurrent (i=1:5)
- !$acc cache (d)
!$acc cache (d(1:3))
!$acc cache (d(i:i+2))
-
- !$acc cache (e)
!$acc cache (e(1:3,2:4))
!$acc cache (e(i:i+2,i+1:i+3))
enddo
diff --git gcc/testsuite/gfortran.dg/goacc/cache-2.f95 gcc/testsuite/gfortran.dg/goacc/cache-2.f95
new file mode 100644
index 0000000..be81878
--- /dev/null
+++ gcc/testsuite/gfortran.dg/goacc/cache-2.f95
@@ -0,0 +1,12 @@
+! OpenACC cache directive: invalid usage.
+! { dg-additional-options "-std=f2008" }
+
+program test
+ implicit none
+ integer :: i, d(10), e(5,13)
+
+ do concurrent (i=1:5)
+ !$acc cache (d) ! { dg-error "" "TODO" { xfail *-*-* } }
+ !$acc cache (e) ! { dg-error "" "TODO" { xfail *-*-* } }
+ enddo
+end
diff --git gcc/testsuite/gfortran.dg/goacc/coarray.f95 gcc/testsuite/gfortran.dg/goacc/coarray.f95
index 932e1f7..f30917b8 100644
--- gcc/testsuite/gfortran.dg/goacc/coarray.f95
+++ gcc/testsuite/gfortran.dg/goacc/coarray.f95
@@ -24,7 +24,7 @@ contains
!$acc end parallel loop
!$acc parallel loop
do i = 1,5
- !$acc cache (a)
+ !$acc cache (a) ! { dg-error "" "TODO" { xfail *-*-* } }
enddo
!$acc end parallel loop
!$acc update device (a)
diff --git gcc/testsuite/gfortran.dg/goacc/cray.f95 gcc/testsuite/gfortran.dg/goacc/cray.f95
index a35ab0d..705c18c 100644
--- gcc/testsuite/gfortran.dg/goacc/cray.f95
+++ gcc/testsuite/gfortran.dg/goacc/cray.f95
@@ -44,7 +44,8 @@ contains
!$acc end parallel loop
!$acc parallel loop
do i = 1,5
- !$acc cache (ptr) ! TODO: This must fail, as in openacc-1_0-branch
+ !TODO: This must fail, as in openacc-1_0-branch.
+ !$acc cache (ptr) ! { dg-error "" "TODO" { xfail *-*-* } }
enddo
!$acc end parallel loop
!$acc update device (ptr)
diff --git gcc/testsuite/gfortran.dg/goacc/loop-1.f95 gcc/testsuite/gfortran.dg/goacc/loop-1.f95
index b5f9e03..a605f03 100644
--- gcc/testsuite/gfortran.dg/goacc/loop-1.f95
+++ gcc/testsuite/gfortran.dg/goacc/loop-1.f95
@@ -158,15 +158,16 @@ subroutine test1
enddo
- !$acc cache (a) ! { dg-error "inside of loop" }
+ !$acc cache (a(1:10)) ! { dg-error "ACC CACHE directive must be inside of loop" }
do i = 1,10
- !$acc cache(a)
+ !$acc cache(a(i:i+1))
enddo
do i = 1,10
+ !$acc cache(a(i:i+1))
a(i) = i
- !$acc cache(a)
+ !$acc cache(a(i+2:i+2+1))
enddo
end subroutine test1
diff --git libgomp/ChangeLog libgomp/ChangeLog
index f6d7dd2..5c7f41a 100644
--- libgomp/ChangeLog
+++ libgomp/ChangeLog
@@ -1,3 +1,10 @@
+2016-06-10 Thomas Schwinge <thomas@codesourcery.com>
+
+ PR c/71381
+ * testsuite/libgomp.oacc-c-c++-common/cache-1.c: #include
+ "../../../gcc/testsuite/c-c++-common/goacc/cache-1.c".
+ * testsuite/libgomp.oacc-fortran/cache-1.f95: New file.
+
2016-06-03 Chung-Lin Tang <cltang@codesourcery.com>
* testsuite/libgomp.oacc-fortran/reduction-8.f90: New testcase.
diff --git libgomp/testsuite/libgomp.oacc-c-c++-common/cache-1.c libgomp/testsuite/libgomp.oacc-c-c++-common/cache-1.c
index 3f1f0bb..16aaed5 100644
--- libgomp/testsuite/libgomp.oacc-c-c++-common/cache-1.c
+++ libgomp/testsuite/libgomp.oacc-c-c++-common/cache-1.c
@@ -1,48 +1,3 @@
-int
-main (int argc, char **argv)
-{
-#define N 2
- int a[N], b[N];
- int i;
+/* OpenACC cache directive. */
- for (i = 0; i < N; i++)
- {
- a[i] = 3;
- b[i] = 0;
- }
-
-#pragma acc parallel copyin (a[0:N]) copyout (b[0:N])
-{
- int ii;
-
- for (ii = 0; ii < N; ii++)
- {
- const int idx = ii;
- int n = 1;
- const int len = n;
-
-#pragma acc cache (a[0:N])
-
-#pragma acc cache (a[0:N], b[0:N])
-
-#pragma acc cache (a[0])
-
-#pragma acc cache (a[0], a[1], b[0:N])
-
-#pragma acc cache (a[idx])
-
-#pragma acc cache (a[idx:len])
-
- b[ii] = a[ii];
- }
-}
-
-
- for (i = 0; i < N; i++)
- {
- if (a[i] != b[i])
- __builtin_abort ();
- }
-
- return 0;
-}
+#include "../../../gcc/testsuite/c-c++-common/goacc/cache-1.c"
diff --git libgomp/testsuite/libgomp.oacc-fortran/cache-1.f95 libgomp/testsuite/libgomp.oacc-fortran/cache-1.f95
new file mode 100644
index 0000000..37313d8
--- /dev/null
+++ libgomp/testsuite/libgomp.oacc-fortran/cache-1.f95
@@ -0,0 +1,6 @@
+! OpenACC cache directive.
+! { dg-do run }
+! { dg-additional-options "-std=f2008" }
+! { dg-additional-options "-cpp" }
+
+#include "../../../gcc/testsuite/gfortran.dg/goacc/cache-1.f95"
commit 11334cfa66bcb2a2096e02c3d5bf92e0068f3909
Author: tschwinge <tschwinge@138bc75d-0d04-0410-961f-82ee72b054a4>
Date: Fri Jun 10 09:46:04 2016 +0000
[PR c/71381] C/C++ OpenACC cache directive rejects valid syntax
Backport trunk r237290:
gcc/c/
PR c/71381
* c-parser.c (c_parser_omp_variable_list) <OMP_CLAUSE__CACHE_>:
Loosen checking.
gcc/cp/
PR c/71381
* parser.c (cp_parser_omp_var_list_no_open) <OMP_CLAUSE__CACHE_>:
Loosen checking.
gcc/fortran/
PR c/71381
* openmp.c (gfc_match_oacc_cache): Add comment.
gcc/testsuite/
PR c/71381
* c-c++-common/goacc/cache-1.c: Update. Move invalid usage tests
to...
* c-c++-common/goacc/cache-2.c: ... this new file.
* gfortran.dg/goacc/cache-1.f95: Move invalid usage tests to...
* gfortran.dg/goacc/cache-2.f95: ... this new file.
* gfortran.dg/goacc/coarray.f95: Update OpenACC cache directive
usage.
* gfortran.dg/goacc/cray.f95: Likewise.
* gfortran.dg/goacc/loop-1.f95: Likewise.
libgomp/
PR c/71381
* testsuite/libgomp.oacc-c-c++-common/cache-1.c: #include
"../../../gcc/testsuite/c-c++-common/goacc/cache-1.c".
* testsuite/libgomp.oacc-fortran/cache-1.f95: New file.
gcc/
* omp-low.c (scan_sharing_clauses): Don't expect
OMP_CLAUSE__CACHE_.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/branches/gcc-6-branch@237295 138bc75d-0d04-0410-961f-82ee72b054a4
---
gcc/ChangeLog | 4 ++
gcc/c/ChangeLog | 7 +++
gcc/c/c-parser.c | 21 +------
gcc/cp/ChangeLog | 7 +++
gcc/cp/parser.c | 21 +------
gcc/fortran/ChangeLog | 6 ++
gcc/fortran/openmp.c | 4 ++
gcc/omp-low.c | 6 --
gcc/testsuite/ChangeLog | 14 +++++
gcc/testsuite/c-c++-common/goacc/cache-1.c | 66 ++++++++--------------
.../c-c++-common/goacc/{cache-1.c => cache-2.c} | 39 ++-----------
gcc/testsuite/gfortran.dg/goacc/cache-1.f95 | 7 +--
gcc/testsuite/gfortran.dg/goacc/cache-2.f95 | 12 ++++
gcc/testsuite/gfortran.dg/goacc/coarray.f95 | 2 +-
gcc/testsuite/gfortran.dg/goacc/cray.f95 | 3 +-
gcc/testsuite/gfortran.dg/goacc/loop-1.f95 | 7 ++-
libgomp/ChangeLog | 8 +++
.../testsuite/libgomp.oacc-c-c++-common/cache-1.c | 49 +---------------
libgomp/testsuite/libgomp.oacc-fortran/cache-1.f95 | 6 ++
19 files changed, 110 insertions(+), 179 deletions(-)
diff --git gcc/ChangeLog gcc/ChangeLog
index 4b7b8f6..cbdcc42 100644
--- gcc/ChangeLog
+++ gcc/ChangeLog
@@ -1,5 +1,9 @@
2016-06-10 Thomas Schwinge <thomas@codesourcery.com>
+ Backport from trunk r237290:
+ * omp-low.c (scan_sharing_clauses): Don't expect
+ OMP_CLAUSE__CACHE_.
+
Backport trunk r235964:
2016-05-06 Nathan Sidwell <nathan@codesourcery.com>
diff --git gcc/c/ChangeLog gcc/c/ChangeLog
index fc89216..7edb380 100644
--- gcc/c/ChangeLog
+++ gcc/c/ChangeLog
@@ -1,3 +1,10 @@
+2016-06-10 Thomas Schwinge <thomas@codesourcery.com>
+
+ PR c/71381
+ Backport from trunk r237290:
+ * c-parser.c (c_parser_omp_variable_list) <OMP_CLAUSE__CACHE_>:
+ Loosen checking.
+
2016-05-30 Jakub Jelinek <jakub@redhat.com>
PR c++/71349
diff --git gcc/c/c-parser.c gcc/c/c-parser.c
index 77c49a1..c9eb8dd 100644
--- gcc/c/c-parser.c
+++ gcc/c/c-parser.c
@@ -10595,6 +10595,8 @@ c_parser_omp_variable_list (c_parser *parser,
switch (kind)
{
case OMP_CLAUSE__CACHE_:
+ /* The OpenACC cache directive explicitly only allows "array
+ elements or subarrays". */
if (c_parser_peek_token (parser)->type != CPP_OPEN_SQUARE)
{
c_parser_error (parser, "expected %<[%>");
@@ -10657,25 +10659,6 @@ c_parser_omp_variable_list (c_parser *parser,
break;
}
- if (kind == OMP_CLAUSE__CACHE_)
- {
- if (TREE_CODE (low_bound) != INTEGER_CST
- && !TREE_READONLY (low_bound))
- {
- error_at (clause_loc,
- "%qD is not a constant", low_bound);
- t = error_mark_node;
- }
-
- if (TREE_CODE (length) != INTEGER_CST
- && !TREE_READONLY (length))
- {
- error_at (clause_loc,
- "%qD is not a constant", length);
- t = error_mark_node;
- }
- }
-
t = tree_cons (low_bound, length, t);
}
break;
diff --git gcc/cp/ChangeLog gcc/cp/ChangeLog
index a55f04e..8fb22e8 100644
--- gcc/cp/ChangeLog
+++ gcc/cp/ChangeLog
@@ -1,3 +1,10 @@
+2016-06-10 Thomas Schwinge <thomas@codesourcery.com>
+
+ PR c/71381
+ Backport from trunk r237290:
+ * parser.c (cp_parser_omp_var_list_no_open) <OMP_CLAUSE__CACHE_>:
+ Loosen checking.
+
2016-06-08 Jakub Jelinek <jakub@redhat.com>
PR c++/71442
diff --git gcc/cp/parser.c gcc/cp/parser.c
index f626a5d..f59b03a 100644
--- gcc/cp/parser.c
+++ gcc/cp/parser.c
@@ -29964,6 +29964,8 @@ cp_parser_omp_var_list_no_open (cp_parser *parser, enum omp_clause_code kind,
switch (kind)
{
case OMP_CLAUSE__CACHE_:
+ /* The OpenACC cache directive explicitly only allows "array
+ elements or subarrays". */
if (cp_lexer_peek_token (parser->lexer)->type != CPP_OPEN_SQUARE)
{
error_at (token->location, "expected %<[%>");
@@ -30015,25 +30017,6 @@ cp_parser_omp_var_list_no_open (cp_parser *parser, enum omp_clause_code kind,
RT_CLOSE_SQUARE))
goto skip_comma;
- if (kind == OMP_CLAUSE__CACHE_)
- {
- if (TREE_CODE (low_bound) != INTEGER_CST
- && !TREE_READONLY (low_bound))
- {
- error_at (token->location,
- "%qD is not a constant", low_bound);
- decl = error_mark_node;
- }
-
- if (TREE_CODE (length) != INTEGER_CST
- && !TREE_READONLY (length))
- {
- error_at (token->location,
- "%qD is not a constant", length);
- decl = error_mark_node;
- }
- }
-
decl = tree_cons (low_bound, length, decl);
}
break;
diff --git gcc/fortran/ChangeLog gcc/fortran/ChangeLog
index 5a21c9b..de67856 100644
--- gcc/fortran/ChangeLog
+++ gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2016-06-10 Thomas Schwinge <thomas@codesourcery.com>
+
+ PR c/71381
+ Backport from trunk r237290:
+ * openmp.c (gfc_match_oacc_cache): Add comment.
+
2016-06-05 Andre Vehreschild <vehre@gcc.gnu.org>
PR fortran/69659
diff --git gcc/fortran/openmp.c gcc/fortran/openmp.c
index 0dd1a92..be70318 100644
--- gcc/fortran/openmp.c
+++ gcc/fortran/openmp.c
@@ -1623,6 +1623,10 @@ match
gfc_match_oacc_cache (void)
{
gfc_omp_clauses *c = gfc_get_omp_clauses ();
+ /* The OpenACC cache directive explicitly only allows "array elements or
+ subarrays", which we're currently not checking here. Either check this
+ after the call of gfc_match_omp_variable_list, or add something like a
+ only_sections variant next to its allow_sections parameter. */
match m = gfc_match_omp_variable_list (" (",
&c->lists[OMP_LIST_CACHE], true,
NULL, NULL, true);
diff --git gcc/omp-low.c gcc/omp-low.c
index 4ad2625..e570c22 100644
--- gcc/omp-low.c
+++ gcc/omp-low.c
@@ -2201,9 +2201,6 @@ scan_sharing_clauses (tree clauses, omp_context *ctx,
case OMP_CLAUSE_DEVICE_RESIDENT:
case OMP_CLAUSE__CACHE_:
- sorry ("Clause not supported yet");
- break;
-
default:
gcc_unreachable ();
}
@@ -2369,9 +2366,6 @@ scan_sharing_clauses (tree clauses, omp_context *ctx,
case OMP_CLAUSE_DEVICE_RESIDENT:
case OMP_CLAUSE__CACHE_:
- sorry ("Clause not supported yet");
- break;
-
default:
gcc_unreachable ();
}
diff --git gcc/testsuite/ChangeLog gcc/testsuite/ChangeLog
index 8437f84..5e3f7e3 100644
--- gcc/testsuite/ChangeLog
+++ gcc/testsuite/ChangeLog
@@ -1,3 +1,17 @@
+2016-06-10 Thomas Schwinge <thomas@codesourcery.com>
+
+ PR c/71381
+ Backport from trunk r237290:
+ * c-c++-common/goacc/cache-1.c: Update. Move invalid usage tests
+ to...
+ * c-c++-common/goacc/cache-2.c: ... this new file.
+ * gfortran.dg/goacc/cache-1.f95: Move invalid usage tests to...
+ * gfortran.dg/goacc/cache-2.f95: ... this new file.
+ * gfortran.dg/goacc/coarray.f95: Update OpenACC cache directive
+ usage.
+ * gfortran.dg/goacc/cray.f95: Likewise.
+ * gfortran.dg/goacc/loop-1.f95: Likewise.
+
2016-06-09 Michael Meissner <meissner@linux.vnet.ibm.com>
Back port from trunk
diff --git gcc/testsuite/c-c++-common/goacc/cache-1.c gcc/testsuite/c-c++-common/goacc/cache-1.c
index 9503341..1d4759e 100644
--- gcc/testsuite/c-c++-common/goacc/cache-1.c
+++ gcc/testsuite/c-c++-common/goacc/cache-1.c
@@ -1,3 +1,7 @@
+/* OpenACC cache directive: valid usage. */
+/* For execution testing, this file is "#include"d from
+ libgomp/testsuite/libgomp.oacc-c-c++-common/cache-1.c. */
+
int
main (int argc, char **argv)
{
@@ -21,57 +25,31 @@ main (int argc, char **argv)
int n = 1;
const int len = n;
-#pragma acc cache /* { dg-error "expected '\\\(' before end of line" } */
-
-#pragma acc cache a[0:N] /* { dg-error "expected '\\\(' before 'a'" } */
- /* { dg-bogus "expected end of line before 'a'" "" { xfail c++ } 26 } */
-
-#pragma acc cache (a) /* { dg-error "expected '\\\['" } */
-
-#pragma acc cache ( /* { dg-error "expected (identifier|unqualified-id) before end of line" } */
-
-#pragma acc cache () /* { dg-error "expected (identifier|unqualified-id) before '\\\)' token" } */
-
-#pragma acc cache (,) /* { dg-error "expected (identifier|unqualified-id) before '(,|\\\))' token" } */
-
-#pragma acc cache (a[0:N] /* { dg-error "expected '\\\)' before end of line" } */
-
-#pragma acc cache (a[0:N],) /* { dg-error "expected (identifier|unqualified-id) before '(,|\\\))' token" "" { xfail c } } */
-
-#pragma acc cache (a[0:N]) copyin (a[0:N]) /* { dg-error "expected end of line before 'copyin'" } */
-
-#pragma acc cache () /* { dg-error "expected (identifier|unqualified-id) before '\\\)' token" } */
-
-#pragma acc cache (a[0:N] b[0:N]) /* { dg-error "expected '\\\)' before 'b'" } */
-
-#pragma acc cache (a[0:N] b[0:N}) /* { dg-error "expected '\\\)' before 'b'" } */
- /* { dg-bogus "expected end of line before '\\\}' token" "" { xfail c++ } 47 } */
-
-#pragma acc cache (a[0:N] /* { dg-error "expected '\\\)' before end of line" } */
-
-#pragma acc cache (a[ii]) /* { dg-error "'ii' is not a constant" } */
-
-#pragma acc cache (a[idx:n]) /* { dg-error "'n' is not a constant" } */
-
-#pragma acc cache (a[0:N]) ( /* { dg-error "expected end of line before '\\(' token" } */
-
-#pragma acc cache (a[0:N]) ii /* { dg-error "expected end of line before 'ii'" } */
-
-#pragma acc cache (a[0:N] ii) /* { dg-error "expected '\\)' before 'ii'" } */
-
+ /* Have at it, GCC! */
#pragma acc cache (a[0:N])
-
#pragma acc cache (a[0:N], a[0:N])
-
#pragma acc cache (a[0:N], b[0:N])
-
#pragma acc cache (a[0])
-
#pragma acc cache (a[0], a[1], b[0:N])
-
+#pragma acc cache (a[i - 5])
+#pragma acc cache (a[i + 5:len])
+#pragma acc cache (a[i + 5:len - 1])
+#pragma acc cache (b[i])
+#pragma acc cache (b[i:len])
+#pragma acc cache (a[ii])
+#pragma acc cache (a[ii:len])
+#pragma acc cache (b[ii - 1])
+#pragma acc cache (b[ii - 1:len])
+#pragma acc cache (b[i - ii + 1])
+#pragma acc cache (b[i + ii - 1:len])
+#pragma acc cache (b[i * ii - 1:len + 1])
+#pragma acc cache (a[idx + 2])
+#pragma acc cache (a[idx:len + 2])
#pragma acc cache (a[idx])
-
#pragma acc cache (a[idx:len])
+#pragma acc cache (a[idx + 2:len])
+#pragma acc cache (a[idx + 2 + i:len])
+#pragma acc cache (a[idx + 2 + i + ii:len])
b[ii] = a[ii];
}
diff --git gcc/testsuite/c-c++-common/goacc/cache-1.c gcc/testsuite/c-c++-common/goacc/cache-2.c
similarity index 83%
copy from gcc/testsuite/c-c++-common/goacc/cache-1.c
copy to gcc/testsuite/c-c++-common/goacc/cache-2.c
index 9503341..f717515 100644
--- gcc/testsuite/c-c++-common/goacc/cache-1.c
+++ gcc/testsuite/c-c++-common/goacc/cache-2.c
@@ -1,3 +1,5 @@
+/* OpenACC cache directive: invalid usage. */
+
int
main (int argc, char **argv)
{
@@ -22,57 +24,24 @@ main (int argc, char **argv)
const int len = n;
#pragma acc cache /* { dg-error "expected '\\\(' before end of line" } */
-
#pragma acc cache a[0:N] /* { dg-error "expected '\\\(' before 'a'" } */
- /* { dg-bogus "expected end of line before 'a'" "" { xfail c++ } 26 } */
-
+ /* { dg-bogus "expected end of line before 'a'" "" { xfail c++ } 27 } */
#pragma acc cache (a) /* { dg-error "expected '\\\['" } */
-
#pragma acc cache ( /* { dg-error "expected (identifier|unqualified-id) before end of line" } */
-
#pragma acc cache () /* { dg-error "expected (identifier|unqualified-id) before '\\\)' token" } */
-
#pragma acc cache (,) /* { dg-error "expected (identifier|unqualified-id) before '(,|\\\))' token" } */
-
#pragma acc cache (a[0:N] /* { dg-error "expected '\\\)' before end of line" } */
-
#pragma acc cache (a[0:N],) /* { dg-error "expected (identifier|unqualified-id) before '(,|\\\))' token" "" { xfail c } } */
-
#pragma acc cache (a[0:N]) copyin (a[0:N]) /* { dg-error "expected end of line before 'copyin'" } */
-
#pragma acc cache () /* { dg-error "expected (identifier|unqualified-id) before '\\\)' token" } */
-
#pragma acc cache (a[0:N] b[0:N]) /* { dg-error "expected '\\\)' before 'b'" } */
-
#pragma acc cache (a[0:N] b[0:N}) /* { dg-error "expected '\\\)' before 'b'" } */
- /* { dg-bogus "expected end of line before '\\\}' token" "" { xfail c++ } 47 } */
-
+ /* { dg-bogus "expected end of line before '\\\}' token" "" { xfail c++ } 38 } */
#pragma acc cache (a[0:N] /* { dg-error "expected '\\\)' before end of line" } */
-
-#pragma acc cache (a[ii]) /* { dg-error "'ii' is not a constant" } */
-
-#pragma acc cache (a[idx:n]) /* { dg-error "'n' is not a constant" } */
-
#pragma acc cache (a[0:N]) ( /* { dg-error "expected end of line before '\\(' token" } */
-
#pragma acc cache (a[0:N]) ii /* { dg-error "expected end of line before 'ii'" } */
-
#pragma acc cache (a[0:N] ii) /* { dg-error "expected '\\)' before 'ii'" } */
-#pragma acc cache (a[0:N])
-
-#pragma acc cache (a[0:N], a[0:N])
-
-#pragma acc cache (a[0:N], b[0:N])
-
-#pragma acc cache (a[0])
-
-#pragma acc cache (a[0], a[1], b[0:N])
-
-#pragma acc cache (a[idx])
-
-#pragma acc cache (a[idx:len])
-
b[ii] = a[ii];
}
}
diff --git gcc/testsuite/gfortran.dg/goacc/cache-1.f95 gcc/testsuite/gfortran.dg/goacc/cache-1.f95
index 2aa9e05..39fbf2c 100644
--- gcc/testsuite/gfortran.dg/goacc/cache-1.f95
+++ gcc/testsuite/gfortran.dg/goacc/cache-1.f95
@@ -1,4 +1,6 @@
-! { dg-do compile }
+! OpenACC cache directive: valid usage.
+! For execution testing, this file is "#include"d from
+! libgomp/testsuite/libgomp.oacc-fortran/cache-1.f95.
! { dg-additional-options "-std=f2008" }
program test
@@ -6,11 +8,8 @@ program test
integer :: i, d(10), e(5,13)
do concurrent (i=1:5)
- !$acc cache (d)
!$acc cache (d(1:3))
!$acc cache (d(i:i+2))
-
- !$acc cache (e)
!$acc cache (e(1:3,2:4))
!$acc cache (e(i:i+2,i+1:i+3))
enddo
diff --git gcc/testsuite/gfortran.dg/goacc/cache-2.f95 gcc/testsuite/gfortran.dg/goacc/cache-2.f95
new file mode 100644
index 0000000..be81878
--- /dev/null
+++ gcc/testsuite/gfortran.dg/goacc/cache-2.f95
@@ -0,0 +1,12 @@
+! OpenACC cache directive: invalid usage.
+! { dg-additional-options "-std=f2008" }
+
+program test
+ implicit none
+ integer :: i, d(10), e(5,13)
+
+ do concurrent (i=1:5)
+ !$acc cache (d) ! { dg-error "" "TODO" { xfail *-*-* } }
+ !$acc cache (e) ! { dg-error "" "TODO" { xfail *-*-* } }
+ enddo
+end
diff --git gcc/testsuite/gfortran.dg/goacc/coarray.f95 gcc/testsuite/gfortran.dg/goacc/coarray.f95
index 932e1f7..f30917b8 100644
--- gcc/testsuite/gfortran.dg/goacc/coarray.f95
+++ gcc/testsuite/gfortran.dg/goacc/coarray.f95
@@ -24,7 +24,7 @@ contains
!$acc end parallel loop
!$acc parallel loop
do i = 1,5
- !$acc cache (a)
+ !$acc cache (a) ! { dg-error "" "TODO" { xfail *-*-* } }
enddo
!$acc end parallel loop
!$acc update device (a)
diff --git gcc/testsuite/gfortran.dg/goacc/cray.f95 gcc/testsuite/gfortran.dg/goacc/cray.f95
index a35ab0d..705c18c 100644
--- gcc/testsuite/gfortran.dg/goacc/cray.f95
+++ gcc/testsuite/gfortran.dg/goacc/cray.f95
@@ -44,7 +44,8 @@ contains
!$acc end parallel loop
!$acc parallel loop
do i = 1,5
- !$acc cache (ptr) ! TODO: This must fail, as in openacc-1_0-branch
+ !TODO: This must fail, as in openacc-1_0-branch.
+ !$acc cache (ptr) ! { dg-error "" "TODO" { xfail *-*-* } }
enddo
!$acc end parallel loop
!$acc update device (ptr)
diff --git gcc/testsuite/gfortran.dg/goacc/loop-1.f95 gcc/testsuite/gfortran.dg/goacc/loop-1.f95
index b5f9e03..a605f03 100644
--- gcc/testsuite/gfortran.dg/goacc/loop-1.f95
+++ gcc/testsuite/gfortran.dg/goacc/loop-1.f95
@@ -158,15 +158,16 @@ subroutine test1
enddo
- !$acc cache (a) ! { dg-error "inside of loop" }
+ !$acc cache (a(1:10)) ! { dg-error "ACC CACHE directive must be inside of loop" }
do i = 1,10
- !$acc cache(a)
+ !$acc cache(a(i:i+1))
enddo
do i = 1,10
+ !$acc cache(a(i:i+1))
a(i) = i
- !$acc cache(a)
+ !$acc cache(a(i+2:i+2+1))
enddo
end subroutine test1
diff --git libgomp/ChangeLog libgomp/ChangeLog
index 7b124eb..f6da5c4 100644
--- libgomp/ChangeLog
+++ libgomp/ChangeLog
@@ -1,3 +1,11 @@
+2016-06-10 Thomas Schwinge <thomas@codesourcery.com>
+
+ PR c/71381
+ Backport from trunk r237290:
+ * testsuite/libgomp.oacc-c-c++-common/cache-1.c: #include
+ "../../../gcc/testsuite/c-c++-common/goacc/cache-1.c".
+ * testsuite/libgomp.oacc-fortran/cache-1.f95: New file.
+
2016-05-23 Martin Jambor <mjambor@suse.cz>
* testsuite/libgomp.hsa.c/switch-sbr-2.c: New test.
diff --git libgomp/testsuite/libgomp.oacc-c-c++-common/cache-1.c libgomp/testsuite/libgomp.oacc-c-c++-common/cache-1.c
index 3f1f0bb..16aaed5 100644
--- libgomp/testsuite/libgomp.oacc-c-c++-common/cache-1.c
+++ libgomp/testsuite/libgomp.oacc-c-c++-common/cache-1.c
@@ -1,48 +1,3 @@
-int
-main (int argc, char **argv)
-{
-#define N 2
- int a[N], b[N];
- int i;
+/* OpenACC cache directive. */
- for (i = 0; i < N; i++)
- {
- a[i] = 3;
- b[i] = 0;
- }
-
-#pragma acc parallel copyin (a[0:N]) copyout (b[0:N])
-{
- int ii;
-
- for (ii = 0; ii < N; ii++)
- {
- const int idx = ii;
- int n = 1;
- const int len = n;
-
-#pragma acc cache (a[0:N])
-
-#pragma acc cache (a[0:N], b[0:N])
-
-#pragma acc cache (a[0])
-
-#pragma acc cache (a[0], a[1], b[0:N])
-
-#pragma acc cache (a[idx])
-
-#pragma acc cache (a[idx:len])
-
- b[ii] = a[ii];
- }
-}
-
-
- for (i = 0; i < N; i++)
- {
- if (a[i] != b[i])
- __builtin_abort ();
- }
-
- return 0;
-}
+#include "../../../gcc/testsuite/c-c++-common/goacc/cache-1.c"
diff --git libgomp/testsuite/libgomp.oacc-fortran/cache-1.f95 libgomp/testsuite/libgomp.oacc-fortran/cache-1.f95
new file mode 100644
index 0000000..37313d8
--- /dev/null
+++ libgomp/testsuite/libgomp.oacc-fortran/cache-1.f95
@@ -0,0 +1,6 @@
+! OpenACC cache directive.
+! { dg-do run }
+! { dg-additional-options "-std=f2008" }
+! { dg-additional-options "-cpp" }
+
+#include "../../../gcc/testsuite/gfortran.dg/goacc/cache-1.f95"
commit ca3738135ba830829657e20b66f197616bbf733a
Author: tschwinge <tschwinge@138bc75d-0d04-0410-961f-82ee72b054a4>
Date: Fri Jun 10 10:12:22 2016 +0000
[PR c/71381] C/C++ OpenACC cache directive rejects valid syntax
libgomp/
PR c/71381
* testsuite/libgomp.oacc-fortran/cache-1.f90: Remove file.
Backport trunk r237290:
gcc/c/
PR c/71381
* c-parser.c (c_parser_omp_variable_list) <OMP_CLAUSE__CACHE_>:
Loosen checking.
gcc/cp/
PR c/71381
* parser.c (cp_parser_omp_var_list_no_open) <OMP_CLAUSE__CACHE_>:
Loosen checking.
gcc/fortran/
PR c/71381
* openmp.c (gfc_match_oacc_cache): Add comment.
gcc/testsuite/
PR c/71381
* c-c++-common/goacc/cache-1.c: Update. Move invalid usage tests
to...
* c-c++-common/goacc/cache-2.c: ... this new file.
* gfortran.dg/goacc/cache-1.f95: Move invalid usage tests to...
* gfortran.dg/goacc/cache-2.f95: ... this new file.
* gfortran.dg/goacc/coarray.f95: Update OpenACC cache directive
usage.
* gfortran.dg/goacc/cray.f95: Likewise.
* gfortran.dg/goacc/loop-1.f95: Likewise.
libgomp/
PR c/71381
* testsuite/libgomp.oacc-c-c++-common/cache-1.c: #include
"../../../gcc/testsuite/c-c++-common/goacc/cache-1.c".
* testsuite/libgomp.oacc-fortran/cache-1.f95: New file.
gcc/
* omp-low.c (scan_sharing_clauses): Don't expect
OMP_CLAUSE__CACHE_.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/branches/gomp-4_0-branch@237299 138bc75d-0d04-0410-961f-82ee72b054a4
---
gcc/ChangeLog.gomp | 6 ++
gcc/c/ChangeLog.gomp | 7 +++
gcc/c/c-parser.c | 21 +------
gcc/cp/ChangeLog.gomp | 7 +++
gcc/cp/parser.c | 21 +------
gcc/fortran/ChangeLog.gomp | 6 ++
gcc/fortran/openmp.c | 4 ++
gcc/omp-low.c | 14 ++---
gcc/testsuite/ChangeLog.gomp | 14 +++++
gcc/testsuite/c-c++-common/goacc/cache-1.c | 66 ++++++++--------------
.../c-c++-common/goacc/{cache-1.c => cache-2.c} | 39 ++-----------
gcc/testsuite/gfortran.dg/goacc/cache-1.f95 | 7 +--
gcc/testsuite/gfortran.dg/goacc/cache-2.f95 | 12 ++++
gcc/testsuite/gfortran.dg/goacc/coarray.f95 | 2 +-
gcc/testsuite/gfortran.dg/goacc/cray.f95 | 3 +-
gcc/testsuite/gfortran.dg/goacc/loop-1.f95 | 7 ++-
libgomp/ChangeLog.gomp | 9 +++
.../testsuite/libgomp.oacc-c-c++-common/cache-1.c | 49 +---------------
libgomp/testsuite/libgomp.oacc-fortran/cache-1.f90 | 30 ----------
libgomp/testsuite/libgomp.oacc-fortran/cache-1.f95 | 6 ++
20 files changed, 117 insertions(+), 213 deletions(-)
diff --git gcc/ChangeLog.gomp gcc/ChangeLog.gomp
index a73eff6..4477abf 100644
--- gcc/ChangeLog.gomp
+++ gcc/ChangeLog.gomp
@@ -1,3 +1,9 @@
+2016-06-10 Thomas Schwinge <thomas@codesourcery.com>
+
+ Backport from trunk r237290:
+ * omp-low.c (scan_sharing_clauses): Don't expect
+ OMP_CLAUSE__CACHE_.
+
2016-05-27 Cesar Philippidis <cesar@codesourcery.com>
Backport trunk r236678:
diff --git gcc/c/ChangeLog.gomp gcc/c/ChangeLog.gomp
index 26de504..aa2ba02 100644
--- gcc/c/ChangeLog.gomp
+++ gcc/c/ChangeLog.gomp
@@ -1,3 +1,10 @@
+2016-06-10 Thomas Schwinge <thomas@codesourcery.com>
+
+ PR c/71381
+ Backport from trunk r237290:
+ * c-parser.c (c_parser_omp_variable_list) <OMP_CLAUSE__CACHE_>:
+ Loosen checking.
+
2016-06-08 Chung-Lin Tang <cltang@codesourcery.com>
Backport trunk r237070:
diff --git gcc/c/c-parser.c gcc/c/c-parser.c
index 2f1c826..20b05d3 100644
--- gcc/c/c-parser.c
+++ gcc/c/c-parser.c
@@ -10634,6 +10634,8 @@ c_parser_omp_variable_list (c_parser *parser,
switch (kind)
{
case OMP_CLAUSE__CACHE_:
+ /* The OpenACC cache directive explicitly only allows "array
+ elements or subarrays". */
if (c_parser_peek_token (parser)->type != CPP_OPEN_SQUARE)
{
c_parser_error (parser, "expected %<[%>");
@@ -10696,25 +10698,6 @@ c_parser_omp_variable_list (c_parser *parser,
break;
}
- if (kind == OMP_CLAUSE__CACHE_)
- {
- if (TREE_CODE (low_bound) != INTEGER_CST
- && !TREE_READONLY (low_bound))
- {
- error_at (clause_loc,
- "%qD is not a constant", low_bound);
- t = error_mark_node;
- }
-
- if (TREE_CODE (length) != INTEGER_CST
- && !TREE_READONLY (length))
- {
- error_at (clause_loc,
- "%qD is not a constant", length);
- t = error_mark_node;
- }
- }
-
t = tree_cons (low_bound, length, t);
}
break;
diff --git gcc/cp/ChangeLog.gomp gcc/cp/ChangeLog.gomp
index b3fef78..f030a59 100644
--- gcc/cp/ChangeLog.gomp
+++ gcc/cp/ChangeLog.gomp
@@ -1,3 +1,10 @@
+2016-06-10 Thomas Schwinge <thomas@codesourcery.com>
+
+ PR c/71381
+ Backport from trunk r237290:
+ * parser.c (cp_parser_omp_var_list_no_open) <OMP_CLAUSE__CACHE_>:
+ Loosen checking.
+
2016-06-08 Chung-Lin Tang <cltang@codesourcery.com>
Backport trunk r237070:
diff --git gcc/cp/parser.c gcc/cp/parser.c
index 599ca77..53c7892 100644
--- gcc/cp/parser.c
+++ gcc/cp/parser.c
@@ -29960,6 +29960,8 @@ cp_parser_omp_var_list_no_open (cp_parser *parser, enum omp_clause_code kind,
switch (kind)
{
case OMP_CLAUSE__CACHE_:
+ /* The OpenACC cache directive explicitly only allows "array
+ elements or subarrays". */
if (cp_lexer_peek_token (parser->lexer)->type != CPP_OPEN_SQUARE)
{
error_at (token->location, "expected %<[%>");
@@ -30011,25 +30013,6 @@ cp_parser_omp_var_list_no_open (cp_parser *parser, enum omp_clause_code kind,
RT_CLOSE_SQUARE))
goto skip_comma;
- if (kind == OMP_CLAUSE__CACHE_)
- {
- if (TREE_CODE (low_bound) != INTEGER_CST
- && !TREE_READONLY (low_bound))
- {
- error_at (token->location,
- "%qD is not a constant", low_bound);
- decl = error_mark_node;
- }
-
- if (TREE_CODE (length) != INTEGER_CST
- && !TREE_READONLY (length))
- {
- error_at (token->location,
- "%qD is not a constant", length);
- decl = error_mark_node;
- }
- }
-
decl = tree_cons (low_bound, length, decl);
}
break;
diff --git gcc/fortran/ChangeLog.gomp gcc/fortran/ChangeLog.gomp
index 24fec48..527d088 100644
--- gcc/fortran/ChangeLog.gomp
+++ gcc/fortran/ChangeLog.gomp
@@ -1,3 +1,9 @@
+2016-06-10 Thomas Schwinge <thomas@codesourcery.com>
+
+ PR c/71381
+ Backport from trunk r237290:
+ * openmp.c (gfc_match_oacc_cache): Add comment.
+
2016-06-08 Chung-Lin Tang <cltang@codesourcery.com>
Backport trunk r237070:
diff --git gcc/fortran/openmp.c gcc/fortran/openmp.c
index a2a0e4b..cc4583d 100644
--- gcc/fortran/openmp.c
+++ gcc/fortran/openmp.c
@@ -1799,6 +1799,10 @@ match
gfc_match_oacc_cache (void)
{
gfc_omp_clauses *c = gfc_get_omp_clauses ();
+ /* The OpenACC cache directive explicitly only allows "array elements or
+ subarrays", which we're currently not checking here. Either check this
+ after the call of gfc_match_omp_variable_list, or add something like a
+ only_sections variant next to its allow_sections parameter. */
match m = gfc_match_omp_variable_list (" (",
&c->lists[OMP_LIST_CACHE], true,
NULL, NULL, true);
diff --git gcc/omp-low.c gcc/omp-low.c
index 200d331..40ac8c8 100644
--- gcc/omp-low.c
+++ gcc/omp-low.c
@@ -2232,13 +2232,10 @@ scan_sharing_clauses (tree clauses, omp_context *ctx,
install_var_local (decl, ctx);
break;
- case OMP_CLAUSE_DEVICE_RESIDENT:
- case OMP_CLAUSE__CACHE_:
- sorry ("Clause not supported yet");
- break;
-
case OMP_CLAUSE_BIND:
+ case OMP_CLAUSE_DEVICE_RESIDENT:
case OMP_CLAUSE_NOHOST:
+ case OMP_CLAUSE__CACHE_:
default:
gcc_unreachable ();
}
@@ -2403,13 +2400,10 @@ scan_sharing_clauses (tree clauses, omp_context *ctx,
case OMP_CLAUSE_DEVICE_TYPE:
break;
- case OMP_CLAUSE_DEVICE_RESIDENT:
- case OMP_CLAUSE__CACHE_:
- sorry ("Clause not supported yet");
- break;
-
case OMP_CLAUSE_BIND:
+ case OMP_CLAUSE_DEVICE_RESIDENT:
case OMP_CLAUSE_NOHOST:
+ case OMP_CLAUSE__CACHE_:
default:
gcc_unreachable ();
}
diff --git gcc/testsuite/ChangeLog.gomp gcc/testsuite/ChangeLog.gomp
index 41669bc..eef9425 100644
--- gcc/testsuite/ChangeLog.gomp
+++ gcc/testsuite/ChangeLog.gomp
@@ -1,3 +1,17 @@
+2016-06-10 Thomas Schwinge <thomas@codesourcery.com>
+
+ PR c/71381
+ Backport from trunk r237290:
+ * c-c++-common/goacc/cache-1.c: Update. Move invalid usage tests
+ to...
+ * c-c++-common/goacc/cache-2.c: ... this new file.
+ * gfortran.dg/goacc/cache-1.f95: Move invalid usage tests to...
+ * gfortran.dg/goacc/cache-2.f95: ... this new file.
+ * gfortran.dg/goacc/coarray.f95: Update OpenACC cache directive
+ usage.
+ * gfortran.dg/goacc/cray.f95: Likewise.
+ * gfortran.dg/goacc/loop-1.f95: Likewise.
+
2016-05-27 Cesar Philippidis <cesar@codesourcery.com>
* c-c++-common/goacc/kernels-loop-offload-alias-none.c: Add xfails.
diff --git gcc/testsuite/c-c++-common/goacc/cache-1.c gcc/testsuite/c-c++-common/goacc/cache-1.c
index 9503341..1d4759e 100644
--- gcc/testsuite/c-c++-common/goacc/cache-1.c
+++ gcc/testsuite/c-c++-common/goacc/cache-1.c
@@ -1,3 +1,7 @@
+/* OpenACC cache directive: valid usage. */
+/* For execution testing, this file is "#include"d from
+ libgomp/testsuite/libgomp.oacc-c-c++-common/cache-1.c. */
+
int
main (int argc, char **argv)
{
@@ -21,57 +25,31 @@ main (int argc, char **argv)
int n = 1;
const int len = n;
-#pragma acc cache /* { dg-error "expected '\\\(' before end of line" } */
-
-#pragma acc cache a[0:N] /* { dg-error "expected '\\\(' before 'a'" } */
- /* { dg-bogus "expected end of line before 'a'" "" { xfail c++ } 26 } */
-
-#pragma acc cache (a) /* { dg-error "expected '\\\['" } */
-
-#pragma acc cache ( /* { dg-error "expected (identifier|unqualified-id) before end of line" } */
-
-#pragma acc cache () /* { dg-error "expected (identifier|unqualified-id) before '\\\)' token" } */
-
-#pragma acc cache (,) /* { dg-error "expected (identifier|unqualified-id) before '(,|\\\))' token" } */
-
-#pragma acc cache (a[0:N] /* { dg-error "expected '\\\)' before end of line" } */
-
-#pragma acc cache (a[0:N],) /* { dg-error "expected (identifier|unqualified-id) before '(,|\\\))' token" "" { xfail c } } */
-
-#pragma acc cache (a[0:N]) copyin (a[0:N]) /* { dg-error "expected end of line before 'copyin'" } */
-
-#pragma acc cache () /* { dg-error "expected (identifier|unqualified-id) before '\\\)' token" } */
-
-#pragma acc cache (a[0:N] b[0:N]) /* { dg-error "expected '\\\)' before 'b'" } */
-
-#pragma acc cache (a[0:N] b[0:N}) /* { dg-error "expected '\\\)' before 'b'" } */
- /* { dg-bogus "expected end of line before '\\\}' token" "" { xfail c++ } 47 } */
-
-#pragma acc cache (a[0:N] /* { dg-error "expected '\\\)' before end of line" } */
-
-#pragma acc cache (a[ii]) /* { dg-error "'ii' is not a constant" } */
-
-#pragma acc cache (a[idx:n]) /* { dg-error "'n' is not a constant" } */
-
-#pragma acc cache (a[0:N]) ( /* { dg-error "expected end of line before '\\(' token" } */
-
-#pragma acc cache (a[0:N]) ii /* { dg-error "expected end of line before 'ii'" } */
-
-#pragma acc cache (a[0:N] ii) /* { dg-error "expected '\\)' before 'ii'" } */
-
+ /* Have at it, GCC! */
#pragma acc cache (a[0:N])
-
#pragma acc cache (a[0:N], a[0:N])
-
#pragma acc cache (a[0:N], b[0:N])
-
#pragma acc cache (a[0])
-
#pragma acc cache (a[0], a[1], b[0:N])
-
+#pragma acc cache (a[i - 5])
+#pragma acc cache (a[i + 5:len])
+#pragma acc cache (a[i + 5:len - 1])
+#pragma acc cache (b[i])
+#pragma acc cache (b[i:len])
+#pragma acc cache (a[ii])
+#pragma acc cache (a[ii:len])
+#pragma acc cache (b[ii - 1])
+#pragma acc cache (b[ii - 1:len])
+#pragma acc cache (b[i - ii + 1])
+#pragma acc cache (b[i + ii - 1:len])
+#pragma acc cache (b[i * ii - 1:len + 1])
+#pragma acc cache (a[idx + 2])
+#pragma acc cache (a[idx:len + 2])
#pragma acc cache (a[idx])
-
#pragma acc cache (a[idx:len])
+#pragma acc cache (a[idx + 2:len])
+#pragma acc cache (a[idx + 2 + i:len])
+#pragma acc cache (a[idx + 2 + i + ii:len])
b[ii] = a[ii];
}
diff --git gcc/testsuite/c-c++-common/goacc/cache-1.c gcc/testsuite/c-c++-common/goacc/cache-2.c
similarity index 83%
copy from gcc/testsuite/c-c++-common/goacc/cache-1.c
copy to gcc/testsuite/c-c++-common/goacc/cache-2.c
index 9503341..f717515 100644
--- gcc/testsuite/c-c++-common/goacc/cache-1.c
+++ gcc/testsuite/c-c++-common/goacc/cache-2.c
@@ -1,3 +1,5 @@
+/* OpenACC cache directive: invalid usage. */
+
int
main (int argc, char **argv)
{
@@ -22,57 +24,24 @@ main (int argc, char **argv)
const int len = n;
#pragma acc cache /* { dg-error "expected '\\\(' before end of line" } */
-
#pragma acc cache a[0:N] /* { dg-error "expected '\\\(' before 'a'" } */
- /* { dg-bogus "expected end of line before 'a'" "" { xfail c++ } 26 } */
-
+ /* { dg-bogus "expected end of line before 'a'" "" { xfail c++ } 27 } */
#pragma acc cache (a) /* { dg-error "expected '\\\['" } */
-
#pragma acc cache ( /* { dg-error "expected (identifier|unqualified-id) before end of line" } */
-
#pragma acc cache () /* { dg-error "expected (identifier|unqualified-id) before '\\\)' token" } */
-
#pragma acc cache (,) /* { dg-error "expected (identifier|unqualified-id) before '(,|\\\))' token" } */
-
#pragma acc cache (a[0:N] /* { dg-error "expected '\\\)' before end of line" } */
-
#pragma acc cache (a[0:N],) /* { dg-error "expected (identifier|unqualified-id) before '(,|\\\))' token" "" { xfail c } } */
-
#pragma acc cache (a[0:N]) copyin (a[0:N]) /* { dg-error "expected end of line before 'copyin'" } */
-
#pragma acc cache () /* { dg-error "expected (identifier|unqualified-id) before '\\\)' token" } */
-
#pragma acc cache (a[0:N] b[0:N]) /* { dg-error "expected '\\\)' before 'b'" } */
-
#pragma acc cache (a[0:N] b[0:N}) /* { dg-error "expected '\\\)' before 'b'" } */
- /* { dg-bogus "expected end of line before '\\\}' token" "" { xfail c++ } 47 } */
-
+ /* { dg-bogus "expected end of line before '\\\}' token" "" { xfail c++ } 38 } */
#pragma acc cache (a[0:N] /* { dg-error "expected '\\\)' before end of line" } */
-
-#pragma acc cache (a[ii]) /* { dg-error "'ii' is not a constant" } */
-
-#pragma acc cache (a[idx:n]) /* { dg-error "'n' is not a constant" } */
-
#pragma acc cache (a[0:N]) ( /* { dg-error "expected end of line before '\\(' token" } */
-
#pragma acc cache (a[0:N]) ii /* { dg-error "expected end of line before 'ii'" } */
-
#pragma acc cache (a[0:N] ii) /* { dg-error "expected '\\)' before 'ii'" } */
-#pragma acc cache (a[0:N])
-
-#pragma acc cache (a[0:N], a[0:N])
-
-#pragma acc cache (a[0:N], b[0:N])
-
-#pragma acc cache (a[0])
-
-#pragma acc cache (a[0], a[1], b[0:N])
-
-#pragma acc cache (a[idx])
-
-#pragma acc cache (a[idx:len])
-
b[ii] = a[ii];
}
}
diff --git gcc/testsuite/gfortran.dg/goacc/cache-1.f95 gcc/testsuite/gfortran.dg/goacc/cache-1.f95
index 2aa9e05..39fbf2c 100644
--- gcc/testsuite/gfortran.dg/goacc/cache-1.f95
+++ gcc/testsuite/gfortran.dg/goacc/cache-1.f95
@@ -1,4 +1,6 @@
-! { dg-do compile }
+! OpenACC cache directive: valid usage.
+! For execution testing, this file is "#include"d from
+! libgomp/testsuite/libgomp.oacc-fortran/cache-1.f95.
! { dg-additional-options "-std=f2008" }
program test
@@ -6,11 +8,8 @@ program test
integer :: i, d(10), e(5,13)
do concurrent (i=1:5)
- !$acc cache (d)
!$acc cache (d(1:3))
!$acc cache (d(i:i+2))
-
- !$acc cache (e)
!$acc cache (e(1:3,2:4))
!$acc cache (e(i:i+2,i+1:i+3))
enddo
diff --git gcc/testsuite/gfortran.dg/goacc/cache-2.f95 gcc/testsuite/gfortran.dg/goacc/cache-2.f95
new file mode 100644
index 0000000..be81878
--- /dev/null
+++ gcc/testsuite/gfortran.dg/goacc/cache-2.f95
@@ -0,0 +1,12 @@
+! OpenACC cache directive: invalid usage.
+! { dg-additional-options "-std=f2008" }
+
+program test
+ implicit none
+ integer :: i, d(10), e(5,13)
+
+ do concurrent (i=1:5)
+ !$acc cache (d) ! { dg-error "" "TODO" { xfail *-*-* } }
+ !$acc cache (e) ! { dg-error "" "TODO" { xfail *-*-* } }
+ enddo
+end
diff --git gcc/testsuite/gfortran.dg/goacc/coarray.f95 gcc/testsuite/gfortran.dg/goacc/coarray.f95
index 932e1f7..f30917b8 100644
--- gcc/testsuite/gfortran.dg/goacc/coarray.f95
+++ gcc/testsuite/gfortran.dg/goacc/coarray.f95
@@ -24,7 +24,7 @@ contains
!$acc end parallel loop
!$acc parallel loop
do i = 1,5
- !$acc cache (a)
+ !$acc cache (a) ! { dg-error "" "TODO" { xfail *-*-* } }
enddo
!$acc end parallel loop
!$acc update device (a)
diff --git gcc/testsuite/gfortran.dg/goacc/cray.f95 gcc/testsuite/gfortran.dg/goacc/cray.f95
index a35ab0d..705c18c 100644
--- gcc/testsuite/gfortran.dg/goacc/cray.f95
+++ gcc/testsuite/gfortran.dg/goacc/cray.f95
@@ -44,7 +44,8 @@ contains
!$acc end parallel loop
!$acc parallel loop
do i = 1,5
- !$acc cache (ptr) ! TODO: This must fail, as in openacc-1_0-branch
+ !TODO: This must fail, as in openacc-1_0-branch.
+ !$acc cache (ptr) ! { dg-error "" "TODO" { xfail *-*-* } }
enddo
!$acc end parallel loop
!$acc update device (ptr)
diff --git gcc/testsuite/gfortran.dg/goacc/loop-1.f95 gcc/testsuite/gfortran.dg/goacc/loop-1.f95
index b5f9e03..a605f03 100644
--- gcc/testsuite/gfortran.dg/goacc/loop-1.f95
+++ gcc/testsuite/gfortran.dg/goacc/loop-1.f95
@@ -158,15 +158,16 @@ subroutine test1
enddo
- !$acc cache (a) ! { dg-error "inside of loop" }
+ !$acc cache (a(1:10)) ! { dg-error "ACC CACHE directive must be inside of loop" }
do i = 1,10
- !$acc cache(a)
+ !$acc cache(a(i:i+1))
enddo
do i = 1,10
+ !$acc cache(a(i:i+1))
a(i) = i
- !$acc cache(a)
+ !$acc cache(a(i+2:i+2+1))
enddo
end subroutine test1
diff --git libgomp/ChangeLog.gomp libgomp/ChangeLog.gomp
index ccee4d1c..17c26c5 100644
--- libgomp/ChangeLog.gomp
+++ libgomp/ChangeLog.gomp
@@ -1,5 +1,14 @@
2016-06-10 Thomas Schwinge <thomas@codesourcery.com>
+ PR c/71381
+ * testsuite/libgomp.oacc-fortran/cache-1.f90: Remove file.
+
+ PR c/71381
+ Backport from trunk r237290:
+ * testsuite/libgomp.oacc-c-c++-common/cache-1.c: #include
+ "../../../gcc/testsuite/c-c++-common/goacc/cache-1.c".
+ * testsuite/libgomp.oacc-fortran/cache-1.f95: New file.
+
* testsuite/libgomp.oacc-c++/template-reduction.C: Remove XFAIL.
2016-06-08 Chung-Lin Tang <cltang@codesourcery.com>
diff --git libgomp/testsuite/libgomp.oacc-c-c++-common/cache-1.c libgomp/testsuite/libgomp.oacc-c-c++-common/cache-1.c
index 3f1f0bb..16aaed5 100644
--- libgomp/testsuite/libgomp.oacc-c-c++-common/cache-1.c
+++ libgomp/testsuite/libgomp.oacc-c-c++-common/cache-1.c
@@ -1,48 +1,3 @@
-int
-main (int argc, char **argv)
-{
-#define N 2
- int a[N], b[N];
- int i;
+/* OpenACC cache directive. */
- for (i = 0; i < N; i++)
- {
- a[i] = 3;
- b[i] = 0;
- }
-
-#pragma acc parallel copyin (a[0:N]) copyout (b[0:N])
-{
- int ii;
-
- for (ii = 0; ii < N; ii++)
- {
- const int idx = ii;
- int n = 1;
- const int len = n;
-
-#pragma acc cache (a[0:N])
-
-#pragma acc cache (a[0:N], b[0:N])
-
-#pragma acc cache (a[0])
-
-#pragma acc cache (a[0], a[1], b[0:N])
-
-#pragma acc cache (a[idx])
-
-#pragma acc cache (a[idx:len])
-
- b[ii] = a[ii];
- }
-}
-
-
- for (i = 0; i < N; i++)
- {
- if (a[i] != b[i])
- __builtin_abort ();
- }
-
- return 0;
-}
+#include "../../../gcc/testsuite/c-c++-common/goacc/cache-1.c"
diff --git libgomp/testsuite/libgomp.oacc-fortran/cache-1.f90 libgomp/testsuite/libgomp.oacc-fortran/cache-1.f90
deleted file mode 100644
index 2aeacb9..0000000
--- libgomp/testsuite/libgomp.oacc-fortran/cache-1.f90
+++ /dev/null
@@ -1,30 +0,0 @@
-! { dg-do run }
-
-program main
- integer, parameter :: N = 8
- integer, dimension (N) :: a, b
- integer :: i
- integer :: idx, len
-
- idx = 1
- len = 2
-
- !$acc parallel copyin (a(1:N)) copyout (b(1:N))
- do i = 1, N
-
- !$acc cache (a)
- !$acc cache (a, b)
- !$acc cache (a(2))
- !$acc cache (a(3), b(4))
- !$acc cache (a(1:N))
- !$acc cache (a(1:N), b(1:N))
- !$acc cache (a(idx))
- !$acc cache (a(idx:len), b(idx:len))
- !$acc cache (a(i:i+2))
- !$acc cache (a(i:i+2), b(i+1:i+3))
-
- b(i) = a(i)
- end do
- !$acc end parallel
-
-end program
diff --git libgomp/testsuite/libgomp.oacc-fortran/cache-1.f95 libgomp/testsuite/libgomp.oacc-fortran/cache-1.f95
new file mode 100644
index 0000000..37313d8
--- /dev/null
+++ libgomp/testsuite/libgomp.oacc-fortran/cache-1.f95
@@ -0,0 +1,6 @@
+! OpenACC cache directive.
+! { dg-do run }
+! { dg-additional-options "-std=f2008" }
+! { dg-additional-options "-cpp" }
+
+#include "../../../gcc/testsuite/gfortran.dg/goacc/cache-1.f95"
Grüße
Thomas
[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 472 bytes --]
^ permalink raw reply [flat|nested] 89+ messages in thread
* Re: [PING] [PR c/71381] C/C++ OpenACC cache directive rejects valid syntax
2016-06-10 10:32 ` Thomas Schwinge
@ 2016-06-10 13:14 ` Thomas Schwinge
2016-06-10 20:40 ` Gerald Pfeifer
0 siblings, 1 reply; 89+ messages in thread
From: Thomas Schwinge @ 2016-06-10 13:14 UTC (permalink / raw)
To: gcc-patches, Jakub Jelinek
[-- Attachment #1: Type: text/plain, Size: 839 bytes --]
Hi!
On Fri, 10 Jun 2016 12:31:48 +0200, I wrote:
> On Wed, 8 Jun 2016 16:07:17 +0200, Jakub Jelinek <jakub@redhat.com> wrote:
> > On Wed, Jun 08, 2016 at 03:28:57PM +0200, Thomas Schwinge wrote:
> > > > + /* The OpenACC cache directive explicitly only allows "array
> > > > + elements or subarrays". Would it make sense to allow complete
> > > > + arrays as a GNU extension? */
> >
> > Please try to not add GNU extensions on top of OpenACC, unless strictly
> > necessary.
> > It is better if the compiler is strict and there is interoperability.
> > If you think it should accept something that it doesn't, talk to the OpenACC
> > committee.
>
> Thanks, that makes sense.
I filed <https://github.com/OpenACC/openacc-spec/issues/55> "Make OpenACC
cache directive less restrictive".
Grüße
Thomas
[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 472 bytes --]
^ permalink raw reply [flat|nested] 89+ messages in thread
* Re: [PING] [PR c/71381] C/C++ OpenACC cache directive rejects valid syntax
2016-06-10 13:14 ` Thomas Schwinge
@ 2016-06-10 20:40 ` Gerald Pfeifer
0 siblings, 0 replies; 89+ messages in thread
From: Gerald Pfeifer @ 2016-06-10 20:40 UTC (permalink / raw)
To: Thomas Schwinge; +Cc: gcc-patches, Jakub Jelinek
On Fri, 10 Jun 2016, Thomas Schwinge wrote:
> I filed <https://github.com/OpenACC/openacc-spec/issues/55>
> "Make OpenACC cache directive less restrictive".
This gives "404, This is not the web page you are looking for".
Gerald
^ permalink raw reply [flat|nested] 89+ messages in thread
end of thread, other threads:[~2016-06-10 20:40 UTC | newest]
Thread overview: 89+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2014-01-23 18:01 [PATCH] [GOMP4] OpenACC 1.0+ support in fortran front-end Ilmir Usmanov
2014-01-23 18:03 ` [PATCH 1/6] " Ilmir Usmanov
2014-01-23 18:03 ` [PATCH 2/6] " Ilmir Usmanov
2014-01-23 18:04 ` [PATCH 3/6] " Ilmir Usmanov
2014-01-23 18:05 ` [PATCH 4/6] " Ilmir Usmanov
2014-01-23 18:05 ` [PATCH 5/6] " Ilmir Usmanov
2014-01-23 18:06 ` [PATCH 6/6] " Ilmir Usmanov
2014-01-23 18:09 ` [PATCH 7/6] " Ilmir Usmanov
2014-01-24 19:33 ` [PATCH 4/6] " Thomas Schwinge
2014-11-05 16:29 ` [gomp4] OpenACC cache directive for C Thomas Schwinge
2014-11-05 16:36 ` [gomp4] OpenACC cache directive maintenance (was: [PATCH 4/6] [GOMP4] OpenACC 1.0+ support in fortran front-end) Thomas Schwinge
2014-11-05 16:45 ` [gomp4] OpenACC cache directive maintenance Thomas Schwinge
2015-10-27 15:26 ` [PR fortran/63865] OpenACC cache directive: match Fortran support with C/C++ (was: [gomp4] OpenACC cache directive maintenance) Thomas Schwinge
2015-10-27 15:30 ` Jakub Jelinek
2015-10-27 17:03 ` [PR fortran/63865] OpenACC cache directive: match Fortran support with C/C++ Thomas Schwinge
2014-11-05 16:49 ` [gomp4] Testing of C/C++ OpenACC cache directive (was: OpenACC cache directive for C) Thomas Schwinge
2016-06-02 11:47 ` [PR c/71381] C/C++ OpenACC cache directive rejects valid syntax (was: [gomp4] OpenACC cache directive for C.) Thomas Schwinge
2016-06-08 13:29 ` [PING] [PR c/71381] C/C++ OpenACC cache directive rejects valid syntax Thomas Schwinge
2016-06-08 14:07 ` Jakub Jelinek
2016-06-10 10:32 ` Thomas Schwinge
2016-06-10 13:14 ` Thomas Schwinge
2016-06-10 20:40 ` Gerald Pfeifer
2014-01-24 20:47 ` [PATCH 2/6] [GOMP4] OpenACC 1.0+ support in fortran front-end Thomas Schwinge
2014-01-24 20:31 ` [PATCH 1/6] " Thomas Schwinge
2014-01-27 19:37 ` Tobias Burnus
2014-01-24 18:04 ` [PATCH] " Thomas Schwinge
2014-01-27 13:12 ` Ilmir Usmanov
2014-01-27 15:49 ` Thomas Schwinge
2014-01-27 16:35 ` Ilmir Usmanov
2014-01-31 11:14 ` Ilmir Usmanov
2014-01-31 11:16 ` [PATCH 1/6] " Ilmir Usmanov
2014-01-31 11:17 ` [PATCH 2/6] " Ilmir Usmanov
2014-01-31 11:18 ` [PATCH 3/6] " Ilmir Usmanov
2014-01-31 11:22 ` [PATCH 4/6] " Ilmir Usmanov
2014-01-31 11:34 ` [PATCH 5/6] " Ilmir Usmanov
2014-01-31 11:45 ` [PATCH 6/6] " Ilmir Usmanov
2014-02-09 23:43 ` [PATCH 5/6] " Tobias Burnus
2014-02-10 8:52 ` Thomas Schwinge
2014-02-10 9:34 ` Ilmir Usmanov
2014-02-10 23:13 ` Tobias Burnus
2014-02-10 9:45 ` Ilmir Usmanov
2014-02-10 10:52 ` Thomas Schwinge
2014-02-11 16:51 ` [PATCH 4/6] " Thomas Schwinge
2014-02-13 13:15 ` Ilmir Usmanov
2014-02-13 14:57 ` Thomas Schwinge
2014-02-14 5:45 ` Ilmir Usmanov
2014-02-21 19:29 ` [GOMP4] gimple_code_is_oacc -> is_gimple_omp_oacc_specifically (was: [PATCH 4/6] [GOMP4] OpenACC 1.0+ support in fortran front-end) Thomas Schwinge
2014-02-09 23:24 ` [PATCH 3/6] [GOMP4] OpenACC 1.0+ support in fortran front-end Tobias Burnus
2014-02-09 23:10 ` [PATCH 2/6] " Tobias Burnus
2014-02-10 9:10 ` Thomas Schwinge
2014-02-19 16:43 ` Ilmir Usmanov
2014-01-31 12:00 ` [PATCH 1/6] " Jakub Jelinek
2014-01-31 12:33 ` Ilmir Usmanov
2014-02-03 15:21 ` [PING] " Ilmir Usmanov
2014-02-09 22:22 ` Tobias Burnus
2014-02-19 15:34 ` Ilmir Usmanov
2014-02-19 23:52 ` Tobias Burnus
2014-02-20 8:19 ` Ilmir Usmanov
2014-03-04 7:56 ` [PATCH 1/4] [GOMP4] [Fortran] " Ilmir Usmanov
2014-03-04 7:57 ` Ilmir Usmanov
2014-03-04 7:57 ` [PATCH 2/4] " Ilmir Usmanov
2014-03-04 7:58 ` [PATCH 3/4] " Ilmir Usmanov
2014-03-04 7:59 ` [PATCH 4/4] " Ilmir Usmanov
2014-03-04 22:56 ` Tobias Burnus
2014-03-04 22:52 ` [PATCH 3/4] " Tobias Burnus
2014-03-04 17:20 ` [PATCH 1/4] " Tobias Burnus
2014-03-07 10:44 ` Ilmir Usmanov
2014-03-07 10:45 ` Ilmir Usmanov
2014-03-07 10:46 ` [PATCH 2/4] " Ilmir Usmanov
2014-03-07 10:46 ` [PATCH 3/4] " Ilmir Usmanov
2014-03-07 10:47 ` [PATCH 4/4] " Ilmir Usmanov
2014-03-08 17:55 ` Tobias Burnus
2014-03-20 10:53 ` Thomas Schwinge
2014-03-20 12:48 ` Ilmir Usmanov
2014-03-20 14:43 ` Jakub Jelinek
2014-03-08 17:19 ` [PATCH 3/4] " Tobias Burnus
2014-03-08 19:55 ` [PATCH 2/4] " Tobias Burnus
2014-03-11 12:04 ` Ilmir Usmanov
2014-03-12 18:46 ` Tobias Burnus
2014-03-12 18:27 ` [PATCH 1/4] " Tobias Burnus
2014-03-13 9:41 ` Ilmir Usmanov
2014-03-13 11:43 ` Thomas Schwinge
2014-03-13 13:24 ` Ilmir Usmanov
2014-03-13 14:13 ` Ilmir Usmanov
2014-03-16 19:46 ` Tobias Burnus
2014-03-16 20:44 ` Thomas Schwinge
2014-04-05 10:40 ` Thomas Schwinge
2014-03-10 15:44 ` Thomas Schwinge
2014-03-04 17:42 ` Tobias Burnus
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).