[gomp4] Re: OpenACC declare directive updates
Thomas Schwinge
thomas@codesourcery.com
Fri Nov 27 11:41:00 GMT 2015
Hi!
On Thu, 19 Nov 2015 10:22:16 -0600, James Norris <jnorris@codesourcery.com> 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
<http://news.gmane.org/find-root.php?message_id=%3C878u5n7pqk.fsf%40hertz.schwinge.homeip.net%3E>,
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 <tschwinge@138bc75d-0d04-0410-961f-82ee72b054a4>
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]
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
Grüße
Thomas
-------------- next part --------------
A non-text attachment was scrubbed...
Name: signature.asc
Type: application/pgp-signature
Size: 472 bytes
Desc: not available
URL: <http://gcc.gnu.org/pipermail/gcc-patches/attachments/20151127/11f60882/attachment.sig>
More information about the Gcc-patches
mailing list