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(-)
@@ -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