From patchwork Fri Nov 27 11:37:23 2015 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Thomas Schwinge X-Patchwork-Id: 549393 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id DCE04140306 for ; Fri, 27 Nov 2015 22:38:04 +1100 (AEDT) Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b=m0iyur8T; dkim-atps=neutral DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:from :to:cc:subject:in-reply-to:references:date:message-id :mime-version:content-type; q=dns; s=default; b=MJ8k1ugG0At7WzG8 kHhBOoOWzP0N1iu9Se5vb/8iyDDbtp9y311FxM6i1yBfkbIgCKE+dMCvEbsiqjba 5QiwGYydMdtxjhNxNjugXF+Raf3P5CUcR5pYwYzjnzA0rJYb/wkKkbUV/ooYNBSa GwW9gWzUBzK9Cgp7AZqsMC++2gQ= DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:from :to:cc:subject:in-reply-to:references:date:message-id :mime-version:content-type; s=default; bh=kXpT4+2Gx/ApX2NnD3JPfP N+6l0=; b=m0iyur8TdDa5fzTBgepl+xCLLOaic8joxGT8i/euazewNImofnzAOC jVk1y4aSfYYuvjcf9lOKjJRngrzXFPvm8vQzXDthmn8ZPZ/F1K6CziKo6P2ZVxb1 msiNDDWf4Ecmyx47KnPWfGOwyOt1abEpYWdu3Yf3+3KPJ4/sEuZrA= Received: (qmail 98538 invoked by alias); 27 Nov 2015 11:37:54 -0000 Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org Received: (qmail 98500 invoked by uid 89); 27 Nov 2015 11:37:51 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-0.7 required=5.0 tests=AWL, BAYES_50, RCVD_IN_DNSWL_LOW, SPF_PASS autolearn=ham version=3.3.2 X-Spam-User: qpsmtpd, 2 recipients X-HELO: relay1.mentorg.com Received: from relay1.mentorg.com (HELO relay1.mentorg.com) (192.94.38.131) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Fri, 27 Nov 2015 11:37:39 +0000 Received: from svr-orw-fem-06.mgc.mentorg.com ([147.34.97.120]) by relay1.mentorg.com with esmtp id 1a2HLM-0002BF-Ea from Thomas_Schwinge@mentor.com ; Fri, 27 Nov 2015 03:37:36 -0800 Received: from tftp-cs (147.34.91.1) by SVR-ORW-FEM-06.mgc.mentorg.com (147.34.97.120) with Microsoft SMTP Server id 14.3.224.2; Fri, 27 Nov 2015 03:37:35 -0800 Received: by tftp-cs (Postfix, from userid 49978) id 4F746C2266; Fri, 27 Nov 2015 03:37:35 -0800 (PST) From: Thomas Schwinge To: James Norris CC: Cesar Philippidis , GCC Patches , Jakub Jelinek , Subject: [gomp4] Re: OpenACC declare directive updates In-Reply-To: <564DF738.80706@codesourcery.com> References: <5637692F.7050306@codesourcery.com> <5639FAC0.2090104@codesourcery.com> <20151106193127.GI5675@tucnak.redhat.com> <563D0345.7010208@codesourcery.com> <20151106194909.GK5675@tucnak.redhat.com> <878u5n7pqk.fsf@hertz.schwinge.homeip.net> <56451FE6.3040200@codesourcery.com> <20151122185949.GA53877@troutmask.apl.washington.edu> <564DF738.80706@codesourcery.com> User-Agent: Notmuch/0.9-125-g4686d11 (http://notmuchmail.org) Emacs/24.5.1 (i586-pc-linux-gnu) Date: Fri, 27 Nov 2015 12:37:23 +0100 Message-ID: <87lh9jptak.fsf@kepler.schwinge.homeip.net> MIME-Version: 1.0 Hi! On Thu, 19 Nov 2015 10:22:16 -0600, James Norris wrote: > --- a/gcc/fortran/dump-parse-tree.c > +++ b/gcc/fortran/dump-parse-tree.c Don't you need to handle OMP_LIST_LINK in gcc/fortran/dump-parse-tree.c:show_omp_clauses; OMP_LIST_DEVICE_RESIDENT is being handled there (but maps to the wrong string?). (See gomp-4_0-branch.) When touching that, please sort the "case OMP_LIST_*"s corresponding to the order the OMP_LIST_* are defined in gcc/fortran/gfortran.h. > --- a/gcc/fortran/openmp.c > +++ b/gcc/fortran/openmp.c I see OMP_LIST_DEVICE_RESIDENT being handled in gcc/fortran/openmp.c:resolve_omp_clauses and gcc/fortran/openmp.c:gfc_resolve_oacc_declare, but not OMP_LIST_LINK -- is that correct? Likewise, in gcc/fortran/trans-openmp.c:gfc_trans_omp_clauses. Also, oacc_declare_device_resident is handled in a lot more places compared to oacc_declare_link -- is that correct? In fact, there doesn't seem to be any "consumer" for the latter, but I see the OpenACC link clause being used in the test cases you added, so I wonder how that works. Merging your trunk r230722 and r230725 with the existing Fortran OpenACC declare implementation present on gomp-4_0-branch, I effectively applied the following to gomp-4_0-branch in 231002. Please verify this. Regarding my Fortran XFAIL comments in , with some of my earlier changes "#if 0"ed in gcc/fortran/trans-decl.c:add_attributes_to_decl, libgomp.oacc-fortran/declare-3.f90 again PASSes. But I don't understand (why something like) this code (isn't needed/done differently in C/C++). The XFAIL in libgomp.oacc-fortran/declare-1.f90 means to be resolved (gomp-4_0-branch only; not seen on trunk): "libgomp: cuStreamSynchronize error: an illegal memory access was encountered". commit 95e909a492b001df6d6faffdfa6047a5e9919561 Merge: 8373bdf e18d05e Author: tschwinge Date: Fri Nov 27 09:41:03 2015 +0000 svn merge -r 230720:230725 svn+ssh://gcc.gnu.org/svn/gcc/trunk git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/branches/gomp-4_0-branch@231002 138bc75d-0d04-0410-961f-82ee72b054a4 gcc/fortran/ChangeLog | 51 +++++ gcc/fortran/gfortran.h | 17 +- gcc/fortran/openmp.c | 235 +++++++++++++-------- gcc/fortran/parse.c | 2 +- gcc/fortran/parse.h | 2 +- gcc/fortran/resolve.c | 1 - gcc/fortran/st.c | 2 +- gcc/fortran/symbol.c | 12 +- gcc/fortran/trans-decl.c | 198 +++++------------ gcc/fortran/trans-openmp.c | 29 +-- gcc/fortran/trans-stmt.c | 3 +- gcc/testsuite/ChangeLog | 6 + gcc/testsuite/gfortran.dg/goacc/declare-1.f95 | 4 +- gcc/testsuite/gfortran.dg/goacc/declare-2.f95 | 43 +++- libgomp/ChangeLog | 9 + .../testsuite/libgomp.oacc-fortran/declare-1.f90 | 13 ++ .../testsuite/libgomp.oacc-fortran/declare-2.f90 | 2 + .../testsuite/libgomp.oacc-fortran/declare-3.f90 | 4 +- .../testsuite/libgomp.oacc-fortran/declare-4.f90 | 2 + .../testsuite/libgomp.oacc-fortran/declare-5.f90 | 1 + 20 files changed, 347 insertions(+), 289 deletions(-) [diff --git gcc/fortran/ChangeLog gcc/fortran/ChangeLog] Grüße Thomas diff --git gcc/fortran/gfortran.h gcc/fortran/gfortran.h index c8401cf..dd186b5 100644 --- gcc/fortran/gfortran.h +++ gcc/fortran/gfortran.h @@ -1250,17 +1250,18 @@ gfc_omp_clauses; #define gfc_get_omp_clauses() XCNEW (gfc_omp_clauses) -/* Node in the linked list used for storing OpenACC declare constructs. */ + +/* Node in the linked list used for storing !$oacc declare constructs. */ typedef struct gfc_oacc_declare { struct gfc_oacc_declare *next; - locus where; bool module_var; gfc_omp_clauses *clauses; - gfc_omp_clauses *return_clauses; + locus loc; } gfc_oacc_declare; + #define gfc_get_oacc_declare() XCNEW (gfc_oacc_declare) @@ -1685,8 +1686,8 @@ typedef struct gfc_namespace this namespace. */ struct gfc_data *data, *old_data; - /* !$ACC DECLARE clauses. */ - struct gfc_oacc_declare *oacc_declare; + /* !$ACC DECLARE. */ + gfc_oacc_declare *oacc_declare; /* !$ACC ROUTINE clauses. */ gfc_omp_clauses *oacc_routine_clauses; @@ -2455,8 +2456,8 @@ typedef struct gfc_code struct gfc_code *which_construct; int stop_code; gfc_entry_list *entry; - gfc_omp_clauses *omp_clauses; gfc_oacc_declare *oacc_declare; + gfc_omp_clauses *omp_clauses; const char *omp_name; gfc_omp_namelist *omp_namelist; bool omp_bool; @@ -2958,7 +2959,7 @@ gfc_expr *gfc_get_parentheses (gfc_expr *); /* openmp.c */ struct gfc_omp_saved_state { void *ptrs[2]; int ints[1]; }; void gfc_free_omp_clauses (gfc_omp_clauses *); -void gfc_free_oacc_declares (struct gfc_oacc_declare *); +void gfc_free_oacc_declare_clauses (struct gfc_oacc_declare *); void gfc_free_omp_declare_simd (gfc_omp_declare_simd *); void gfc_free_omp_declare_simd_list (gfc_omp_declare_simd *); void gfc_free_omp_udr (gfc_omp_udr *); @@ -3278,6 +3279,6 @@ bool gfc_is_reallocatable_lhs (gfc_expr *); /* trans-decl.c */ -void finish_oacc_declare (gfc_namespace *, enum sym_flavor); +void finish_oacc_declare (gfc_namespace *, gfc_symbol *, bool); #endif /* GCC_GFORTRAN_H */ diff --git gcc/fortran/openmp.c gcc/fortran/openmp.c index e8e8071..c6db847 100644 --- gcc/fortran/openmp.c +++ gcc/fortran/openmp.c @@ -94,7 +94,7 @@ gfc_free_omp_clauses (gfc_omp_clauses *c) /* Free oacc_declare structures. */ void -gfc_free_oacc_declares (struct gfc_oacc_declare *oc) +gfc_free_oacc_declare_clauses (struct gfc_oacc_declare *oc) { struct gfc_oacc_declare *decl = oc; @@ -413,6 +413,110 @@ match_oacc_clause_gang (gfc_omp_clauses *cp) return gfc_match (" %e )", &cp->gang_expr); } +static match +gfc_match_oacc_clause_link (const char *str, gfc_omp_namelist **list) +{ + gfc_omp_namelist *head = NULL; + gfc_omp_namelist *tail, *p; + locus old_loc; + char n[GFC_MAX_SYMBOL_LEN+1]; + gfc_symbol *sym; + match m; + gfc_symtree *st; + + old_loc = gfc_current_locus; + + m = gfc_match (str); + if (m != MATCH_YES) + return m; + + m = gfc_match (" ("); + + for (;;) + { + m = gfc_match_symbol (&sym, 0); + switch (m) + { + case MATCH_YES: + if (sym->attr.in_common) + { + gfc_error_now ("Variable at %C is an element of a COMMON block"); + goto cleanup; + } + gfc_set_sym_referenced (sym); + p = gfc_get_omp_namelist (); + if (head == NULL) + head = tail = p; + else + { + tail->next = p; + tail = tail->next; + } + tail->sym = sym; + tail->expr = NULL; + tail->where = gfc_current_locus; + goto next_item; + case MATCH_NO: + break; + + case MATCH_ERROR: + goto cleanup; + } + + m = gfc_match (" / %n /", n); + if (m == MATCH_ERROR) + goto cleanup; + if (m == MATCH_NO || n[0] == '\0') + goto syntax; + + st = gfc_find_symtree (gfc_current_ns->common_root, n); + if (st == NULL) + { + gfc_error ("COMMON block /%s/ not found at %C", n); + goto cleanup; + } + + for (sym = st->n.common->head; sym; sym = sym->common_next) + { + gfc_set_sym_referenced (sym); + p = gfc_get_omp_namelist (); + if (head == NULL) + head = tail = p; + else + { + tail->next = p; + tail = tail->next; + } + tail->sym = sym; + tail->where = gfc_current_locus; + } + + next_item: + if (gfc_match_char (')') == MATCH_YES) + break; + if (gfc_match_char (',') != MATCH_YES) + goto syntax; + } + + if (gfc_match_omp_eos () != MATCH_YES) + { + gfc_error ("Unexpected junk after !$ACC DECLARE at %C"); + goto cleanup; + } + + while (*list) + list = &(*list)->next; + *list = head; + return MATCH_YES; + +syntax: + gfc_error ("Syntax error in !$ACC DECLARE list at %C"); + +cleanup: + gfc_current_locus = old_loc; + return MATCH_ERROR; +} + #define OMP_CLAUSE_PRIVATE ((uint64_t) 1 << 0) #define OMP_CLAUSE_FIRSTPRIVATE ((uint64_t) 1 << 1) #define OMP_CLAUSE_LASTPRIVATE ((uint64_t) 1 << 2) @@ -473,10 +577,10 @@ match_oacc_clause_gang (gfc_omp_clauses *cp) #define OMP_CLAUSE_DELETE ((uint64_t) 1 << 55) #define OMP_CLAUSE_AUTO ((uint64_t) 1 << 56) #define OMP_CLAUSE_TILE ((uint64_t) 1 << 57) -#define OMP_CLAUSE_BIND ((uint64_t) 1 << 58) -#define OMP_CLAUSE_NOHOST ((uint64_t) 1 << 59) -#define OMP_CLAUSE_DEVICE_TYPE ((uint64_t) 1 << 60) -#define OMP_CLAUSE_LINK ((uint64_t) 1 << 61) +#define OMP_CLAUSE_LINK ((uint64_t) 1 << 58) +#define OMP_CLAUSE_BIND ((uint64_t) 1 << 59) +#define OMP_CLAUSE_NOHOST ((uint64_t) 1 << 60) +#define OMP_CLAUSE_DEVICE_TYPE ((uint64_t) 1 << 61) /* Helper function for OpenACC and OpenMP clauses involving memory mapping. */ @@ -739,9 +843,8 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask, == MATCH_YES) continue; if ((mask & OMP_CLAUSE_LINK) - && gfc_match_omp_variable_list ("link (", - &c->lists[OMP_LIST_LINK], - true) + && gfc_match_oacc_clause_link ("link (", + &c->lists[OMP_LIST_LINK]) == MATCH_YES) continue; if ((mask & OMP_CLAUSE_OACC_DEVICE) @@ -1444,8 +1547,9 @@ gfc_match_oacc_declare (void) gfc_omp_clauses *c; gfc_omp_namelist *n; gfc_namespace *ns = gfc_current_ns; - gfc_oacc_declare *new_oc, *oc; + gfc_oacc_declare *new_oc; bool module_var = false; + locus where = gfc_current_locus; if (gfc_match_omp_clauses (&c, OACC_DECLARE_CLAUSES, 0, false, false, true) != MATCH_YES) @@ -1466,8 +1570,8 @@ gfc_match_oacc_declare (void) if (n->u.map_op != OMP_MAP_FORCE_ALLOC && n->u.map_op != OMP_MAP_FORCE_TO) { - gfc_error ("Invalid clause in module with " - "$!ACC DECLARE at %C"); + gfc_error ("Invalid clause in module with $!ACC DECLARE at %L", + &where); return MATCH_ERROR; } @@ -1476,29 +1580,23 @@ gfc_match_oacc_declare (void) if (ns->proc_name->attr.oacc_function) { - gfc_error ("Invalid declare in routine with " "$!ACC DECLARE at %C"); - return MATCH_ERROR; - } - - if (s->attr.in_common) - { - gfc_error ("Unsupported: variable in a common block with " - "$!ACC DECLARE at %C"); + gfc_error ("Invalid declare in routine with $!ACC DECLARE at %L", + &where); return MATCH_ERROR; } if (s->attr.use_assoc) { - gfc_error ("Unsupported: variable is USE-associated with " - "$!ACC DECLARE at %C"); + gfc_error ("Variable is USE-associated with $!ACC DECLARE at %L", + &where); return MATCH_ERROR; } if ((s->attr.dimension || s->attr.codimension) && s->attr.dummy && s->as->type != AS_EXPLICIT) { - gfc_error ("Unsupported: assumed-size dummy array with " - "$!ACC DECLARE at %C"); + gfc_error ("Assumed-size dummy array with $!ACC DECLARE at %L", + &where); return MATCH_ERROR; } @@ -1525,38 +1623,7 @@ gfc_match_oacc_declare (void) new_oc->next = ns->oacc_declare; new_oc->module_var = module_var; new_oc->clauses = c; - new_oc->where = gfc_current_locus; - - for (oc = new_oc; oc; oc = oc->next) - { - c = oc->clauses; - for (n = c->lists[OMP_LIST_MAP]; n != NULL; n = n->next) - n->sym->mark = 0; - } - - for (oc = new_oc; oc; oc = oc->next) - { - c = oc->clauses; - for (n = c->lists[OMP_LIST_MAP]; n != NULL; n = n->next) - { - if (n->sym->mark) - { - gfc_error ("Symbol %qs present on multiple clauses at %C", - n->sym->name); - return MATCH_ERROR; - } - else - n->sym->mark = 1; - } - } - - for (oc = new_oc; oc; oc = oc->next) - { - c = oc->clauses; - for (n = c->lists[OMP_LIST_MAP]; n != NULL; n = n->next) - n->sym->mark = 1; - } - + new_oc->loc = gfc_current_locus; ns->oacc_declare = new_oc; return MATCH_YES; @@ -4936,13 +5003,11 @@ resolve_oacc_loop (gfc_code *code) resolve_oacc_nested_loops (code, do_code, collapse, "collapsed"); } - void gfc_resolve_oacc_declare (gfc_namespace *ns) { int list; gfc_omp_namelist *n; - locus loc; gfc_oacc_declare *oc; if (ns->oacc_declare == NULL) @@ -4950,55 +5015,40 @@ gfc_resolve_oacc_declare (gfc_namespace *ns) for (oc = ns->oacc_declare; oc; oc = oc->next) { - loc = oc->where; - - for (list = OMP_LIST_DEVICE_RESIDENT; - list <= OMP_LIST_DEVICE_RESIDENT; list++) + for (list = 0; list < OMP_LIST_NUM; list++) for (n = oc->clauses->lists[list]; n; n = n->next) { n->sym->mark = 0; if (n->sym->attr.flavor == FL_PARAMETER) - gfc_error ("PARAMETER object %qs is not allowed at %L", - n->sym->name, &loc); - } + { + gfc_error ("PARAMETER object %qs is not allowed at %L", + n->sym->name, &oc->loc); + continue; + } - for (list = OMP_LIST_DEVICE_RESIDENT; - list <= OMP_LIST_DEVICE_RESIDENT; list++) - for (n = oc->clauses->lists[list]; n; n = n->next) - { - if (n->sym->mark) - gfc_error ("Symbol %qs present on multiple clauses at %L", - n->sym->name, &loc); - else - n->sym->mark = 1; + if (n->expr && n->expr->ref->type == REF_ARRAY) + { + gfc_error ("Array sections: %qs not allowed in" + " $!ACC DECLARE at %L", n->sym->name, &oc->loc); + continue; + } } for (n = oc->clauses->lists[OMP_LIST_DEVICE_RESIDENT]; n; n = n->next) - check_array_not_assumed (n->sym, loc, "DEVICE_RESIDENT"); - - for (n = oc->clauses->lists[OMP_LIST_MAP]; n; n = n->next) - { - if (n->expr && n->expr->ref->type == REF_ARRAY) - gfc_error ("Subarray: %qs not allowed in $!ACC DECLARE at %L", - n->sym->name, &loc); - } - } - - for (oc = ns->oacc_declare; oc; oc = oc->next) - { - for (list = OMP_LIST_LINK; list <= OMP_LIST_LINK; list++) - for (n = oc->clauses->lists[list]; n; n = n->next) - n->sym->mark = 0; + check_array_not_assumed (n->sym, oc->loc, "DEVICE_RESIDENT"); } for (oc = ns->oacc_declare; oc; oc = oc->next) { - for (list = OMP_LIST_LINK; list <= OMP_LIST_LINK; list++) + for (list = 0; list < OMP_LIST_NUM; list++) for (n = oc->clauses->lists[list]; n; n = n->next) { if (n->sym->mark) - gfc_error ("Symbol %qs present on multiple clauses at %L", - n->sym->name, &loc); + { + gfc_error ("Symbol %qs present on multiple clauses at %L", + n->sym->name, &oc->loc); + continue; + } else n->sym->mark = 1; } @@ -5006,13 +5056,12 @@ gfc_resolve_oacc_declare (gfc_namespace *ns) for (oc = ns->oacc_declare; oc; oc = oc->next) { - for (list = OMP_LIST_LINK; list <= OMP_LIST_LINK; list++) + for (list = 0; list < OMP_LIST_NUM; list++) for (n = oc->clauses->lists[list]; n; n = n->next) n->sym->mark = 0; } } - void gfc_resolve_oacc_directive (gfc_code *code, gfc_namespace *ns ATTRIBUTE_UNUSED) { diff --git gcc/fortran/parse.c gcc/fortran/parse.c index 6c4d195..b2d15a8 100644 --- gcc/fortran/parse.c +++ gcc/fortran/parse.c @@ -1406,7 +1406,7 @@ push_state (gfc_state_data *p, gfc_compile_state new_state, gfc_symbol *sym) p->head = p->tail = NULL; p->do_variable = NULL; if (p->state != COMP_DO && p->state != COMP_DO_CONCURRENT) - p->ext.oacc_declare = NULL; + p->ext.oacc_declare_clauses = NULL; /* If this the state of a construct like BLOCK, DO or IF, the corresponding construct statement was accepted right before pushing the state. Thus, diff --git gcc/fortran/parse.h gcc/fortran/parse.h index f343550..94b2ada 100644 --- gcc/fortran/parse.h +++ gcc/fortran/parse.h @@ -48,7 +48,7 @@ typedef struct gfc_state_data union { gfc_st_label *end_do_label; - struct gfc_oacc_declare *oacc_declare; + gfc_oacc_declare *oacc_declare_clauses; } ext; } diff --git gcc/fortran/resolve.c gcc/fortran/resolve.c index 1d38d23..febf0fa 100644 --- gcc/fortran/resolve.c +++ gcc/fortran/resolve.c @@ -9374,7 +9374,6 @@ gfc_resolve_blocks (gfc_code *b, gfc_namespace *ns) case EXEC_OACC_EXIT_DATA: case EXEC_OACC_ATOMIC: case EXEC_OACC_ROUTINE: - case EXEC_OACC_DECLARE: case EXEC_OMP_ATOMIC: case EXEC_OMP_CRITICAL: case EXEC_OMP_DISTRIBUTE: diff --git gcc/fortran/st.c gcc/fortran/st.c index 78099b8..566150b 100644 --- gcc/fortran/st.c +++ gcc/fortran/st.c @@ -187,7 +187,7 @@ gfc_free_statement (gfc_code *p) case EXEC_OACC_DECLARE: if (p->ext.oacc_declare) - gfc_free_oacc_declares (p->ext.oacc_declare); + gfc_free_oacc_declare_clauses (p->ext.oacc_declare); break; case EXEC_OACC_PARALLEL_LOOP: diff --git gcc/fortran/symbol.c gcc/fortran/symbol.c index 43fd25d..ff9aff9 100644 --- gcc/fortran/symbol.c +++ gcc/fortran/symbol.c @@ -1269,7 +1269,8 @@ gfc_add_omp_declare_target (symbol_attribute *attr, const char *name, bool -gfc_add_oacc_declare_create (symbol_attribute *attr, const char *name, locus *where) +gfc_add_oacc_declare_create (symbol_attribute *attr, const char *name, + locus *where) { if (check_used (attr, name, where)) return false; @@ -1283,7 +1284,8 @@ gfc_add_oacc_declare_create (symbol_attribute *attr, const char *name, locus *wh bool -gfc_add_oacc_declare_copyin (symbol_attribute *attr, const char *name, locus *where) +gfc_add_oacc_declare_copyin (symbol_attribute *attr, const char *name, + locus *where) { if (check_used (attr, name, where)) return false; @@ -1297,7 +1299,8 @@ gfc_add_oacc_declare_copyin (symbol_attribute *attr, const char *name, locus *wh bool -gfc_add_oacc_declare_deviceptr (symbol_attribute *attr, const char *name, locus *where) +gfc_add_oacc_declare_deviceptr (symbol_attribute *attr, const char *name, + locus *where) { if (check_used (attr, name, where)) return false; @@ -1311,7 +1314,8 @@ gfc_add_oacc_declare_deviceptr (symbol_attribute *attr, const char *name, locus bool -gfc_add_oacc_declare_device_resident (symbol_attribute *attr, const char *name, locus *where) +gfc_add_oacc_declare_device_resident (symbol_attribute *attr, const char *name, + locus *where) { if (check_used (attr, name, where)) return false; diff --git gcc/fortran/trans-decl.c gcc/fortran/trans-decl.c index 56bc797..eaf46cb 100644 --- gcc/fortran/trans-decl.c +++ gcc/fortran/trans-decl.c @@ -1302,15 +1302,20 @@ add_attributes_to_decl (symbol_attribute sym_attr, tree list) } if (sym_attr.omp_declare_target +#if 0 /* TODO */ || sym_attr.oacc_declare_create || sym_attr.oacc_declare_copyin || sym_attr.oacc_declare_deviceptr - || sym_attr.oacc_declare_device_resident) + || sym_attr.oacc_declare_device_resident +#endif + ) list = tree_cons (get_identifier ("omp declare target"), NULL_TREE, list); +#if 0 /* TODO */ if (sym_attr.oacc_declare_link) list = tree_cons (get_identifier ("omp declare target link"), NULL_TREE, list); +#endif if (sym_attr.oacc_function) { @@ -5782,61 +5787,6 @@ is_ieee_module_used (gfc_namespace *ns) } -static struct oacc_return -{ - gfc_code *code; - struct oacc_return *next; -} *oacc_returns; - - -static void -find_oacc_return (gfc_code *code) -{ - if (code->next) - { - if (code->next->op == EXEC_RETURN) - { - struct oacc_return *r; - - r = XCNEW (struct oacc_return); - r->code = code; - r->next = NULL; - - if (oacc_returns) - r->next = oacc_returns; - - oacc_returns = r; - } - else - { - find_oacc_return (code->next); - } - } - - if (code->block) - find_oacc_return (code->block); - - return; -} - - -static gfc_code * -find_end (gfc_code *code) -{ - gcc_assert (code); - - if (code->next) - { - if (code->next->op == EXEC_END_PROCEDURE) - return code; - else - return find_end (code->next); - } - - return NULL; -} - - static gfc_omp_clauses *module_oacc_clauses; @@ -5891,16 +5841,17 @@ find_module_oacc_declare_clauses (gfc_symbol *sym) void -finish_oacc_declare (gfc_namespace *ns, enum sym_flavor flavor) +finish_oacc_declare (gfc_namespace *ns, gfc_symbol *sym, bool block) { gfc_code *code; gfc_oacc_declare *oc; - gfc_omp_namelist *n; locus where = gfc_current_locus; + gfc_omp_clauses *omp_clauses = NULL; + gfc_omp_namelist *n, *p; gfc_traverse_ns (ns, find_module_oacc_declare_clauses); - if (module_oacc_clauses && flavor == FL_PROGRAM) + if (module_oacc_clauses && sym->attr.flavor == FL_PROGRAM) { gfc_oacc_declare *new_oc; @@ -5917,107 +5868,63 @@ finish_oacc_declare (gfc_namespace *ns, enum sym_flavor flavor) for (oc = ns->oacc_declare; oc; oc = oc->next) { - gfc_omp_clauses *omp_clauses, *ret_clauses; - if (oc->module_var) continue; - if (oc->clauses) - { - code = XCNEW (gfc_code); - code->op = EXEC_OACC_DECLARE; - code->loc = where; - - ret_clauses = NULL; - omp_clauses = oc->clauses; - - for (n = omp_clauses->lists[OMP_LIST_MAP]; n; n = n->next) - { - bool ret = false; - gfc_omp_map_op new_op; - - switch (n->u.map_op) - { - case OMP_MAP_ALLOC: - case OMP_MAP_FORCE_ALLOC: - new_op = OMP_MAP_FORCE_DEALLOC; - ret = true; - break; + if (block) + gfc_error ("Sorry, $!ACC DECLARE at %L is not allowed " + "in BLOCK construct", &oc->loc); - case OMP_MAP_DEVICE_RESIDENT: - n->u.map_op = OMP_MAP_FORCE_ALLOC; - new_op = OMP_MAP_FORCE_DEALLOC; - ret = true; - break; - case OMP_MAP_FORCE_FROM: - n->u.map_op = OMP_MAP_FORCE_ALLOC; - new_op = OMP_MAP_FORCE_FROM; - ret = true; - break; - - case OMP_MAP_FORCE_TO: - new_op = OMP_MAP_FORCE_DEALLOC; - ret = true; - break; - - case OMP_MAP_FORCE_TOFROM: - n->u.map_op = OMP_MAP_FORCE_TO; - new_op = OMP_MAP_FORCE_FROM; - ret = true; - break; + if (oc->clauses && oc->clauses->lists[OMP_LIST_MAP]) + { + if (omp_clauses == NULL) + { + omp_clauses = oc->clauses; + continue; + } - case OMP_MAP_FROM: - n->u.map_op = OMP_MAP_FORCE_ALLOC; - new_op = OMP_MAP_FROM; - ret = true; - break; + for (n = oc->clauses->lists[OMP_LIST_MAP]; n; p = n, n = n->next) + ; - case OMP_MAP_FORCE_DEVICEPTR: - case OMP_MAP_FORCE_PRESENT: - case OMP_MAP_LINK: - case OMP_MAP_TO: - break; + gcc_assert (p->next == NULL); - case OMP_MAP_TOFROM: - n->u.map_op = OMP_MAP_TO; - new_op = OMP_MAP_FROM; - ret = true; - break; + p->next = omp_clauses->lists[OMP_LIST_MAP]; + omp_clauses = oc->clauses; + } + } - default: - gcc_unreachable (); - break; - } + if (!omp_clauses) + return; - if (ret) - { - gfc_omp_namelist *new_n; + for (n = omp_clauses->lists[OMP_LIST_MAP]; n; n = n->next) + { + switch (n->u.map_op) + { + case OMP_MAP_DEVICE_RESIDENT: + n->u.map_op = OMP_MAP_FORCE_ALLOC; + break; - new_n = gfc_get_omp_namelist (); - new_n->sym = n->sym; - new_n->u.map_op = new_op; + default: + break; + } + } - if (!ret_clauses) - ret_clauses = gfc_get_omp_clauses (); + code = XCNEW (gfc_code); + code->op = EXEC_OACC_DECLARE; + code->loc = where; - if (ret_clauses->lists[OMP_LIST_MAP]) - new_n->next = ret_clauses->lists[OMP_LIST_MAP]; + code->ext.oacc_declare = gfc_get_oacc_declare (); + code->ext.oacc_declare->clauses = omp_clauses; - ret_clauses->lists[OMP_LIST_MAP] = new_n; - ret = false; - } - } + code->block = XCNEW (gfc_code); + code->block->op = EXEC_OACC_DECLARE; + code->block->loc = where; - code->ext.oacc_declare = gfc_get_oacc_declare (); - code->ext.oacc_declare->clauses = omp_clauses; - code->ext.oacc_declare->return_clauses = ret_clauses; + if (ns->code) + code->block->next = ns->code; - if (ns->code) - code->next = ns->code; - ns->code = code; - } - } + ns->code = code; return; } @@ -6159,8 +6066,7 @@ gfc_generate_function_code (gfc_namespace * ns) if ((gfc_option.rtcheck & GFC_RTCHECK_BOUNDS) && !sym->attr.is_bind_c) add_argument_checking (&body, sym); - /* Generate !$ACC DECLARE directive. */ - finish_oacc_declare (ns, sym->attr.flavor); + finish_oacc_declare (ns, sym, false); tmp = gfc_trans_code (ns->code); gfc_add_expr_to_block (&body, tmp); diff --git gcc/fortran/trans-openmp.c gcc/fortran/trans-openmp.c index 87ecc5a..e98a29c 100644 --- gcc/fortran/trans-openmp.c +++ gcc/fortran/trans-openmp.c @@ -1776,8 +1776,8 @@ gfc_trans_omp_clauses_1 (stmtblock_t *block, gfc_omp_clauses *clauses, clause_code = OMP_CLAUSE_USE_DEVICE; goto add_clause; case OMP_LIST_DEVICE_RESIDENT: - case OMP_LIST_LINK: - continue; + clause_code = OMP_CLAUSE_DEVICE_RESIDENT; + goto add_clause; add_clause: omp_clauses @@ -1925,9 +1925,6 @@ gfc_trans_omp_clauses_1 (stmtblock_t *block, gfc_omp_clauses *clauses, if (!n->sym->attr.referenced) continue; - if (n->sym->attr.use_assoc && n->sym->attr.oacc_declare_link) - continue; - tree node = build_omp_clause (input_location, OMP_CLAUSE_MAP); tree node2 = NULL_TREE; tree node3 = NULL_TREE; @@ -2141,9 +2138,6 @@ gfc_trans_omp_clauses_1 (stmtblock_t *block, gfc_omp_clauses *clauses, case OMP_MAP_FORCE_DEVICEPTR: OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_FORCE_DEVICEPTR); break; - case OMP_MAP_DEVICE_RESIDENT: - OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_DEVICE_RESIDENT); - break; default: gcc_unreachable (); } @@ -4672,23 +4666,18 @@ tree gfc_trans_oacc_declare (gfc_code *code) { stmtblock_t block; - tree stmt, c1; + tree stmt, oacc_clauses; enum tree_code construct_code; - gfc_start_block (&block); - - construct_code = OACC_DECLARE; + construct_code = OACC_DATA; gfc_start_block (&block); - c1 = gfc_trans_omp_clauses (&block, code->ext.oacc_declare->clauses, - code->loc); - -#if 0 /* TODO */ - c2 = gfc_trans_omp_clauses (&block, code->ext.oacc_declare->return_clauses, - code->loc); -#endif - stmt = build1_loc (input_location, construct_code, void_type_node, c1); + oacc_clauses = gfc_trans_omp_clauses (&block, code->ext.oacc_declare->clauses, + code->loc); + stmt = gfc_trans_omp_code (code->block->next, true); + stmt = build2_loc (input_location, construct_code, void_type_node, stmt, + oacc_clauses); gfc_add_expr_to_block (&block, stmt); return gfc_finish_block (&block); diff --git gcc/fortran/trans-stmt.c gcc/fortran/trans-stmt.c index 4a9c98a..06591a3 100644 --- gcc/fortran/trans-stmt.c +++ gcc/fortran/trans-stmt.c @@ -1575,8 +1575,7 @@ gfc_trans_block_construct (gfc_code* code) exit_label = gfc_build_label_decl (NULL_TREE); code->exit_label = exit_label; - /* Generate !$ACC DECLARE directive. */ - finish_oacc_declare (ns, FL_UNKNOWN); + finish_oacc_declare (ns, sym, true); gfc_add_expr_to_block (&body, gfc_trans_code (ns->code)); gfc_add_expr_to_block (&body, build1_v (LABEL_EXPR, exit_label)); [diff --git gcc/testsuite/ChangeLog gcc/testsuite/ChangeLog] diff --git gcc/testsuite/gfortran.dg/goacc/declare-1.f95 gcc/testsuite/gfortran.dg/goacc/declare-1.f95 index 3129f04..1ff8e6a 100644 --- gcc/testsuite/gfortran.dg/goacc/declare-1.f95 +++ gcc/testsuite/gfortran.dg/goacc/declare-1.f95 @@ -1,5 +1,4 @@ ! { dg-do compile } -! { dg-additional-options "-fdump-tree-original" } program test implicit none @@ -11,8 +10,7 @@ contains integer, value :: n BLOCK integer i - !$acc declare copy(i) + !$acc declare copy(i) ! { dg-error "is not allowed" } END BLOCK end function foo end program test -! { dg-final { scan-tree-dump-times "pragma acc declare map\\(force_to:i\\)" 2 "original" } } diff --git gcc/testsuite/gfortran.dg/goacc/declare-2.f95 gcc/testsuite/gfortran.dg/goacc/declare-2.f95 index afdbe2e..aa1704f 100644 --- gcc/testsuite/gfortran.dg/goacc/declare-2.f95 +++ gcc/testsuite/gfortran.dg/goacc/declare-2.f95 @@ -21,24 +21,51 @@ end subroutine end module +module bmod + + implicit none + integer :: a, b, c, d, e, f, g, h, i + common /data1/ a, b, c + common /data2/ d, e, f + common /data3/ g, h, i + !$acc declare link (a) ! { dg-error "element of a COMMON" } + !$acc declare link (/data1/) + !$acc declare link (a, b, c) ! { dg-error "element of a COMMON" } + !$acc declare link (/foo/) ! { dg-error "not found" } + !$acc declare device_resident (/data2/) + !$acc declare device_resident (/data3/) ! { dg-error "present on multiple clauses" } + !$acc declare device_resident (g, h, i) + +end module + subroutine bsubr (foo) implicit none integer, dimension (:) :: foo - !$acc declare copy (foo) ! { dg-error "assumed-size dummy array" } - !$acc declare copy (foo(1:2)) ! { dg-error "assumed-size dummy array" } + !$acc declare copy (foo) ! { dg-error "Assumed-size dummy array" } + !$acc declare copy (foo(1:2)) ! { dg-error "Assumed-size dummy array" } -end subroutine +end subroutine bsubr + +subroutine multiline + integer :: b(8) + + !$acc declare copyin (b) ! { dg-error "present on multiple clauses" } + !$acc declare copyin (b) + +end subroutine multiline + +subroutine subarray + integer :: c(8) + + !$acc declare copy (c(1:2)) ! { dg-error "Array sections: 'c' not allowed" } + +end subroutine subarray program test integer :: a(8) - integer :: b(8) - integer :: c(8) !$acc declare create (a) copyin (a) ! { dg-error "present on multiple clauses" } - !$acc declare copyin (b) - !$acc declare copyin (b) ! { dg-error "present on multiple clauses" } - !$acc declare copy (c(1:2)) ! { dg-error "Subarray: 'c' not allowed" } end program [diff --git libgomp/ChangeLog libgomp/ChangeLog] diff --git libgomp/testsuite/libgomp.oacc-fortran/declare-1.f90 libgomp/testsuite/libgomp.oacc-fortran/declare-1.f90 index dffbedd..430cd24 100644 --- libgomp/testsuite/libgomp.oacc-fortran/declare-1.f90 +++ libgomp/testsuite/libgomp.oacc-fortran/declare-1.f90 @@ -1,12 +1,15 @@ ! { dg-do run { target openacc_nvidia_accel_selected } } +! libgomp: cuStreamSynchronize error: an illegal memory access was encountered ! { dg-xfail-run-if "TODO" { *-*-* } } module vars + implicit none integer z !$acc declare create (z) end module vars subroutine subr6 (a, d) + implicit none integer, parameter :: N = 8 integer :: i integer :: a(N) @@ -24,6 +27,7 @@ subroutine subr6 (a, d) end subroutine subroutine subr5 (a, b, c, d) + implicit none integer, parameter :: N = 8 integer :: i integer :: a(N) @@ -48,6 +52,7 @@ subroutine subr5 (a, b, c, d) end subroutine subroutine subr4 (a, b) + implicit none integer, parameter :: N = 8 integer :: i integer :: a(N) @@ -66,6 +71,7 @@ subroutine subr4 (a, b) end subroutine subroutine subr3 (a, c) + implicit none integer, parameter :: N = 8 integer :: i integer :: a(N) @@ -85,6 +91,7 @@ subroutine subr3 (a, c) end subroutine subroutine subr2 (a, b, c) + implicit none integer, parameter :: N = 8 integer :: i integer :: a(N) @@ -106,6 +113,7 @@ subroutine subr2 (a, b, c) end subroutine subroutine subr1 (a) + implicit none integer, parameter :: N = 8 integer :: i integer :: a(N) @@ -123,6 +131,7 @@ end subroutine subroutine test (a, e) use openacc + implicit none logical :: e integer, parameter :: N = 8 integer :: a(N) @@ -132,12 +141,14 @@ subroutine test (a, e) end subroutine subroutine subr0 (a, b, c, d) + implicit none integer, parameter :: N = 8 integer :: a(N) !$acc declare copy (a) integer :: b(N) integer :: c(N) integer :: d(N) + integer :: i call test (a, .true.) call test (b, .false.) @@ -206,11 +217,13 @@ end subroutine program main use vars use openacc + implicit none integer, parameter :: N = 8 integer :: a(N) integer :: b(N) integer :: c(N) integer :: d(N) + integer :: i a(:) = 2 b(:) = 3 diff --git libgomp/testsuite/libgomp.oacc-fortran/declare-2.f90 libgomp/testsuite/libgomp.oacc-fortran/declare-2.f90 index 9b75aa1..2aa7907 100644 --- libgomp/testsuite/libgomp.oacc-fortran/declare-2.f90 +++ libgomp/testsuite/libgomp.oacc-fortran/declare-2.f90 @@ -1,6 +1,7 @@ ! { dg-do run { target openacc_nvidia_accel_selected } } module globalvars + implicit none integer a !$acc declare create (a) end module globalvars @@ -8,6 +9,7 @@ end module globalvars program test use globalvars use openacc + implicit none if (acc_is_present (a) .neqv. .true.) call abort diff --git libgomp/testsuite/libgomp.oacc-fortran/declare-3.f90 libgomp/testsuite/libgomp.oacc-fortran/declare-3.f90 index 1d19bfd..3a6b420 100644 --- libgomp/testsuite/libgomp.oacc-fortran/declare-3.f90 +++ libgomp/testsuite/libgomp.oacc-fortran/declare-3.f90 @@ -1,13 +1,15 @@ ! { dg-do run { target openacc_nvidia_accel_selected } } -! { dg-xfail-if "TODO" { *-*-* } } module globalvars + implicit none real b !$acc declare link (b) end module globalvars program test use openacc + use globalvars + implicit none real a real c diff --git libgomp/testsuite/libgomp.oacc-fortran/declare-4.f90 libgomp/testsuite/libgomp.oacc-fortran/declare-4.f90 index 997c8ac..226264e 100644 --- libgomp/testsuite/libgomp.oacc-fortran/declare-4.f90 +++ libgomp/testsuite/libgomp.oacc-fortran/declare-4.f90 @@ -1,6 +1,7 @@ ! { dg-do run { target openacc_nvidia_accel_selected } } module vars + implicit none real b !$acc declare create (b) end module vars @@ -8,6 +9,7 @@ end module vars program test use vars use openacc + implicit none real a if (acc_is_present (b) .neqv. .true.) call abort diff --git libgomp/testsuite/libgomp.oacc-fortran/declare-5.f90 libgomp/testsuite/libgomp.oacc-fortran/declare-5.f90 index d7c9bac..bcd9c9c 100644 --- libgomp/testsuite/libgomp.oacc-fortran/declare-5.f90 +++ libgomp/testsuite/libgomp.oacc-fortran/declare-5.f90 @@ -9,6 +9,7 @@ end module vars program test use vars use openacc + implicit none real a if (acc_is_present (b) .neqv. .true.) call abort