This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[PATCH 1/6] [GOMP4] OpenACC 1.0+ support in fortran front-end
- From: Ilmir Usmanov <i dot usmanov at samsung dot com>
- To: gcc-patches at gcc dot gnu dot org, Thomas Schwinge <thomas at codesourcery dot com>, jakub at redhat dot com
- Cc: Evgeny Gavrin <e dot gavrin at samsung dot com>, GarbuzovViacheslav <v dot garbuzov at samsung dot com>, Dmitri Botcharnikov <dmitry dot b at samsung dot com>
- Date: Thu, 23 Jan 2014 22:03:09 +0400
- Subject: [PATCH 1/6] [GOMP4] OpenACC 1.0+ support in fortran front-end
- Authentication-results: sourceware.org; auth=none
- References: <52E158EF dot 9050009 at samsung dot com>
>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