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.
>From f8f10537d2555e596bdd1655990150d45ef08f9b Mon Sep 17 00:00:00 2001
From: Ilmir Usmanov <i.usma...@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
