From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: (qmail 13698 invoked by alias); 23 Jan 2014 18:03:55 -0000 Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Received: (qmail 13673 invoked by uid 89); 23 Jan 2014 18:03:55 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=0.0 required=5.0 tests=AWL,BAYES_00,RP_MATCHES_RCVD,SPF_HELO_PASS,T_FRT_STOCK2,UNWANTED_LANGUAGE_BODY autolearn=ham version=3.3.2 X-HELO: mailout1.w1.samsung.com Received: from mailout1.w1.samsung.com (HELO mailout1.w1.samsung.com) (210.118.77.11) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with (DES-CBC3-SHA encrypted) ESMTPS; Thu, 23 Jan 2014 18:03:14 +0000 Received: from eucpsbgm1.samsung.com (unknown [203.254.199.244]) by mailout1.w1.samsung.com (Oracle Communications Messaging Server 7u4-24.01(7.0.4.24.0) 64bit (built Nov 17 2011)) with ESMTP id <0MZV0023W8TBVJ60@mailout1.w1.samsung.com> for gcc-patches@gcc.gnu.org; Thu, 23 Jan 2014 18:03:11 +0000 (GMT) Received: from eusync1.samsung.com ( [203.254.199.211]) by eucpsbgm1.samsung.com (EUCPMTA) with SMTP id FE.9B.23059.E5951E25; Thu, 23 Jan 2014 18:03:10 +0000 (GMT) Received: from [106.109.130.57] by eusync1.samsung.com (Oracle Communications Messaging Server 7u4-23.01(7.0.4.23.0) 64bit (built Aug 10 2011)) with ESMTPA id <0MZV003308T9TX70@eusync1.samsung.com>; Thu, 23 Jan 2014 18:03:10 +0000 (GMT) Message-id: <52E1595D.9000007@samsung.com> Date: Thu, 23 Jan 2014 18:03:00 -0000 From: Ilmir Usmanov User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Thunderbird/24.0 MIME-version: 1.0 To: gcc-patches@gcc.gnu.org, Thomas Schwinge , jakub@redhat.com Cc: Evgeny Gavrin , GarbuzovViacheslav , Dmitri Botcharnikov Subject: [PATCH 1/6] [GOMP4] OpenACC 1.0+ support in fortran front-end References: <52E158EF.9050009@samsung.com> In-reply-to: <52E158EF.9050009@samsung.com> Content-type: multipart/mixed; boundary=------------080109060209030906010707 X-SW-Source: 2014-01/txt/msg01522.txt.bz2 This is a multi-part message in MIME format. --------------080109060209030906010707 Content-Type: text/plain; charset=ISO-8859-1; format=flowed Content-Transfer-Encoding: 7bit Content-length: 1 --------------080109060209030906010707 Content-Type: text/x-diff; name="0001-OpenACC-fortran-FE-part-1.patch" Content-Transfer-Encoding: 7bit Content-Disposition: attachment; filename="0001-OpenACC-fortran-FE-part-1.patch" Content-length: 52356 >From 84dc72f88c1b23ae995afdda0b946ebd73af102f Mon Sep 17 00:00:00 2001 From: Ilmir Usmanov 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 --------------080109060209030906010707--