* OpenACC declare directive updates
@ 2015-11-02 13:46 James Norris
[not found] ` <5639FAC0.2090104@codesourcery.com>
0 siblings, 1 reply; 6+ messages in thread
From: James Norris @ 2015-11-02 13:46 UTC (permalink / raw)
To: GCC Patches, fortran, Tobias Burnus
[-- Attachment #1: Type: text/plain, Size: 419 bytes --]
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
[-- Attachment #2: NOTES --]
[-- Type: text/plain, Size: 2670 bytes --]
Background
The declare directive is used to allocate device memory for the
entire scope of a variable / array within a program, function,
or subroutine. Consider the following example.
module vars
integer b
!$acc declare device_resident (b)
integer c
!$acc declare link (c)
end module vars
program main
use vars
integer, parameter :: N = 8
integer :: a(N)
a(:) = 2
c = 12
!$acc parallel copy (a) present (b) copyin(c)
do i = 1, N
b = a(i)
c = b
a(i) = c + i
end do
!$acc end parallel
end program
In the example, 'b' will be allocated on the device at the outset
of device activity and be available for the duration. Whereas the
allocation of 'c' will be delayed until the parallel region is
entered. The device memory for 'c' will be deallocated upon exit
of the parallel region.
Fortran front-end
The changes are concentrated into four (4) areas.
1) module support
The neccesary functionality has been added to handle the
reading in and writing out of the appropriate attributes
for the declare directive. Additional functionality has
been added at read in time to setup the required declare
handling.
2) device_resident and link clauses
Add the functionality necessary to process the link and
device_resident clauses.
3) clause checking
The clause checking has been cleaned up to better check
for duplicates and correctness.
4) directive generation
Prior to handling the fortran execution body a code
body is created to handle the clause(s) that accompany
the declare directive(s). Each clause is examined and
determined whether the clause need to be modified to
perform an action at the beginning of the module, function,
subroutine, or program. Furthermore, an additional
clause may be added to the list to perform an action
at the time the function or subroutine returns.
Once all the clauses have been handled, the code body
is added to the chain.
libgomp
TODO
Testing
New compile and runtime tests have been added. Also some have
been modified.
[-- Attachment #3: declare2.patch --]
[-- Type: text/x-patch, Size: 43734 bytes --]
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<gfc_symbol *> 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
^ permalink raw reply [flat|nested] 6+ messages in thread
* [PATCH] fortran/openmp.c -- Fix bootstrap
@ 2015-11-22 18:59 ` Steve Kargl
2015-11-22 19:18 ` Jerry DeLisle
` (2 more replies)
0 siblings, 3 replies; 6+ messages in thread
From: Steve Kargl @ 2015-11-22 18:59 UTC (permalink / raw)
To: fortran, gcc-patches
I have no idea if this is actually correct, but it restores bootstrap.
OK to commit?
2015-11-22 Steven G. Kargl <kargl@gcc.gnu.org>
* openmp.c (match_oacc_clause_gang): Fix bootstrap.
Index: openmp.c
===================================================================
--- openmp.c (revision 230723)
+++ openmp.c (working copy)
@@ -415,7 +415,8 @@ match_oacc_clause_gang (gfc_omp_clauses
static match
gfc_match_oacc_clause_link (const char *str, gfc_omp_namelist **list)
{
- gfc_omp_namelist *head, *tail, *p;
+ gfc_omp_namelist *head = NULL;
+ gfc_omp_namelist *tail, *p;
locus old_loc;
char n[GFC_MAX_SYMBOL_LEN+1];
gfc_symbol *sym;
@@ -4821,7 +4822,7 @@ gfc_resolve_oacc_declare (gfc_namespace
for (oc = ns->oacc_declare; oc; oc = oc->next)
{
- for (list = 0; list <= OMP_LIST_NUM; list++)
+ for (list = 0; list < OMP_LIST_NUM; list++)
for (n = oc->clauses->lists[list]; n; n = n->next)
{
n->sym->mark = 0;
@@ -4846,7 +4847,7 @@ gfc_resolve_oacc_declare (gfc_namespace
for (oc = ns->oacc_declare; oc; oc = oc->next)
{
- for (list = 0; list <= OMP_LIST_NUM; list++)
+ for (list = 0; list < OMP_LIST_NUM; list++)
for (n = oc->clauses->lists[list]; n; n = n->next)
{
if (n->sym->mark)
@@ -4862,7 +4863,7 @@ gfc_resolve_oacc_declare (gfc_namespace
for (oc = ns->oacc_declare; oc; oc = oc->next)
{
- for (list = 0; list <= OMP_LIST_NUM; list++)
+ for (list = 0; list < OMP_LIST_NUM; list++)
for (n = oc->clauses->lists[list]; n; n = n->next)
n->sym->mark = 0;
}
--
Steve
^ permalink raw reply [flat|nested] 6+ messages in thread
* Re: [PATCH] fortran/openmp.c -- Fix bootstrap
2015-11-22 18:59 ` [PATCH] fortran/openmp.c -- Fix bootstrap Steve Kargl
@ 2015-11-22 19:18 ` Jerry DeLisle
2015-11-22 19:27 ` James Norris
[not found] ` <564DF738.80706@codesourcery.com>
2 siblings, 0 replies; 6+ messages in thread
From: Jerry DeLisle @ 2015-11-22 19:18 UTC (permalink / raw)
To: Steve Kargl, fortran, gcc-patches
On 11/22/2015 10:59 AM, Steve Kargl wrote:
> I have no idea if this is actually correct, but it restores bootstrap.
> OK to commit?
>
This looks correct to me. There should be no more in the lists than
OMP_LIST_NUM. Was there a PR for this and do we know when it broke?
Jerry
^ permalink raw reply [flat|nested] 6+ messages in thread
* Re: [PATCH] fortran/openmp.c -- Fix bootstrap
2015-11-22 18:59 ` [PATCH] fortran/openmp.c -- Fix bootstrap Steve Kargl
2015-11-22 19:18 ` Jerry DeLisle
@ 2015-11-22 19:27 ` James Norris
[not found] ` <564DF738.80706@codesourcery.com>
2 siblings, 0 replies; 6+ messages in thread
From: James Norris @ 2015-11-22 19:27 UTC (permalink / raw)
To: Steve Kargl, fortran, gcc-patches
Hi,
Patch committed to trunk as obvious. Thanks to Dominique and Steve.
Jim
====
On 11/22/2015 12:59 PM, Steve Kargl wrote:
> I have no idea if this is actually correct, but it restores bootstrap.
> OK to commit?
>
> 2015-11-22 Steven G. Kargl <kargl@gcc.gnu.org>
>
> * openmp.c (match_oacc_clause_gang): Fix bootstrap.
>
>
> Index: openmp.c
> ===================================================================
> --- openmp.c (revision 230723)
> +++ openmp.c (working copy)
> @@ -415,7 +415,8 @@ match_oacc_clause_gang (gfc_omp_clauses
> static match
> gfc_match_oacc_clause_link (const char *str, gfc_omp_namelist **list)
> {
> - gfc_omp_namelist *head, *tail, *p;
> + gfc_omp_namelist *head = NULL;
> + gfc_omp_namelist *tail, *p;
> locus old_loc;
> char n[GFC_MAX_SYMBOL_LEN+1];
> gfc_symbol *sym;
> @@ -4821,7 +4822,7 @@ gfc_resolve_oacc_declare (gfc_namespace
>
> for (oc = ns->oacc_declare; oc; oc = oc->next)
> {
> - for (list = 0; list <= OMP_LIST_NUM; list++)
> + for (list = 0; list < OMP_LIST_NUM; list++)
> for (n = oc->clauses->lists[list]; n; n = n->next)
> {
> n->sym->mark = 0;
> @@ -4846,7 +4847,7 @@ gfc_resolve_oacc_declare (gfc_namespace
>
> for (oc = ns->oacc_declare; oc; oc = oc->next)
> {
> - for (list = 0; list <= OMP_LIST_NUM; list++)
> + for (list = 0; list < OMP_LIST_NUM; list++)
> for (n = oc->clauses->lists[list]; n; n = n->next)
> {
> if (n->sym->mark)
> @@ -4862,7 +4863,7 @@ gfc_resolve_oacc_declare (gfc_namespace
>
> for (oc = ns->oacc_declare; oc; oc = oc->next)
> {
> - for (list = 0; list <= OMP_LIST_NUM; list++)
> + for (list = 0; list < OMP_LIST_NUM; list++)
> for (n = oc->clauses->lists[list]; n; n = n->next)
> n->sym->mark = 0;
> }
>
^ permalink raw reply [flat|nested] 6+ messages in thread
* [gomp4] Re: OpenACC declare directive updates
[not found] ` <564DF738.80706@codesourcery.com>
@ 2015-11-27 11:37 ` Thomas Schwinge
2019-06-18 23:02 ` [committed] [PR85221] Set 'omp declare target', 'omp declare target link' attributes for Fortran OpenACC 'declare'd variables (was: [gomp4] Re: OpenACC declare directive updates) Thomas Schwinge
0 siblings, 1 reply; 6+ messages in thread
From: Thomas Schwinge @ 2015-11-27 11:37 UTC (permalink / raw)
To: James Norris; +Cc: Cesar Philippidis, GCC Patches, Jakub Jelinek, fortran
[-- Attachment #1: Type: text/plain, Size: 35824 bytes --]
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
[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 472 bytes --]
^ permalink raw reply [flat|nested] 6+ messages in thread
* [committed] [PR85221] Set 'omp declare target', 'omp declare target link' attributes for Fortran OpenACC 'declare'd variables (was: [gomp4] Re: OpenACC declare directive updates)
2015-11-27 11:37 ` [gomp4] Re: OpenACC declare directive updates Thomas Schwinge
@ 2019-06-18 23:02 ` Thomas Schwinge
0 siblings, 0 replies; 6+ messages in thread
From: Thomas Schwinge @ 2019-06-18 23:02 UTC (permalink / raw)
To: gcc-patches, fortran; +Cc: Jakub Jelinek, Tom de Vries
[-- Attachment #1.1: Type: text/plain, Size: 2032 bytes --]
Hi!
On Fri, 27 Nov 2015 12:37:23 +0100, I wrote:
> On Thu, 19 Nov 2015 10:22:16 -0600, James Norris <jnorris@codesourcery.com> wrote:
> > [...]
> 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://mid.mail-archive.com/878u5n7pqk.fsf@hertz.schwinge.homeip.net>,
> 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++).
There remains a lot of mystery to be resolved regarding the OpenACC
'declare' implementation... :-(
> --- 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
As PR85221 "[openacc] ICE in install_var_field, at omp-low.c:657" tells
us, yes, these are actually necessary.
I'm confused why not all OpenACC 'declare' clauses are handled here, but
looking into that is for another day, or week.
Committed to trunk in r272453 "[PR85221] Set 'omp declare target', 'omp
declare target link' attributes for Fortran OpenACC 'declare'd
variables", see attached.
Grüße
Thomas
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1.2: 0001-PR85221-Set-omp-declare-target-omp-declare-tar.trunk.patch --]
[-- Type: text/x-diff, Size: 3745 bytes --]
From b7194d24d942998da2ab8f6f5dc080e3fff81972 Mon Sep 17 00:00:00 2001
From: tschwinge <tschwinge@138bc75d-0d04-0410-961f-82ee72b054a4>
Date: Tue, 18 Jun 2019 22:15:43 +0000
Subject: [PATCH] [PR85221] Set 'omp declare target', 'omp declare target link'
attributes for Fortran OpenACC 'declare'd variables
gcc/fortran/
PR fortran/85221
* trans-decl.c (add_attributes_to_decl): Handle OpenACC 'declare'
directive.
gcc/testsuite/
PR fortran/85221
* gfortran.dg/goacc/declare-3.f95: New file.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@272453 138bc75d-0d04-0410-961f-82ee72b054a4
---
gcc/fortran/ChangeLog | 6 +++
gcc/fortran/trans-decl.c | 9 +++-
gcc/testsuite/ChangeLog | 3 ++
gcc/testsuite/gfortran.dg/goacc/declare-3.f95 | 47 +++++++++++++++++++
4 files changed, 63 insertions(+), 2 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/goacc/declare-3.f95
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index d30fa2e50a88..6fd97b61ce05 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2019-06-18 Thomas Schwinge <thomas@codesourcery.com>
+
+ PR fortran/85221
+ * trans-decl.c (add_attributes_to_decl): Handle OpenACC 'declare'
+ directive.
+
2019-06-16 Thomas Koenig <tkoenig@gcc.gnu.org>
* dump_parse_tree (debug): Add verison for formal arglist.
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index b8e07274febd..f504c279c31b 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -1432,10 +1432,15 @@ add_attributes_to_decl (symbol_attribute sym_attr, tree list)
list = oacc_replace_fn_attrib_attr (list, dims);
}
- if (sym_attr.omp_declare_target_link)
+ if (sym_attr.omp_declare_target_link
+ || sym_attr.oacc_declare_link)
list = tree_cons (get_identifier ("omp declare target link"),
NULL_TREE, list);
- else if (sym_attr.omp_declare_target)
+ else if (sym_attr.omp_declare_target
+ || sym_attr.oacc_declare_create
+ || sym_attr.oacc_declare_copyin
+ || sym_attr.oacc_declare_deviceptr
+ || sym_attr.oacc_declare_device_resident)
list = tree_cons (get_identifier ("omp declare target"),
clauses, list);
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 59d39e8c179a..552ccc6fbd68 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,5 +1,8 @@
2019-06-18 Thomas Schwinge <thomas@codesourcery.com>
+ PR fortran/85221
+ * gfortran.dg/goacc/declare-3.f95: New file.
+
PR middle-end/90859
* c-c++-common/goacc/firstprivate-mappings-1.c: Update.
diff --git a/gcc/testsuite/gfortran.dg/goacc/declare-3.f95 b/gcc/testsuite/gfortran.dg/goacc/declare-3.f95
new file mode 100644
index 000000000000..ec5d4c5a062a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/declare-3.f95
@@ -0,0 +1,47 @@
+! Test valid usage of the OpenACC 'declare' directive.
+
+module mod_a
+ implicit none
+ integer :: a
+ !$acc declare create (a)
+end module
+
+module mod_b
+ implicit none
+ integer :: b
+ !$acc declare copyin (b)
+end module
+
+module mod_c
+ implicit none
+ integer :: c
+ !$acc declare deviceptr (c)
+end module
+
+module mod_d
+ implicit none
+ integer :: d
+ !$acc declare device_resident (d)
+end module
+
+module mod_e
+ implicit none
+ integer :: e
+ !$acc declare link (e)
+end module
+
+subroutine sub1
+ use mod_a
+ use mod_b
+ use mod_c
+ use mod_d
+ use mod_e
+end subroutine sub1
+
+program test
+ use mod_a
+ use mod_b
+ use mod_c
+ use mod_d
+ use mod_e
+end program test
--
2.20.1
[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 658 bytes --]
^ permalink raw reply [flat|nested] 6+ messages in thread
end of thread, other threads:[~2019-06-18 23:02 UTC | newest]
Thread overview: 6+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2015-11-02 13:46 OpenACC declare directive updates James Norris
[not found] ` <5639FAC0.2090104@codesourcery.com>
[not found] ` <20151106193127.GI5675@tucnak.redhat.com>
[not found] ` <563D0345.7010208@codesourcery.com>
[not found] ` <20151106194909.GK5675@tucnak.redhat.com>
[not found] ` <878u5n7pqk.fsf@hertz.schwinge.homeip.net>
[not found] ` <56451FE6.3040200@codesourcery.com>
2015-11-22 18:59 ` [PATCH] fortran/openmp.c -- Fix bootstrap Steve Kargl
2015-11-22 19:18 ` Jerry DeLisle
2015-11-22 19:27 ` James Norris
[not found] ` <564DF738.80706@codesourcery.com>
2015-11-27 11:37 ` [gomp4] Re: OpenACC declare directive updates Thomas Schwinge
2019-06-18 23:02 ` [committed] [PR85221] Set 'omp declare target', 'omp declare target link' attributes for Fortran OpenACC 'declare'd variables (was: [gomp4] Re: OpenACC declare directive updates) Thomas Schwinge
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).