From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: (qmail 86970 invoked by alias); 2 Nov 2015 13:46:35 -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 86947 invoked by uid 89); 2 Nov 2015 13:46:34 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-0.6 required=5.0 tests=AWL,BAYES_50,RCVD_IN_DNSWL_LOW,SPF_PASS,T_FROM_12LTRDOM 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; Mon, 02 Nov 2015 13:46:30 +0000 Received: from svr-orw-fem-03.mgc.mentorg.com ([147.34.97.39]) by relay1.mentorg.com with esmtp id 1ZtFRJ-0004wz-QI from James_Norris@mentor.com ; Mon, 02 Nov 2015 05:46:25 -0800 Received: from [172.30.80.90] (147.34.91.1) by svr-orw-fem-03.mgc.mentorg.com (147.34.97.39) with Microsoft SMTP Server id 14.3.224.2; Mon, 2 Nov 2015 05:46:25 -0800 Message-ID: <5637692F.7050306@codesourcery.com> Date: Mon, 02 Nov 2015 13:46:00 -0000 From: James Norris User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:31.0) Gecko/20100101 Thunderbird/31.7.0 MIME-Version: 1.0 To: GCC Patches , , Tobias Burnus Subject: OpenACC declare directive updates Content-Type: multipart/mixed; boundary="------------090802010505050703030903" X-SW-Source: 2015-11/txt/msg00066.txt.bz2 --------------090802010505050703030903 Content-Type: text/plain; charset="utf-8"; format=flowed Content-Transfer-Encoding: 7bit Content-length: 419 This patch updates the processing of OpenACC declare directive for Fortran in the following areas: 1) module support 2) device_resident and link clauses 3) clause checking 4) directive generation Commentary on the changes is included as an attachment (NOTES). All of the code is in the gomp-4_0-branch. Regtested on x86_64-linux. Thanks! Jim --------------090802010505050703030903 Content-Type: text/plain; charset="UTF-8"; name="NOTES" Content-Transfer-Encoding: base64 Content-Disposition: attachment; filename="NOTES" Content-length: 3620 ICAgIEJhY2tncm91bmQKCiAgICAgICAgVGhlIGRlY2xhcmUgZGlyZWN0aXZl IGlzIHVzZWQgdG8gYWxsb2NhdGUgZGV2aWNlIG1lbW9yeSBmb3IgdGhlCiAg ICAgICAgZW50aXJlIHNjb3BlIG9mIGEgdmFyaWFibGUgLyBhcnJheSB3aXRo aW4gYSBwcm9ncmFtLCBmdW5jdGlvbiwKICAgICAgICBvciBzdWJyb3V0aW5l LiBDb25zaWRlciB0aGUgZm9sbG93aW5nIGV4YW1wbGUuCgogICAgICAgICAg ICBtb2R1bGUgdmFycwogICAgICAgICAgICAgIGludGVnZXIgYgogICAgICAg ICAgICAgICEkYWNjIGRlY2xhcmUgZGV2aWNlX3Jlc2lkZW50IChiKQogICAg ICAgICAgICAgIGludGVnZXIgYwogICAgICAgICAgICAgICEkYWNjIGRlY2xh cmUgbGluayAoYykKICAgICAgICAgICAgZW5kIG1vZHVsZSB2YXJzCiAgICAg ICAgICAgIAogICAgICAgICAgICBwcm9ncmFtIG1haW4KICAgICAgICAgICAg ICB1c2UgdmFycwogICAgICAgICAgICAgIGludGVnZXIsIHBhcmFtZXRlciA6 OiBOID0gOAogICAgICAgICAgICAgIGludGVnZXIgOjogYShOKQogICAgICAg ICAgICAKICAgICAgICAgICAgICBhKDopID0gMgogICAgICAgICAgICAgIGMg PSAxMgogICAgICAgICAgICAKICAgICAgICAgICAgICAhJGFjYyBwYXJhbGxl bCBjb3B5IChhKSBwcmVzZW50IChiKSBjb3B5aW4oYykKICAgICAgICAgICAg ICBkbyBpID0gMSwgTgogICAgICAgICAgICAgICAgYiA9IGEoaSkKICAgICAg ICAgICAgICAgIGMgPSBiCiAgICAgICAgICAgICAgICBhKGkpID0gYyArIGkK ICAgICAgICAgICAgICBlbmQgZG8KICAgICAgICAgICAgICAhJGFjYyBlbmQg cGFyYWxsZWwKICAgICAgICAgICAgCiAgICAgICAgICAgIGVuZCBwcm9ncmFt CgogICAgICAgIEluIHRoZSBleGFtcGxlLCAnYicgd2lsbCBiZSBhbGxvY2F0 ZWQgb24gdGhlIGRldmljZSBhdCB0aGUgb3V0c2V0CiAgICAgICAgb2YgZGV2 aWNlIGFjdGl2aXR5IGFuZCBiZSBhdmFpbGFibGUgZm9yIHRoZSBkdXJhdGlv bi4gV2hlcmVhcyB0aGUKICAgICAgICBhbGxvY2F0aW9uIG9mICdjJyB3aWxs IGJlIGRlbGF5ZWQgdW50aWwgdGhlIHBhcmFsbGVsIHJlZ2lvbiBpcwogICAg ICAgIGVudGVyZWQuIFRoZSBkZXZpY2UgbWVtb3J5IGZvciAnYycgd2lsbCBi ZSBkZWFsbG9jYXRlZCB1cG9uIGV4aXQKICAgICAgICBvZiB0aGUgcGFyYWxs ZWwgcmVnaW9uLgoKICAgIEZvcnRyYW4gZnJvbnQtZW5kCgogICAgICAgIFRo ZSBjaGFuZ2VzIGFyZSBjb25jZW50cmF0ZWQgaW50byBmb3VyICg0KSBhcmVh cy4KCiAgICAgICAgMSkgbW9kdWxlIHN1cHBvcnQKICAgICAgICAgICAgVGhl IG5lY2Nlc2FyeSBmdW5jdGlvbmFsaXR5IGhhcyBiZWVuIGFkZGVkIHRvIGhh bmRsZSB0aGUKICAgICAgICAgICAgcmVhZGluZyBpbiBhbmQgd3JpdGluZyBv dXQgb2YgdGhlIGFwcHJvcHJpYXRlIGF0dHJpYnV0ZXMKICAgICAgICAgICAg Zm9yIHRoZSBkZWNsYXJlIGRpcmVjdGl2ZS4gQWRkaXRpb25hbCBmdW5jdGlv bmFsaXR5IGhhcwogICAgICAgICAgICBiZWVuIGFkZGVkIGF0IHJlYWQgaW4g dGltZSB0byBzZXR1cCB0aGUgcmVxdWlyZWQgZGVjbGFyZQogICAgICAgICAg ICBoYW5kbGluZy4KCiAgICAgICAgMikgZGV2aWNlX3Jlc2lkZW50IGFuZCBs aW5rIGNsYXVzZXMKICAgICAgICAgICAgQWRkIHRoZSBmdW5jdGlvbmFsaXR5 IG5lY2Vzc2FyeSB0byBwcm9jZXNzIHRoZSBsaW5rIGFuZAogICAgICAgICAg ICBkZXZpY2VfcmVzaWRlbnQgY2xhdXNlcy4KCiAgICAgICAgMykgY2xhdXNl IGNoZWNraW5nCiAgICAgICAgICAgIFRoZSBjbGF1c2UgY2hlY2tpbmcgaGFz IGJlZW4gY2xlYW5lZCB1cCB0byBiZXR0ZXIgY2hlY2sKICAgICAgICAgICAg Zm9yIGR1cGxpY2F0ZXMgYW5kIGNvcnJlY3RuZXNzLgoKICAgICAgICA0KSBk aXJlY3RpdmUgZ2VuZXJhdGlvbgoKICAgICAgICAgICAgUHJpb3IgdG8gaGFu ZGxpbmcgdGhlIGZvcnRyYW4gZXhlY3V0aW9uIGJvZHkgYSBjb2RlCiAgICAg ICAgICAgIGJvZHkgaXMgY3JlYXRlZCB0byBoYW5kbGUgdGhlIGNsYXVzZShz KSB0aGF0IGFjY29tcGFueQogICAgICAgICAgICB0aGUgZGVjbGFyZSBkaXJl Y3RpdmUocykuIEVhY2ggY2xhdXNlIGlzIGV4YW1pbmVkIGFuZAogICAgICAg ICAgICBkZXRlcm1pbmVkIHdoZXRoZXIgdGhlIGNsYXVzZSBuZWVkIHRvIGJl IG1vZGlmaWVkIHRvIAogICAgICAgICAgICBwZXJmb3JtIGFuIGFjdGlvbiBh dCB0aGUgYmVnaW5uaW5nIG9mIHRoZSBtb2R1bGUsIGZ1bmN0aW9uLAogICAg ICAgICAgICBzdWJyb3V0aW5lLCBvciBwcm9ncmFtLiBGdXJ0aGVybW9yZSwg YW4gYWRkaXRpb25hbAogICAgICAgICAgICBjbGF1c2UgbWF5IGJlIGFkZGVk IHRvIHRoZSBsaXN0IHRvIHBlcmZvcm0gYW4gYWN0aW9uCiAgICAgICAgICAg IGF0IHRoZSB0aW1lIHRoZSBmdW5jdGlvbiBvciBzdWJyb3V0aW5lIHJldHVy bnMuCgogICAgICAgICAgICBPbmNlIGFsbCB0aGUgY2xhdXNlcyBoYXZlIGJl ZW4gaGFuZGxlZCwgdGhlIGNvZGUgYm9keQogICAgICAgICAgICBpcyBhZGRl ZCB0byB0aGUgY2hhaW4uCgogICAgbGliZ29tcAoKICAgICAgICBUT0RPCgog ICAgVGVzdGluZwoKICAgICAgICBOZXcgY29tcGlsZSBhbmQgcnVudGltZSB0 ZXN0cyBoYXZlIGJlZW4gYWRkZWQuIEFsc28gc29tZSBoYXZlCiAgICAgICAg YmVlbiBtb2RpZmllZC4K --------------090802010505050703030903 Content-Type: text/x-patch; name="declare2.patch" Content-Transfer-Encoding: 7bit Content-Disposition: attachment; filename="declare2.patch" Content-length: 43734 diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c index 83ecbaa..e953160 100644 --- a/gcc/fortran/dump-parse-tree.c +++ b/gcc/fortran/dump-parse-tree.c @@ -2572,10 +2572,14 @@ show_namespace (gfc_namespace *ns) if (ns->oacc_declare_clauses) { + struct gfc_oacc_declare *decl; /* Dump !$ACC DECLARE clauses. */ - show_indent (); - fprintf (dumpfile, "!$ACC DECLARE"); - show_omp_clauses (ns->oacc_declare_clauses); + for (decl = ns->oacc_declare_clauses; decl; decl = decl->next) + { + show_indent (); + fprintf (dumpfile, "!$ACC DECLARE"); + show_omp_clauses (decl->clauses); + } } fputc ('\n', dumpfile); diff --git a/gcc/fortran/f95-lang.c b/gcc/fortran/f95-lang.c index 67b0bac..2758a28 100644 --- a/gcc/fortran/f95-lang.c +++ b/gcc/fortran/f95-lang.c @@ -103,6 +103,8 @@ static const struct attribute_spec gfc_attribute_table[] = affects_type_identity } */ { "omp declare target", 0, 0, true, false, false, gfc_handle_omp_declare_target_attribute, false }, + { "oacc declare", 0, 0, true, false, false, + gfc_handle_omp_declare_target_attribute, false }, { NULL, 0, 0, false, false, false, NULL, false } }; diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 90f63cf..17c2357 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -840,6 +840,13 @@ typedef struct /* Mentioned in OMP DECLARE TARGET. */ unsigned omp_declare_target:1; + /* Mentioned in OACC DECLARE. */ + unsigned oacc_declare_create:1; + unsigned oacc_declare_copyin:1; + unsigned oacc_declare_deviceptr:1; + unsigned oacc_declare_device_resident:1; + unsigned oacc_declare_link:1; + /* Attributes set by compiler extensions (!GCC$ ATTRIBUTES). */ unsigned ext_attr:EXT_ATTR_NUM; @@ -1105,7 +1112,9 @@ enum gfc_omp_map_op OMP_MAP_FORCE_FROM, OMP_MAP_FORCE_TOFROM, OMP_MAP_FORCE_PRESENT, - OMP_MAP_FORCE_DEVICEPTR + OMP_MAP_FORCE_DEVICEPTR, + OMP_MAP_DEVICE_RESIDENT, + OMP_MAP_LINK }; /* For use in OpenMP clauses in case we need extra information @@ -1146,6 +1155,7 @@ enum OMP_LIST_FROM, OMP_LIST_REDUCTION, OMP_LIST_DEVICE_RESIDENT, + OMP_LIST_LINK, OMP_LIST_USE_DEVICE, OMP_LIST_CACHE, OMP_LIST_NUM @@ -1232,6 +1242,20 @@ gfc_omp_clauses; #define gfc_get_omp_clauses() XCNEW (gfc_omp_clauses) +/* Node in the linked list used for storing !$oacc declare constructs. */ + +typedef struct gfc_oacc_declare +{ + struct gfc_oacc_declare *next; + bool module_var; + gfc_omp_clauses *clauses; + gfc_omp_clauses *return_clauses; +} +gfc_oacc_declare; + +#define gfc_get_oacc_declare() XCNEW (gfc_oacc_declare) + + /* Node in the linked list used for storing !$omp declare simd constructs. */ typedef struct gfc_omp_declare_simd @@ -1644,7 +1668,7 @@ typedef struct gfc_namespace struct gfc_data *data, *old_data; /* !$ACC DECLARE clauses. */ - gfc_omp_clauses *oacc_declare_clauses; + struct gfc_oacc_declare *oacc_declare_clauses; gfc_charlen *cl_list, *old_cl_list; @@ -2321,7 +2345,7 @@ enum gfc_exec_op 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_OACC_ENTER_DATA, EXEC_OACC_EXIT_DATA, EXEC_OACC_DECLARE, 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, @@ -2403,6 +2427,7 @@ typedef struct gfc_code struct gfc_code *which_construct; int stop_code; gfc_entry_list *entry; + gfc_oacc_declare *oacc_declare; gfc_omp_clauses *omp_clauses; const char *omp_name; gfc_omp_namelist *omp_namelist; @@ -2905,6 +2930,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_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 *); @@ -3222,4 +3248,8 @@ gfc_expr *gfc_simplify_ieee_functions (gfc_expr *); bool gfc_is_reallocatable_lhs (gfc_expr *); +/* trans-decl.c */ + +void finish_oacc_declare (gfc_namespace *, enum sym_flavor); + #endif /* GCC_GFORTRAN_H */ diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c index f0d84a4..63d8444 100644 --- a/gcc/fortran/module.c +++ b/gcc/fortran/module.c @@ -1987,7 +1987,9 @@ enum ab_attribute AB_IS_CLASS, AB_PROCEDURE, AB_PROC_POINTER, AB_ASYNCHRONOUS, AB_CODIMENSION, AB_COARRAY_COMP, AB_VTYPE, AB_VTAB, AB_CONTIGUOUS, AB_CLASS_POINTER, AB_IMPLICIT_PURE, AB_ARTIFICIAL, AB_UNLIMITED_POLY, AB_OMP_DECLARE_TARGET, - AB_ARRAY_OUTER_DEPENDENCY, AB_MODULE_PROCEDURE + AB_ARRAY_OUTER_DEPENDENCY, AB_MODULE_PROCEDURE, AB_OACC_DECLARE_CREATE, + AB_OACC_DECLARE_COPYIN, AB_OACC_DECLARE_DEVICEPTR, + AB_OACC_DECLARE_DEVICE_RESIDENT, AB_OACC_DECLARE_LINK }; static const mstring attr_bits[] = @@ -2044,6 +2046,11 @@ static const mstring attr_bits[] = minit ("OMP_DECLARE_TARGET", AB_OMP_DECLARE_TARGET), minit ("ARRAY_OUTER_DEPENDENCY", AB_ARRAY_OUTER_DEPENDENCY), minit ("MODULE_PROCEDURE", AB_MODULE_PROCEDURE), + minit ("OACC_DECLARE_CREATE", AB_OACC_DECLARE_CREATE), + minit ("OACC_DECLARE_COPYIN", AB_OACC_DECLARE_COPYIN), + minit ("OACC_DECLARE_DEVICEPTR", AB_OACC_DECLARE_DEVICEPTR), + minit ("OACC_DECLARE_DEVICE_RESIDENT", AB_OACC_DECLARE_DEVICE_RESIDENT), + minit ("OACC_DECLARE_LINK", AB_OACC_DECLARE_LINK), minit (NULL, -1) }; @@ -2231,6 +2238,16 @@ mio_symbol_attribute (symbol_attribute *attr) MIO_NAME (ab_attribute) (AB_MODULE_PROCEDURE, attr_bits); no_module_procedures = false; } + if (attr->oacc_declare_create) + MIO_NAME (ab_attribute) (AB_OACC_DECLARE_CREATE, attr_bits); + if (attr->oacc_declare_copyin) + MIO_NAME (ab_attribute) (AB_OACC_DECLARE_COPYIN, attr_bits); + if (attr->oacc_declare_deviceptr) + MIO_NAME (ab_attribute) (AB_OACC_DECLARE_DEVICEPTR, attr_bits); + if (attr->oacc_declare_device_resident) + MIO_NAME (ab_attribute) (AB_OACC_DECLARE_DEVICE_RESIDENT, attr_bits); + if (attr->oacc_declare_link) + MIO_NAME (ab_attribute) (AB_OACC_DECLARE_LINK, attr_bits); mio_rparen (); @@ -2403,6 +2420,21 @@ mio_symbol_attribute (symbol_attribute *attr) case AB_MODULE_PROCEDURE: attr->module_procedure =1; break; + case AB_OACC_DECLARE_CREATE: + attr->oacc_declare_create = 1; + break; + case AB_OACC_DECLARE_COPYIN: + attr->oacc_declare_copyin = 1; + break; + case AB_OACC_DECLARE_DEVICEPTR: + attr->oacc_declare_deviceptr = 1; + break; + case AB_OACC_DECLARE_DEVICE_RESIDENT: + attr->oacc_declare_device_resident = 1; + break; + case AB_OACC_DECLARE_LINK: + attr->oacc_declare_link = 1; + break; } } } diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c index 6c78c97..485fac3 100644 --- a/gcc/fortran/openmp.c +++ b/gcc/fortran/openmp.c @@ -90,6 +90,25 @@ gfc_free_omp_clauses (gfc_omp_clauses *c) free (c); } +/* Free oacc_declare structures. */ + +void +gfc_free_oacc_declare_clauses (struct gfc_oacc_declare *oc) +{ + struct gfc_oacc_declare *decl = oc; + + do + { + struct gfc_oacc_declare *next; + + next = decl->next; + gfc_free_omp_clauses (decl->clauses); + free (decl); + decl = next; + } + while (decl); +} + /* Free expression list. */ void gfc_free_expr_list (gfc_expr_list *list) @@ -451,6 +470,7 @@ 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_LINK ((uint64_t) 1 << 58) /* Helper function for OpenACC and OpenMP clauses involving memory mapping. */ @@ -689,6 +709,12 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask, true) == MATCH_YES) continue; + if ((mask & OMP_CLAUSE_LINK) + && gfc_match_omp_variable_list ("link (", + &c->lists[OMP_LIST_LINK], + true) + == MATCH_YES) + continue; if ((mask & OMP_CLAUSE_OACC_DEVICE) && gfc_match ("device ( ") == MATCH_YES && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP], @@ -1171,7 +1197,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask, | OMP_CLAUSE_CREATE | OMP_CLAUSE_DEVICEPTR | OMP_CLAUSE_DEVICE_RESIDENT \ | OMP_CLAUSE_PRESENT | OMP_CLAUSE_PRESENT_OR_COPY \ | OMP_CLAUSE_PRESENT_OR_COPYIN | OMP_CLAUSE_PRESENT_OR_COPYOUT \ - | OMP_CLAUSE_PRESENT_OR_CREATE) + | OMP_CLAUSE_PRESENT_OR_CREATE | OMP_CLAUSE_LINK) #define OACC_UPDATE_CLAUSES \ (OMP_CLAUSE_IF | OMP_CLAUSE_ASYNC | OMP_CLAUSE_HOST_SELF \ | OMP_CLAUSE_OACC_DEVICE | OMP_CLAUSE_WAIT) @@ -1288,12 +1314,86 @@ match gfc_match_oacc_declare (void) { gfc_omp_clauses *c; + gfc_omp_namelist *n; + gfc_namespace *ns = gfc_current_ns; + gfc_oacc_declare *new_oc; + bool module_var = false; + if (gfc_match_omp_clauses (&c, OACC_DECLARE_CLAUSES, false, false, true) != MATCH_YES) return MATCH_ERROR; - new_st.ext.omp_clauses = c; - new_st.ext.omp_clauses->loc = gfc_current_locus; + for (n = c->lists[OMP_LIST_DEVICE_RESIDENT]; n != NULL; n = n->next) + n->sym->attr.oacc_declare_device_resident = 1; + + for (n = c->lists[OMP_LIST_LINK]; n != NULL; n = n->next) + n->sym->attr.oacc_declare_link = 1; + + for (n = c->lists[OMP_LIST_MAP]; n != NULL; n = n->next) + { + gfc_symbol *s = n->sym; + locus where = gfc_current_locus; + + if (s->ns->proc_name && s->ns->proc_name->attr.proc == PROC_MODULE) + { + 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 %L", + &where); + return MATCH_ERROR; + } + + module_var = true; + } + + if (s->attr.in_common) + { + gfc_error ("Variable in a common block with $!ACC DECLARE at %L", + &where); + return MATCH_ERROR; + } + + if (s->attr.use_assoc) + { + 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 ("Assumed-size dummy array with $!ACC DECLARE at %L", + &where); + return MATCH_ERROR; + } + + switch (n->u.map_op) + { + case OMP_MAP_FORCE_ALLOC: + s->attr.oacc_declare_create = 1; + break; + + case OMP_MAP_FORCE_TO: + s->attr.oacc_declare_copyin = 1; + break; + + case OMP_MAP_FORCE_DEVICEPTR: + s->attr.oacc_declare_deviceptr = 1; + break; + + default: + break; + } + } + + new_oc = gfc_get_oacc_declare (); + new_oc->next = ns->oacc_declare_clauses; + new_oc->module_var = module_var; + new_oc->clauses = c; + ns->oacc_declare_clauses = new_oc; + return MATCH_YES; } @@ -2857,6 +2957,42 @@ oacc_compatible_clauses (gfc_omp_clauses *clauses, int list, return false; } +/* Check if a variable appears in multiple clauses. */ + +static void +resolve_omp_duplicate_list (gfc_omp_namelist *clause_list, bool openacc, + int list) +{ + gfc_omp_namelist *n; + const char *error_msg = "Symbol %qs present on multiple clauses at %L"; + + /* OpenACC reduction clauses are compatible with everything. We only + need to check if a reduction variable is used more than once. */ + if (openacc && list == OMP_LIST_REDUCTION) + { + hash_set reductions; + + for (n = clause_list; n; n = n->next) + { + if (reductions.contains (n->sym)) + gfc_error (error_msg, n->sym->name, &n->expr->where); + else + reductions.add (n->sym); + } + + return; + } + + /* Ensure that variables are only used in one clause. */ + for (n = clause_list; n; n = n->next) + { + if (n->sym->mark) + gfc_error (error_msg, n->sym->name, &n->expr->where); + else + n->sym->mark = 1; + } +} + /* OpenMP directive resolving routines. */ static void @@ -4598,41 +4734,59 @@ resolve_oacc_loop (gfc_code *code) } +/* Helper function for gfc_resolve_oacc_declare. Scan omp_map_list LIST + in DECLARE at location LOC. */ + +static void +resolve_oacc_declare_map (gfc_oacc_declare *declare, int list) +{ + gfc_oacc_declare *oc; + gfc_omp_namelist *n; + + for (oc = declare; oc; oc = oc->next) + for (n = oc->clauses->lists[list]; n; n = n->next) + n->sym->mark = 0; + + for (oc = declare; oc; oc = oc->next) + resolve_omp_duplicate_list (oc->clauses->lists[list], false, list); + + for (oc = declare; oc; oc = oc->next) + for (n = oc->clauses->lists[list]; n; n = n->next) + n->sym->mark = 0; +} + void gfc_resolve_oacc_declare (gfc_namespace *ns) { - int list; gfc_omp_namelist *n; - locus loc; + gfc_oacc_declare *oc; if (ns->oacc_declare_clauses == NULL) return; - loc = ns->oacc_declare_clauses->loc; + for (oc = ns->oacc_declare_clauses; oc; oc = oc->next) + { + for (n = oc->clauses->lists[OMP_LIST_DEVICE_RESIDENT]; 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, &gfc_current_locus); - for (list = OMP_LIST_DEVICE_RESIDENT; - list <= OMP_LIST_DEVICE_RESIDENT; list++) - for (n = ns->oacc_declare_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); - } + check_array_not_assumed (n->sym, gfc_current_locus, + "DEVICE_RESIDENT"); + } - for (list = OMP_LIST_DEVICE_RESIDENT; - list <= OMP_LIST_DEVICE_RESIDENT; list++) - for (n = ns->oacc_declare_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; - } + 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 is not allowed in $!ACC DECLARE at %L", + n->sym->name, &n->expr->where); + } - for (n = ns->oacc_declare_clauses->lists[OMP_LIST_DEVICE_RESIDENT]; n; - n = n->next) - check_array_not_assumed (n->sym, loc, "DEVICE_RESIDENT"); + /* Check for duplicate link, device_resident and data clauses. */ + resolve_oacc_declare_map (ns->oacc_declare_clauses, OMP_LIST_LINK); + resolve_oacc_declare_map (ns->oacc_declare_clauses, OMP_LIST_DEVICE_RESIDENT); + resolve_oacc_declare_map (ns->oacc_declare_clauses, OMP_LIST_MAP); } diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c index 4925c7e..be9d0c7 100644 --- a/gcc/fortran/parse.c +++ b/gcc/fortran/parse.c @@ -1381,7 +1381,7 @@ next_statement (void) case ST_EQUIVALENCE: case ST_NAMELIST: case ST_STATEMENT_FUNCTION: \ case ST_TYPE: case ST_INTERFACE: case ST_OMP_THREADPRIVATE: \ case ST_PROCEDURE: case ST_OMP_DECLARE_SIMD: case ST_OMP_DECLARE_REDUCTION: \ - case ST_OMP_DECLARE_TARGET: case ST_OACC_ROUTINE + case ST_OMP_DECLARE_TARGET: case ST_OACC_ROUTINE: case ST_OACC_DECLARE /* Block end statements. Errors associated with interchanging these are detected in gfc_match_end(). */ @@ -2439,7 +2439,6 @@ 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; @@ -3351,19 +3350,6 @@ 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.oacc_declare_clauses == NULL) - gfc_state_stack->ext.oacc_declare_clauses = new_st.ext.omp_clauses; - accept_statement (st); - st = next_statement (); - goto loop; - default: break; } @@ -5189,13 +5175,6 @@ 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_state_stack->state == COMP_BLOCK) - gfc_current_ns->oacc_declare_clauses - = gfc_state_stack->ext.oacc_declare_clauses; } diff --git a/gcc/fortran/parse.h b/gcc/fortran/parse.h index bcd714d..83977bb 100644 --- a/gcc/fortran/parse.h +++ b/gcc/fortran/parse.h @@ -48,7 +48,7 @@ typedef struct gfc_state_data union { gfc_st_label *end_do_label; - gfc_omp_clauses *oacc_declare_clauses; + struct gfc_oacc_declare *oacc_declare_clauses; } ext; } diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 8798d4d..51a0b04 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -9373,6 +9373,7 @@ gfc_resolve_blocks (gfc_code *b, gfc_namespace *ns) case EXEC_OACC_CACHE: case EXEC_OACC_ENTER_DATA: case EXEC_OACC_EXIT_DATA: + case EXEC_OACC_DECLARE: case EXEC_OMP_ATOMIC: case EXEC_OMP_CRITICAL: case EXEC_OMP_DISTRIBUTE: @@ -10645,6 +10646,7 @@ start: case EXEC_OACC_CACHE: case EXEC_OACC_ENTER_DATA: case EXEC_OACC_EXIT_DATA: + case EXEC_OACC_DECLARE: gfc_resolve_oacc_directive (code, ns); break; diff --git a/gcc/fortran/st.c b/gcc/fortran/st.c index 116af15..b77a22f 100644 --- a/gcc/fortran/st.c +++ b/gcc/fortran/st.c @@ -185,6 +185,11 @@ gfc_free_statement (gfc_code *p) gfc_free_forall_iterator (p->ext.forall_iterator); break; + case EXEC_OACC_DECLARE: + if (p->ext.oacc_declare) + gfc_free_oacc_declare_clauses (p->ext.oacc_declare); + break; + case EXEC_OACC_PARALLEL_LOOP: case EXEC_OACC_PARALLEL: case EXEC_OACC_KERNELS_LOOP: diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c index bd7758b..43fd25d 100644 --- a/gcc/fortran/symbol.c +++ b/gcc/fortran/symbol.c @@ -375,6 +375,11 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where) *contiguous = "CONTIGUOUS", *generic = "GENERIC"; static const char *threadprivate = "THREADPRIVATE"; static const char *omp_declare_target = "OMP DECLARE TARGET"; + static const char *oacc_declare_copyin = "OACC DECLARE COPYIN"; + static const char *oacc_declare_create = "OACC DECLARE CREATE"; + static const char *oacc_declare_deviceptr = "OACC DECLARE DEVICEPTR"; + static const char *oacc_declare_device_resident = + "OACC DECLARE DEVICE_RESIDENT"; const char *a1, *a2; int standard; @@ -511,6 +516,10 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where) conf (in_equivalence, allocatable); conf (in_equivalence, threadprivate); conf (in_equivalence, omp_declare_target); + conf (in_equivalence, oacc_declare_create); + conf (in_equivalence, oacc_declare_copyin); + conf (in_equivalence, oacc_declare_deviceptr); + conf (in_equivalence, oacc_declare_device_resident); conf (dummy, result); conf (entry, result); @@ -560,6 +569,10 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where) conf (cray_pointee, in_equivalence); conf (cray_pointee, threadprivate); conf (cray_pointee, omp_declare_target); + conf (cray_pointee, oacc_declare_create); + conf (cray_pointee, oacc_declare_copyin); + conf (cray_pointee, oacc_declare_deviceptr); + conf (cray_pointee, oacc_declare_device_resident); conf (data, dummy); conf (data, function); @@ -614,6 +627,10 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where) conf (proc_pointer, abstract) conf (entry, omp_declare_target) + conf (entry, oacc_declare_create) + conf (entry, oacc_declare_copyin) + conf (entry, oacc_declare_deviceptr) + conf (entry, oacc_declare_device_resident) a1 = gfc_code2string (flavors, attr->flavor); @@ -651,6 +668,10 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where) conf2 (subroutine); conf2 (threadprivate); conf2 (omp_declare_target); + conf2 (oacc_declare_create); + conf2 (oacc_declare_copyin); + conf2 (oacc_declare_deviceptr); + conf2 (oacc_declare_device_resident); if (attr->access == ACCESS_PUBLIC || attr->access == ACCESS_PRIVATE) { @@ -733,6 +754,10 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where) conf2 (threadprivate); conf2 (result); conf2 (omp_declare_target); + conf2 (oacc_declare_create); + conf2 (oacc_declare_copyin); + conf2 (oacc_declare_deviceptr); + conf2 (oacc_declare_device_resident); if (attr->intent != INTENT_UNKNOWN) { @@ -1244,6 +1269,62 @@ 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) +{ + if (check_used (attr, name, where)) + return false; + + if (attr->oacc_declare_create) + return true; + + attr->oacc_declare_create = 1; + return check_conflict (attr, name, where); +} + + +bool +gfc_add_oacc_declare_copyin (symbol_attribute *attr, const char *name, locus *where) +{ + if (check_used (attr, name, where)) + return false; + + if (attr->oacc_declare_copyin) + return true; + + attr->oacc_declare_copyin = 1; + return check_conflict (attr, name, where); +} + + +bool +gfc_add_oacc_declare_deviceptr (symbol_attribute *attr, const char *name, locus *where) +{ + if (check_used (attr, name, where)) + return false; + + if (attr->oacc_declare_deviceptr) + return true; + + attr->oacc_declare_deviceptr = 1; + return check_conflict (attr, name, where); +} + + +bool +gfc_add_oacc_declare_device_resident (symbol_attribute *attr, const char *name, locus *where) +{ + if (check_used (attr, name, where)) + return false; + + if (attr->oacc_declare_device_resident) + return true; + + attr->oacc_declare_device_resident = 1; + return check_conflict (attr, name, where); +} + + +bool gfc_add_target (symbol_attribute *attr, locus *where) { @@ -1820,6 +1901,18 @@ gfc_copy_attr (symbol_attribute *dest, symbol_attribute *src, locus *where) if (src->omp_declare_target && !gfc_add_omp_declare_target (dest, NULL, where)) goto fail; + if (src->oacc_declare_create + && !gfc_add_oacc_declare_create (dest, NULL, where)) + goto fail; + if (src->oacc_declare_copyin + && !gfc_add_oacc_declare_copyin (dest, NULL, where)) + goto fail; + if (src->oacc_declare_deviceptr + && !gfc_add_oacc_declare_deviceptr (dest, NULL, where)) + goto fail; + if (src->oacc_declare_device_resident + && !gfc_add_oacc_declare_device_resident (dest, NULL, where)) + goto fail; if (src->target && !gfc_add_target (dest, where)) goto fail; if (src->dummy && !gfc_add_dummy (dest, NULL, where)) diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 269c235..28b3c2c 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -1309,6 +1309,15 @@ add_attributes_to_decl (symbol_attribute sym_attr, tree list) list = tree_cons (get_identifier ("omp declare target"), NULL_TREE, list); + if (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_link) + { + list = tree_cons (get_identifier ("oacc declare"), + NULL_TREE, list); + } return list; } @@ -5754,6 +5763,192 @@ is_ieee_module_used (gfc_namespace *ns) } +static gfc_omp_clauses *module_oacc_clauses; + + +static void +add_clause (gfc_symbol *sym, gfc_omp_map_op map_op) +{ + gfc_omp_namelist *n; + + n = gfc_get_omp_namelist (); + n->sym = sym; + n->u.map_op = map_op; + + if (!module_oacc_clauses) + module_oacc_clauses = gfc_get_omp_clauses (); + + if (module_oacc_clauses->lists[OMP_LIST_MAP]) + n->next = module_oacc_clauses->lists[OMP_LIST_MAP]; + + module_oacc_clauses->lists[OMP_LIST_MAP] = n; +} + + +static void +find_module_oacc_declare_clauses (gfc_symbol *sym) +{ + if (sym->attr.use_assoc) + { + gfc_omp_map_op map_op; + + if (sym->attr.oacc_declare_create) + map_op = OMP_MAP_FORCE_ALLOC; + + if (sym->attr.oacc_declare_copyin) + map_op = OMP_MAP_FORCE_TO; + + if (sym->attr.oacc_declare_deviceptr) + map_op = OMP_MAP_FORCE_DEVICEPTR; + + if (sym->attr.oacc_declare_device_resident) + map_op = OMP_MAP_DEVICE_RESIDENT; + + if (sym->attr.oacc_declare_create + || sym->attr.oacc_declare_copyin + || sym->attr.oacc_declare_deviceptr + || sym->attr.oacc_declare_device_resident) + { + sym->attr.referenced = 1; + add_clause (sym, map_op); + } + } +} + + +void +finish_oacc_declare (gfc_namespace *ns, enum sym_flavor flavor) +{ + gfc_code *code; + gfc_oacc_declare *oc; + gfc_omp_namelist *n; + locus where = gfc_current_locus; + + gfc_traverse_ns (ns, find_module_oacc_declare_clauses); + + if (module_oacc_clauses && flavor == FL_PROGRAM) + { + gfc_oacc_declare *new_oc; + + new_oc = gfc_get_oacc_declare (); + new_oc->next = ns->oacc_declare_clauses; + new_oc->clauses = module_oacc_clauses; + + ns->oacc_declare_clauses = new_oc; + module_oacc_clauses = NULL; + } + + if (!ns->oacc_declare_clauses) + return; + + for (oc = ns->oacc_declare_clauses; 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; + + 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; + + case OMP_MAP_FROM: + n->u.map_op = OMP_MAP_FORCE_ALLOC; + new_op = OMP_MAP_FROM; + ret = true; + break; + + case OMP_MAP_FORCE_DEVICEPTR: + case OMP_MAP_FORCE_PRESENT: + case OMP_MAP_LINK: + case OMP_MAP_TO: + break; + + case OMP_MAP_TOFROM: + n->u.map_op = OMP_MAP_TO; + new_op = OMP_MAP_FROM; + ret = true; + break; + + default: + gcc_unreachable (); + break; + } + + if (ret) + { + gfc_omp_namelist *new_n; + + new_n = gfc_get_omp_namelist (); + new_n->sym = n->sym; + new_n->u.map_op = new_op; + + if (!ret_clauses) + ret_clauses = gfc_get_omp_clauses (); + + if (ret_clauses->lists[OMP_LIST_MAP]) + new_n->next = ret_clauses->lists[OMP_LIST_MAP]; + + ret_clauses->lists[OMP_LIST_MAP] = new_n; + ret = false; + } + } + + 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->next = ns->code; + ns->code = code; + } + } + + return; +} + + /* Generate code for a function. */ void @@ -5891,11 +6086,7 @@ gfc_generate_function_code (gfc_namespace * ns) add_argument_checking (&body, sym); /* Generate !$ACC DECLARE directive. */ - if (ns->oacc_declare_clauses) - { - tree tmp = gfc_trans_oacc_declare (&body, ns); - gfc_add_expr_to_block (&body, tmp); - } + finish_oacc_declare (ns, sym->attr.flavor); tmp = gfc_trans_code (ns->code); gfc_add_expr_to_block (&body, tmp); diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c index 3be9f51..327a47a 100644 --- a/gcc/fortran/trans-openmp.c +++ b/gcc/fortran/trans-openmp.c @@ -1925,6 +1925,9 @@ gfc_trans_omp_clauses (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; @@ -4377,13 +4380,27 @@ gfc_trans_omp_workshare (gfc_code *code, gfc_omp_clauses *clauses) } tree -gfc_trans_oacc_declare (stmtblock_t *block, gfc_namespace *ns) +gfc_trans_oacc_declare (gfc_code *code) { - tree oacc_clauses; - oacc_clauses = gfc_trans_omp_clauses (block, ns->oacc_declare_clauses, - ns->oacc_declare_clauses->loc); - return build1_loc (ns->oacc_declare_clauses->loc.lb->location, - OACC_DECLARE, void_type_node, oacc_clauses); + stmtblock_t block; + tree stmt, c1, c2; + enum tree_code construct_code; + + gfc_start_block (&block); + + construct_code = OACC_DECLARE; + + gfc_start_block (&block); + c1 = gfc_trans_omp_clauses (&block, code->ext.oacc_declare->clauses, + code->loc); + + c2 = gfc_trans_omp_clauses (&block, code->ext.oacc_declare->return_clauses, + code->loc); + + stmt = build2_loc (input_location, construct_code, void_type_node, c1, c2); + gfc_add_expr_to_block (&block, stmt); + + return gfc_finish_block (&block); } tree @@ -4409,6 +4426,8 @@ gfc_trans_oacc_directive (gfc_code *code) return gfc_trans_oacc_executable_directive (code); case EXEC_OACC_WAIT: return gfc_trans_oacc_wait_directive (code); + case EXEC_OACC_DECLARE: + return gfc_trans_oacc_declare (code); default: gcc_unreachable (); } diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c index 85558f0..a993b1c 100644 --- a/gcc/fortran/trans-stmt.c +++ b/gcc/fortran/trans-stmt.c @@ -1579,11 +1579,7 @@ gfc_trans_block_construct (gfc_code* code) code->exit_label = exit_label; /* Generate !$ACC DECLARE directive. */ - if (ns->oacc_declare_clauses) - { - tree tmp = gfc_trans_oacc_declare (&body, ns); - gfc_add_expr_to_block (&body, tmp); - } + finish_oacc_declare (ns, FL_UNKNOWN); 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 a/gcc/fortran/trans-stmt.h b/gcc/fortran/trans-stmt.h index 2f2a0b3..0ff93c4 100644 --- a/gcc/fortran/trans-stmt.h +++ b/gcc/fortran/trans-stmt.h @@ -67,7 +67,7 @@ void gfc_trans_omp_declare_simd (gfc_namespace *); /* trans-openacc.c */ tree gfc_trans_oacc_directive (gfc_code *); -tree gfc_trans_oacc_declare (stmtblock_t *block, gfc_namespace *); +tree gfc_trans_oacc_declare (gfc_namespace *); /* trans-io.c */ tree gfc_trans_open (gfc_code *); diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c index 4eaea53..7de5db2 100644 --- a/gcc/fortran/trans.c +++ b/gcc/fortran/trans.c @@ -1903,6 +1903,7 @@ trans_code (gfc_code * code, tree cond) case EXEC_OACC_PARALLEL_LOOP: case EXEC_OACC_ENTER_DATA: case EXEC_OACC_EXIT_DATA: + case EXEC_OACC_DECLARE: res = gfc_trans_oacc_directive (code); break; diff --git a/gcc/fortran/types.def b/gcc/fortran/types.def index ca75654..6d993db 100644 --- a/gcc/fortran/types.def +++ b/gcc/fortran/types.def @@ -145,6 +145,7 @@ DEF_FUNCTION_TYPE_3 (BT_FN_VOID_VPTR_I2_INT, BT_VOID, BT_VOLATILE_PTR, BT_I2, BT DEF_FUNCTION_TYPE_3 (BT_FN_VOID_VPTR_I4_INT, BT_VOID, BT_VOLATILE_PTR, BT_I4, BT_INT) DEF_FUNCTION_TYPE_3 (BT_FN_VOID_VPTR_I8_INT, BT_VOID, BT_VOLATILE_PTR, BT_I8, BT_INT) DEF_FUNCTION_TYPE_3 (BT_FN_VOID_VPTR_I16_INT, BT_VOID, BT_VOLATILE_PTR, BT_I16, BT_INT) +DEF_FUNCTION_TYPE_3 (BT_FN_VOID_PTR_INT_UINT, BT_VOID, BT_PTR, BT_INT, BT_UINT) DEF_FUNCTION_TYPE_4 (BT_FN_VOID_OMPFN_PTR_UINT_UINT, BT_VOID, BT_PTR_FN_VOID_PTR, BT_PTR, BT_UINT, BT_UINT) diff --git a/gcc/testsuite/gfortran.dg/goacc/declare-1.f95 b/gcc/testsuite/gfortran.dg/goacc/declare-1.f95 index 5cf737f..3129f04 100644 --- a/gcc/testsuite/gfortran.dg/goacc/declare-1.f95 +++ b/gcc/testsuite/gfortran.dg/goacc/declare-1.f95 @@ -15,5 +15,4 @@ contains END BLOCK end function foo end program test -! { dg-prune-output "unimplemented" } -! { dg-final { scan-tree-dump-times "pragma acc declare map\\(force_tofrom:i\\)" 2 "original" } } +! { dg-final { scan-tree-dump-times "pragma acc declare map\\(force_to:i\\)" 2 "original" } } diff --git a/libgomp/oacc-parallel.c b/libgomp/oacc-parallel.c index e374045..ff6faed 100644 --- a/libgomp/oacc-parallel.c +++ b/libgomp/oacc-parallel.c @@ -359,7 +359,9 @@ GOACC_enter_exit_data (int device, size_t mapnum, if (kind == GOMP_MAP_FORCE_ALLOC || kind == GOMP_MAP_FORCE_PRESENT - || kind == GOMP_MAP_FORCE_TO) + || kind == GOMP_MAP_FORCE_TO + || kind == GOMP_MAP_TO + || kind == GOMP_MAP_ALLOC) { data_enter = true; break; @@ -386,6 +388,9 @@ GOACC_enter_exit_data (int device, size_t mapnum, { switch (kind) { + case GOMP_MAP_ALLOC: + acc_present_or_create (hostaddrs[i], sizes[i]); + break; case GOMP_MAP_POINTER: gomp_acc_insert_pointer (1, &hostaddrs[i], &sizes[i], &kinds[i]); @@ -397,6 +402,7 @@ GOACC_enter_exit_data (int device, size_t mapnum, acc_present_or_copyin (hostaddrs[i], sizes[i]); break; case GOMP_MAP_FORCE_TO: + case GOMP_MAP_TO: acc_present_or_copyin (hostaddrs[i], sizes[i]); break; default: diff --git a/gcc/testsuite/gfortran.dg/goacc/declare-2.f95 b/gcc/testsuite/gfortran.dg/goacc/declare-2.f95 new file mode 100644 index 0000000..f9ffe9e --- /dev/null +++ b/gcc/testsuite/gfortran.dg/goacc/declare-2.f95 @@ -0,0 +1,54 @@ + +module amod + +contains + +subroutine asubr (b) + implicit none + integer :: b(8) + + !$acc declare copy (b) ! { dg-error "Invalid clause in module" } + !$acc declare copyout (b) ! { dg-error "Invalid clause in module" } + !$acc declare present (b) ! { dg-error "Invalid clause in module" } + !$acc declare present_or_copy (b) ! { dg-error "Invalid clause in module" } + !$acc declare present_or_copyin (b) ! { dg-error "Invalid clause in module" } + !$acc declare present_or_copyout (b) ! { dg-error "Invalid clause in module" } + !$acc declare present_or_create (b) ! { dg-error "Invalid clause in module" } + !$acc declare deviceptr (b) ! { dg-error "Invalid clause in module" } + !$acc declare create (b) copyin (b) ! { dg-error "present on multiple clauses" } + +end subroutine + +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" } + +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 "Subarray 'c' is not allowed" } + +end subroutine subarray + +program test + integer :: a(8) + + !$acc declare create (a) copyin (a) ! { dg-error "present on multiple clauses" } + +end program diff --git a/libgomp/testsuite/libgomp.oacc-fortran/declare-1.f90 b/libgomp/testsuite/libgomp.oacc-fortran/declare-1.f90 new file mode 100644 index 0000000..18dd1bb --- /dev/null +++ b/libgomp/testsuite/libgomp.oacc-fortran/declare-1.f90 @@ -0,0 +1,236 @@ +! { dg-do run { target openacc_nvidia_accel_selected } } + +module vars + integer z + !$acc declare create (z) +end module vars + +subroutine subr6 (a, d) + integer, parameter :: N = 8 + integer :: i + integer :: a(N) + !$acc declare deviceptr (a) + integer :: d(N) + + i = 0 + + !$acc parallel copy (d) + do i = 1, N + d(i) = a(i) + a(i) + end do + !$acc end parallel + +end subroutine + +subroutine subr5 (a, b, c, d) + integer, parameter :: N = 8 + integer :: i + integer :: a(N) + !$acc declare present_or_copyin (a) + integer :: b(N) + !$acc declare present_or_create (b) + integer :: c(N) + !$acc declare present_or_copyout (c) + integer :: d(N) + !$acc declare present_or_copy (d) + + i = 0 + + !$acc parallel + do i = 1, N + b(i) = a(i) + c(i) = b(i) + d(i) = d(i) + b(i) + end do + !$acc end parallel + +end subroutine + +subroutine subr4 (a, b) + integer, parameter :: N = 8 + integer :: i + integer :: a(N) + !$acc declare present (a) + integer :: b(N) + !$acc declare copyout (b) + + i = 0 + + !$acc parallel + do i = 1, N + b(i) = a(i) + end do + !$acc end parallel + +end subroutine + +subroutine subr3 (a, c) + integer, parameter :: N = 8 + integer :: i + integer :: a(N) + !$acc declare present (a) + integer :: c(N) + !$acc declare copyin (c) + + i = 0 + + !$acc parallel + do i = 1, N + a(i) = c(i) + c(i) = 0 + end do + !$acc end parallel + +end subroutine + +subroutine subr2 (a, b, c) + integer, parameter :: N = 8 + integer :: i + integer :: a(N) + !$acc declare present (a) + integer :: b(N) + !$acc declare create (b) + integer :: c(N) + !$acc declare copy (c) + + i = 0 + + !$acc parallel + do i = 1, N + b(i) = a(i) + c(i) = b(i) + c(i) + 1 + end do + !$acc end parallel + +end subroutine + +subroutine subr1 (a) + integer, parameter :: N = 8 + integer :: i + integer :: a(N) + !$acc declare present (a) + + i = 0 + + !$acc parallel + do i = 1, N + a(i) = a(i) + 1 + end do + !$acc end parallel + +end subroutine + +subroutine test (a, e) + use openacc + logical :: e + integer, parameter :: N = 8 + integer :: a(N) + + if (acc_is_present (a) .neqv. e) call abort + +end subroutine + +subroutine subr0 (a, b, c, d) + integer, parameter :: N = 8 + integer :: a(N) + !$acc declare copy (a) + integer :: b(N) + integer :: c(N) + integer :: d(N) + + call test (a, .true.) + call test (b, .false.) + call test (c, .false.) + + call subr1 (a) + + call test (a, .true.) + call test (b, .false.) + call test (c, .false.) + + call subr2 (a, b, c) + + call test (a, .true.) + call test (b, .false.) + call test (c, .false.) + + do i = 1, N + if (c(i) .ne. 8) call abort + end do + + call subr3 (a, c) + + call test (a, .true.) + call test (b, .false.) + call test (c, .false.) + + do i = 1, N + if (a(i) .ne. 2) call abort + if (c(i) .ne. 8) call abort + end do + + call subr4 (a, b) + + call test (a, .true.) + call test (b, .false.) + call test (c, .false.) + + do i = 1, N + if (b(i) .ne. 8) call abort + end do + + call subr5 (a, b, c, d) + + call test (a, .true.) + call test (b, .false.) + call test (c, .false.) + call test (d, .false.) + + do i = 1, N + if (c(i) .ne. 8) call abort + if (d(i) .ne. 13) call abort + end do + + call subr6 (a, d) + + call test (a, .true.) + call test (d, .false.) + + do i = 1, N + if (d(i) .ne. 16) call abort + end do + +end subroutine + +program main + use vars + use openacc + integer, parameter :: N = 8 + integer :: a(N) + integer :: b(N) + integer :: c(N) + integer :: d(N) + + a(:) = 2 + b(:) = 3 + c(:) = 4 + d(:) = 5 + + if (acc_is_present (z) .neqv. .true.) call abort + + call subr0 (a, b, c, d) + + call test (a, .false.) + call test (b, .false.) + call test (c, .false.) + call test (d, .false.) + + do i = 1, N + if (a(i) .ne. 8) call abort + if (b(i) .ne. 8) call abort + if (c(i) .ne. 8) call abort + if (d(i) .ne. 16) call abort + end do + + +end program diff --git a/libgomp/testsuite/libgomp.oacc-fortran/declare-2.f90 b/libgomp/testsuite/libgomp.oacc-fortran/declare-2.f90 new file mode 100644 index 0000000..9b75aa1 --- /dev/null +++ b/libgomp/testsuite/libgomp.oacc-fortran/declare-2.f90 @@ -0,0 +1,14 @@ +! { dg-do run { target openacc_nvidia_accel_selected } } + +module globalvars + integer a + !$acc declare create (a) +end module globalvars + +program test + use globalvars + use openacc + + if (acc_is_present (a) .neqv. .true.) call abort + +end program test diff --git a/libgomp/testsuite/libgomp.oacc-fortran/declare-3.f90 b/libgomp/testsuite/libgomp.oacc-fortran/declare-3.f90 new file mode 100644 index 0000000..79fc011 --- /dev/null +++ b/libgomp/testsuite/libgomp.oacc-fortran/declare-3.f90 @@ -0,0 +1,65 @@ +! { dg-do run { target openacc_nvidia_accel_selected } } + +module globalvars + real b + !$acc declare link (b) +end module globalvars + +program test + use openacc + + real a + real c + !$acc declare link (c) + + if (acc_is_present (b) .neqv. .false.) call abort + if (acc_is_present (c) .neqv. .false.) call abort + + a = 0.0 + b = 1.0 + + !$acc parallel copy (a) copyin (b) + b = b + 4.0 + a = b + !$acc end parallel + + if (a .ne. 5.0) call abort + + if (acc_is_present (b) .neqv. .false.) call abort + + a = 0.0 + + !$acc parallel copy (a) create (b) + b = 4.0 + a = b + !$acc end parallel + + if (a .ne. 4.0) call abort + + if (acc_is_present (b) .neqv. .false.) call abort + + a = 0.0 + + !$acc parallel copy (a) copy (b) + b = 4.0 + a = b + !$acc end parallel + + if (a .ne. 4.0) call abort + if (b .ne. 4.0) call abort + + if (acc_is_present (b) .neqv. .false.) call abort + + a = 0.0 + + !$acc parallel copy (a) copy (b) copy (c) + b = 4.0 + c = b + a = c + !$acc end parallel + + if (a .ne. 4.0) call abort + + if (acc_is_present (b) .neqv. .false.) call abort + +end program test diff --git a/libgomp/testsuite/libgomp.oacc-fortran/declare-4.f90 b/libgomp/testsuite/libgomp.oacc-fortran/declare-4.f90 new file mode 100644 index 0000000..997c8ac --- /dev/null +++ b/libgomp/testsuite/libgomp.oacc-fortran/declare-4.f90 @@ -0,0 +1,27 @@ +! { dg-do run { target openacc_nvidia_accel_selected } } + +module vars + real b + !$acc declare create (b) +end module vars + +program test + use vars + use openacc + real a + + if (acc_is_present (b) .neqv. .true.) call abort + + a = 2.0 + + !$acc parallel copy (a) + b = a + a = 1.0 + a = a + b + !$acc end parallel + + if (acc_is_present (b) .neqv. .true.) call abort + + if (a .ne. 3.0) call abort + +end program test diff --git a/libgomp/testsuite/libgomp.oacc-fortran/declare-5.f90 b/libgomp/testsuite/libgomp.oacc-fortran/declare-5.f90 new file mode 100644 index 0000000..d7c9bac --- /dev/null +++ b/libgomp/testsuite/libgomp.oacc-fortran/declare-5.f90 @@ -0,0 +1,28 @@ +! { dg-do run { target openacc_nvidia_accel_selected } } + +module vars + implicit none + real b + !$acc declare device_resident (b) +end module vars + +program test + use vars + use openacc + real a + + if (acc_is_present (b) .neqv. .true.) call abort + + a = 2.0 + + !$acc parallel copy (a) + b = a + a = 1.0 + a = a + b + !$acc end parallel + + if (acc_is_present (b) .neqv. .true.) call abort + + if (a .ne. 3.0) call abort + +end program test --------------090802010505050703030903--