* Re: Next set of OpenACC changes: Fortran
@ 2015-05-05 10:01 Tobias Burnus
2015-05-06 12:48 ` James Norris
0 siblings, 1 reply; 4+ messages in thread
From: Tobias Burnus @ 2015-05-05 10:01 UTC (permalink / raw)
To: Thomas Schwinge
Cc: gcc-patches, Jakub Jelinek, fortran, Bernd Schmidt,
Cesar Philippidis, Chung-Lin Tang, James Norris, Joseph Myers,
Julian Brown, Tom de Vries
Thomas Schwinge wrote:
> In follow-up messages, I'll be posting the separated parts (for easier
> review) of a next set of OpenACC changes that we'd like to commit.
> ChangeLog updates not yet written; will do that before commit, obviously.
Still, it would have been nice if you had given an overview about what
the main part of the patch does. In this case, there is neither some intro
words nor a ChangeLog (which also gives an overview what the patch does).
Regarding the !$ACC ROUTINE support, which the patch adds: In my very
rough understanding, the compiler has to know at compile time whether a
procedure is a '!$ACC ROUTINE' or not. Thus, it should work if you declare
in one file:
!--------- file1.f90-----------
subroutine foo()
!$acc routine
end subroutine foo
!--- end of file
and invoke it in a different file:
call foo()
In order that this works in Fortran, you need to support two ways of
handling this information:
a) modules:
module m
contains
subroutine foo()
!$acc routine
end subroutine foo
end module m
Thus, I had expected that you store this information (at least the relevant
parts) in the .mod file. (-> fortran/module.c)
b) interfaces, i.e. in the scope of the caller:
interface
subroutine foo()
!$acc routine
end subroutine foo
end interface
!$acc parallel
...
call foo()
...
!$acc end parallel
Semantically, something like the the latter is also needed in the same file
if the procedure "foo" is stand along (i.e. neither in a module nor 'contained'
(internal procedure) of the caller nor a sibling internal procedure of the
caller). However, as the original declaration is available, supporting (b) is
only semantical sugar - especially a check whether the !$acc routine is provided
in the interface and matches the original declaration.
Thus, can you check:
* whether you need to store information in the .mod file?
* whether (b) is/should be supported? (And with how much error diagnostic
in case of the same TU and mismatches.)
And, if needed, provide some test cases?
And if you are there:
* Whether something similar to .mod has to be done for LTO?
* Could you also create a test case, where Fortran calls C or vice versa for
an OpenACC ROUTINE?
Tobias
^ permalink raw reply [flat|nested] 4+ messages in thread
* Re: Next set of OpenACC changes: Fortran
2015-05-05 10:01 Next set of OpenACC changes: Fortran Tobias Burnus
@ 2015-05-06 12:48 ` James Norris
0 siblings, 0 replies; 4+ messages in thread
From: James Norris @ 2015-05-06 12:48 UTC (permalink / raw)
To: Tobias Burnus, Thomas Schwinge
Cc: gcc-patches, Jakub Jelinek, fortran, Bernd Schmidt,
Cesar Philippidis, Chung-Lin Tang, Joseph Myers, Julian Brown,
Tom de Vries
Tobias,
First, thank you for taking the time to review the patch.
Second, thank you for providing the comments. It appears
all of the comments need to be acted upon in some manner.
Thanks!
On 05/05/2015 05:01 AM, Tobias Burnus wrote:
> Thomas Schwinge wrote:
>> In follow-up messages, I'll be posting the separated parts (for easier
>> review) of a next set of OpenACC changes that we'd like to commit.
>> ChangeLog updates not yet written; will do that before commit, obviously.
> Still, it would have been nice if you had given an overview about what
> the main part of the patch does. In this case, there is neither some intro
> words nor a ChangeLog (which also gives an overview what the patch does).
>
> Regarding the !$ACC ROUTINE support, which the patch adds: In my very
> rough understanding, the compiler has to know at compile time whether a
> procedure is a '!$ACC ROUTINE' or not. Thus, it should work if you declare
> in one file:
>
> !--------- file1.f90-----------
> subroutine foo()
> !$acc routine
> end subroutine foo
> !--- end of file
>
> and invoke it in a different file:
> call foo()
>
> In order that this works in Fortran, you need to support two ways of
> handling this information:
>
>
> a) modules:
>
> module m
> contains
> subroutine foo()
> !$acc routine
> end subroutine foo
> end module m
>
> Thus, I had expected that you store this information (at least the relevant
> parts) in the .mod file. (-> fortran/module.c)
>
>
> b) interfaces, i.e. in the scope of the caller:
>
> interface
> subroutine foo()
> !$acc routine
> end subroutine foo
> end interface
>
> !$acc parallel
> ...
> call foo()
> ...
> !$acc end parallel
>
>
> Semantically, something like the the latter is also needed in the same file
> if the procedure "foo" is stand along (i.e. neither in a module nor 'contained'
> (internal procedure) of the caller nor a sibling internal procedure of the
> caller). However, as the original declaration is available, supporting (b) is
> only semantical sugar - especially a check whether the !$acc routine is provided
> in the interface and matches the original declaration.
>
>
> Thus, can you check:
> * whether you need to store information in the .mod file?
> * whether (b) is/should be supported? (And with how much error diagnostic
> in case of the same TU and mismatches.)
> And, if needed, provide some test cases?
>
> And if you are there:
> * Whether something similar to .mod has to be done for LTO?
> * Could you also create a test case, where Fortran calls C or vice versa for
> an OpenACC ROUTINE?
>
> Tobias
^ permalink raw reply [flat|nested] 4+ messages in thread
* Re: Next set of OpenACC changes: Fortran
2015-05-05 8:59 ` Next set of OpenACC changes: Fortran Thomas Schwinge
@ 2015-05-05 10:42 ` Bernhard Reutner-Fischer
0 siblings, 0 replies; 4+ messages in thread
From: Bernhard Reutner-Fischer @ 2015-05-05 10:42 UTC (permalink / raw)
To: Thomas Schwinge
Cc: GCC Patches, Jakub Jelinek, gfortran, Bernd Schmidt,
Cesar Philippidis, Chung-Lin Tang, James Norris, Joseph Myers,
Julian Brown, Tom de Vries
On 5 May 2015 at 10:58, Thomas Schwinge <thomas@codesourcery.com> wrote:
> Hi!
+/* Node in the linked list used for storing !$oacc declare constructs. */
The clause is called $ACC declare, isn't it?
> + 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;
> + }
Much code for setting n->sym->mark = 1. What am i missing?
> +
> + ns->oacc_declare = new_oc;
> +
> return MATCH_YES;
> }
>
> @@ -1304,10 +1580,21 @@ match
> gfc_match_oacc_update (void)
> {
> gfc_omp_clauses *c;
> - if (gfc_match_omp_clauses (&c, OACC_UPDATE_CLAUSES, false, false, true)
> + locus here = gfc_current_locus;
> +
> + if (gfc_match_omp_clauses (&c, OACC_UPDATE_CLAUSES,
> + OACC_UPDATE_CLAUSE_DEVICE_TYPE_MASK, false,
> + false, true)
> != MATCH_YES)
> return MATCH_ERROR;
>
> + if (!c->lists[OMP_LIST_MAP])
> + {
> + gfc_error ("%<acc update%> must contain at least one "
> + "%<device%> or %<host/self%> clause at %L", &here);
> + return MATCH_ERROR;
$ACC UPDATE instead of %<acc update %> ?
> - else if (code->ext.omp_clauses->gang
> - && code->ext.omp_clauses->worker
> - && code->ext.omp_clauses->vector)
> + if (code->ext.omp_clauses->tile_list && code->ext.omp_clauses->gang
> + && code->ext.omp_clauses->worker && code->ext.omp_clauses->vector)
conditions on separate lines, please.
> - 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);
> - }
> + for (list = OMP_LIST_DEVICE_RESIDENT;
> + list <= OMP_LIST_DEVICE_RESIDENT; 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);
> + }
>
> - 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 (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;
> + }
>
> - for (n = ns->oacc_declare_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_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);
> + }
> + }
> }
The ->mark setting looks complicated (as noted above)?
thanks,
^ permalink raw reply [flat|nested] 4+ messages in thread
* Next set of OpenACC changes: Fortran
2015-05-05 8:54 Next set of OpenACC changes Thomas Schwinge
@ 2015-05-05 8:59 ` Thomas Schwinge
2015-05-05 10:42 ` Bernhard Reutner-Fischer
0 siblings, 1 reply; 4+ messages in thread
From: Thomas Schwinge @ 2015-05-05 8:59 UTC (permalink / raw)
To: gcc-patches, Jakub Jelinek, fortran
Cc: Bernd Schmidt, Cesar Philippidis, Chung-Lin Tang, James Norris,
Joseph Myers, Julian Brown, Tom de Vries
[-- Attachment #1: Type: text/plain, Size: 53630 bytes --]
Hi!
On Tue, 05 May 2015 10:54:02 +0200, I wrote:
> In follow-up messages, I'll be posting the separated parts (for easier
> review) of a next set of OpenACC changes that we'd like to commit.
> ChangeLog updates not yet written; will do that before commit, obviously.
gcc/fortran/dump-parse-tree.c | 12 +-
gcc/fortran/gfortran.h | 50 +-
gcc/fortran/match.h | 1 +
gcc/fortran/openmp.c | 581 +++++--
gcc/fortran/parse.c | 65 +-
gcc/fortran/parse.h | 2 +-
gcc/fortran/resolve.c | 5 +
gcc/fortran/st.c | 7 +
gcc/fortran/trans-decl.c | 62 +-
gcc/fortran/trans-openmp.c | 66 +-
gcc/fortran/trans-stmt.c | 7 +-
gcc/fortran/trans-stmt.h | 2 +-
gcc/fortran/trans.c | 2 +
diff --git gcc/fortran/dump-parse-tree.c gcc/fortran/dump-parse-tree.c
index 83ecbaa..48476af 100644
--- gcc/fortran/dump-parse-tree.c
+++ gcc/fortran/dump-parse-tree.c
@@ -2570,12 +2570,16 @@ show_namespace (gfc_namespace *ns)
for (eq = ns->equiv; eq; eq = eq->next)
show_equiv (eq);
- if (ns->oacc_declare_clauses)
+ if (ns->oacc_declare)
{
+ 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; decl; decl = decl->next)
+ {
+ show_indent ();
+ fprintf (dumpfile, "!$ACC DECLARE");
+ show_omp_clauses (decl->clauses);
+ }
}
fputc ('\n', dumpfile);
diff --git gcc/fortran/gfortran.h gcc/fortran/gfortran.h
index 832a6ce..9258786 100644
--- gcc/fortran/gfortran.h
+++ gcc/fortran/gfortran.h
@@ -222,6 +222,7 @@ typedef enum
ST_OACC_END_LOOP, ST_OACC_DECLARE, ST_OACC_UPDATE, ST_OACC_WAIT,
ST_OACC_CACHE, ST_OACC_KERNELS_LOOP, ST_OACC_END_KERNELS_LOOP,
ST_OACC_ENTER_DATA, ST_OACC_EXIT_DATA, ST_OACC_ROUTINE,
+ ST_OACC_ATOMIC, ST_OACC_END_ATOMIC,
ST_OMP_ATOMIC, ST_OMP_BARRIER, ST_OMP_CRITICAL, ST_OMP_END_ATOMIC,
ST_OMP_END_CRITICAL, ST_OMP_END_DO, ST_OMP_END_MASTER, ST_OMP_END_ORDERED,
ST_OMP_END_PARALLEL, ST_OMP_END_PARALLEL_DO, ST_OMP_END_PARALLEL_SECTIONS,
@@ -1242,10 +1243,14 @@ typedef struct gfc_omp_clauses
struct gfc_expr *num_gangs_expr;
struct gfc_expr *num_workers_expr;
struct gfc_expr *vector_length_expr;
+ struct gfc_symbol *routine_bind;
+ int dtype;
+ struct gfc_omp_clauses *dtype_clauses;
gfc_expr_list *wait_list;
gfc_expr_list *tile_list;
unsigned async:1, gang:1, worker:1, vector:1, seq:1, independent:1;
- unsigned wait:1, par_auto:1, gang_static:1;
+ unsigned wait:1, par_auto:1, gang_static:1, nohost:1, acc_collapse:1, bind:1;
+ unsigned num_gangs:1, num_workers:1, vector_length:1, tile:1;
locus loc;
}
@@ -1253,6 +1258,17 @@ 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;
+ locus where;
+ gfc_omp_clauses *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. */
@@ -1592,6 +1608,16 @@ gfc_dt_list;
/* A list of all derived types. */
extern gfc_dt_list *gfc_derived_types;
+typedef struct gfc_oacc_routine_name
+{
+ struct gfc_symbol *sym;
+ struct gfc_omp_clauses *clauses;
+ struct gfc_oacc_routine_name *next;
+}
+gfc_oacc_routine_name;
+
+#define gfc_get_oacc_routine_name() XCNEW (gfc_oacc_routine_name)
+
/* A namespace describes the contents of procedure, module, interface block
or BLOCK construct. */
/* ??? Anything else use these? */
@@ -1656,7 +1682,13 @@ 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;
+
+ /* !$ACC ROUTINE clauses. */
+ gfc_omp_clauses *oacc_routine_clauses;
+
+ /* !$ACC ROUTINE names. */
+ gfc_oacc_routine_name *oacc_routine_names;
gfc_charlen *cl_list, *old_cl_list;
@@ -1703,6 +1735,9 @@ typedef struct gfc_namespace
/* Set to 1 for !$OMP DECLARE REDUCTION namespaces. */
unsigned omp_udr_ns:1;
+
+ /* Set to 1 for !$ACC ROUTINE namespaces. */
+ unsigned oacc_routine:1;
}
gfc_namespace;
@@ -2331,10 +2366,11 @@ typedef enum
EXEC_READ, EXEC_WRITE, EXEC_IOLENGTH, EXEC_TRANSFER, EXEC_DT_END,
EXEC_BACKSPACE, EXEC_ENDFILE, EXEC_INQUIRE, EXEC_REWIND, EXEC_FLUSH,
EXEC_LOCK, EXEC_UNLOCK,
- EXEC_OACC_KERNELS_LOOP, EXEC_OACC_PARALLEL_LOOP,
+ EXEC_OACC_KERNELS_LOOP, EXEC_OACC_PARALLEL_LOOP, EXEC_OACC_ROUTINE,
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_ATOMIC,
+ 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,
@@ -2416,6 +2452,7 @@ typedef struct gfc_code
int stop_code;
gfc_entry_list *entry;
gfc_omp_clauses *omp_clauses;
+ gfc_oacc_declare *oacc_declare;
const char *omp_name;
gfc_omp_namelist *omp_namelist;
bool omp_bool;
@@ -2923,6 +2960,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_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 *);
@@ -3231,4 +3269,8 @@ int gfc_code_walker (gfc_code **, walk_code_fn_t, walk_expr_fn_t, void *);
void gfc_convert_mpz_to_signed (mpz_t, int);
+/* trans-decl.c */
+
+void insert_oacc_declare (gfc_namespace *);
+
#endif /* GCC_GFORTRAN_H */
diff --git gcc/fortran/match.h gcc/fortran/match.h
index 96d3ec1..202e175 100644
--- gcc/fortran/match.h
+++ gcc/fortran/match.h
@@ -123,6 +123,7 @@ gfc_common_head *gfc_get_common (const char *, int);
/* openmp.c. */
/* OpenACC directive matchers. */
+match gfc_match_oacc_atomic (void);
match gfc_match_oacc_cache (void);
match gfc_match_oacc_wait (void);
match gfc_match_oacc_update (void);
diff --git gcc/fortran/openmp.c gcc/fortran/openmp.c
index 21de607..883676e 100644
--- gcc/fortran/openmp.c
+++ gcc/fortran/openmp.c
@@ -92,6 +92,25 @@ gfc_free_omp_clauses (gfc_omp_clauses *c)
free (c);
}
+/* Free oacc_declare structures. */
+
+void
+gfc_free_oacc_declares (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)
@@ -447,21 +466,26 @@ match_oacc_clause_gang (gfc_omp_clauses *cp)
#define OMP_CLAUSE_INDEPENDENT ((uint64_t) 1 << 49)
#define OMP_CLAUSE_USE_DEVICE ((uint64_t) 1 << 50)
#define OMP_CLAUSE_DEVICE_RESIDENT ((uint64_t) 1 << 51)
-#define OMP_CLAUSE_HOST_SELF ((uint64_t) 1 << 52)
+#define OMP_CLAUSE_HOST ((uint64_t) 1 << 52)
#define OMP_CLAUSE_OACC_DEVICE ((uint64_t) 1 << 53)
#define OMP_CLAUSE_WAIT ((uint64_t) 1 << 54)
#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)
/* Helper function for OpenACC and OpenMP clauses involving memory
mapping. */
static bool
-gfc_match_omp_map_clause (gfc_omp_namelist **list, gfc_omp_map_op map_op)
+gfc_match_omp_map_clause (gfc_omp_namelist **list, gfc_omp_map_op map_op,
+ bool allow_sections = true)
{
gfc_omp_namelist **head = NULL;
- if (gfc_match_omp_variable_list ("", list, false, NULL, &head, true)
+ if (gfc_match_omp_variable_list ("", list, false, NULL, &head,
+ allow_sections)
== MATCH_YES)
{
gfc_omp_namelist *n;
@@ -478,11 +502,14 @@ gfc_match_omp_map_clause (gfc_omp_namelist **list, gfc_omp_map_op map_op)
static match
gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask,
- bool first = true, bool needs_space = true,
- bool openacc = false)
+ uint64_t dtype_mask, bool first = true,
+ bool needs_space = true, bool openacc = false)
{
- gfc_omp_clauses *c = gfc_get_omp_clauses ();
+ gfc_omp_clauses *base_clauses, *c = gfc_get_omp_clauses ();
locus old_loc;
+ bool scan_dtype = false;
+
+ base_clauses = c;
*cp = NULL;
while (1)
@@ -531,7 +558,10 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask,
if ((mask & OMP_CLAUSE_VECTOR_LENGTH) && c->vector_length_expr == NULL
&& gfc_match ("vector_length ( %e )", &c->vector_length_expr)
== MATCH_YES)
- continue;
+ {
+ c->vector_length = 1;
+ continue;
+ }
if ((mask & OMP_CLAUSE_VECTOR) && !c->vector)
if (gfc_match ("vector") == MATCH_YES)
{
@@ -596,11 +626,17 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask,
}
if ((mask & OMP_CLAUSE_NUM_GANGS) && c->num_gangs_expr == NULL
&& gfc_match ("num_gangs ( %e )", &c->num_gangs_expr) == MATCH_YES)
- continue;
+ {
+ c->num_gangs = 1;
+ continue;
+ }
if ((mask & OMP_CLAUSE_NUM_WORKERS) && c->num_workers_expr == NULL
&& gfc_match ("num_workers ( %e )", &c->num_workers_expr)
== MATCH_YES)
- continue;
+ {
+ c->num_workers = 1;
+ continue;
+ }
if ((mask & OMP_CLAUSE_COPY)
&& gfc_match ("copy ( ") == MATCH_YES
&& gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
@@ -680,6 +716,18 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask,
continue;
}
}
+ if ((mask & OMP_CLAUSE_BIND) && c->routine_bind == NULL
+ && gfc_match ("bind ( %s )", &c->routine_bind) == MATCH_YES)
+ {
+ c->bind = 1;
+ continue;
+ }
+ if ((mask & OMP_CLAUSE_NOHOST) && !c->nohost
+ && gfc_match ("nohost") == MATCH_YES)
+ {
+ c->nohost = true;
+ continue;
+ }
if ((mask & OMP_CLAUSE_USE_DEVICE)
&& gfc_match_omp_variable_list ("use_device (",
&c->lists[OMP_LIST_USE_DEVICE], true)
@@ -696,15 +744,20 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask,
&& gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
OMP_MAP_FORCE_TO))
continue;
- if ((mask & OMP_CLAUSE_HOST_SELF)
+ if ((mask & OMP_CLAUSE_HOST)
&& (gfc_match ("host ( ") == MATCH_YES
- || gfc_match ("self ( ") == MATCH_YES)
+ || gfc_match ("self ( ") == MATCH_YES) /* "self" is a synonym for
+ "host". */
&& gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
OMP_MAP_FORCE_FROM))
continue;
if ((mask & OMP_CLAUSE_TILE)
+ && !c->tile_list
&& match_oacc_expr_list ("tile (", &c->tile_list, true) == MATCH_YES)
- continue;
+ {
+ c->tile = 1;
+ continue;
+ }
if ((mask & OMP_CLAUSE_SEQ) && !c->seq
&& gfc_match ("seq") == MATCH_YES)
{
@@ -856,13 +909,14 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask,
if ((mask & OMP_CLAUSE_DEFAULT)
&& c->default_sharing == OMP_DEFAULT_UNKNOWN)
{
- if (gfc_match ("default ( shared )") == MATCH_YES)
+ if (!openacc && gfc_match ("default ( shared )") == MATCH_YES)
c->default_sharing = OMP_DEFAULT_SHARED;
- else if (gfc_match ("default ( private )") == MATCH_YES)
+ else if (!openacc && gfc_match ("default ( private )") == MATCH_YES)
c->default_sharing = OMP_DEFAULT_PRIVATE;
else if (gfc_match ("default ( none )") == MATCH_YES)
c->default_sharing = OMP_DEFAULT_NONE;
- else if (gfc_match ("default ( firstprivate )") == MATCH_YES)
+ else if (!openacc
+ && gfc_match ("default ( firstprivate )") == MATCH_YES)
c->default_sharing = OMP_DEFAULT_FIRSTPRIVATE;
if (c->default_sharing != OMP_DEFAULT_UNKNOWN)
continue;
@@ -938,6 +992,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask,
}
c->collapse = collapse;
gfc_free_expr (cexpr);
+ c->acc_collapse = 1;
continue;
}
}
@@ -1083,6 +1138,47 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask,
if ((mask & OMP_CLAUSE_DEVICE) && c->device == NULL
&& gfc_match ("device ( %e )", &c->device) == MATCH_YES)
continue;
+ if (((mask & OMP_CLAUSE_DEVICE_TYPE) || scan_dtype)
+ && (gfc_match ("device_type ( ") == MATCH_YES
+ || gfc_match ("dtype ( ") == MATCH_YES))
+ {
+ int device = GOMP_DEVICE_NONE;
+ gfc_omp_clauses *t = gfc_get_omp_clauses ();
+
+ c->dtype_clauses = t;
+ c = t;
+
+ if (gfc_match (" * ") == MATCH_YES)
+ device = GOMP_DEVICE_DEFAULT;
+ else
+ {
+ char n[GFC_MAX_SYMBOL_LEN + 1];
+
+ while (gfc_match (" %n ", n) == MATCH_YES)
+ {
+ if (!strcasecmp ("nvidia", n))
+ device = GOMP_DEVICE_NVIDIA_PTX;
+ else
+ {
+ /* The OpenACC technical committee advises compilers
+ to silently ignore unknown devices. */
+ }
+ gfc_match (" , ");
+ }
+ }
+
+ /* Consume the trailing ')'. */
+ if (gfc_match (" ) ") != MATCH_YES)
+ {
+ gfc_error ("expected %<)%>");
+ continue;
+ }
+
+ c->dtype = device;
+ mask = dtype_mask;
+ scan_dtype = true;
+ continue;
+ }
if ((mask & OMP_CLAUSE_THREAD_LIMIT) && c->thread_limit == NULL
&& gfc_match ("thread_limit ( %e )", &c->thread_limit) == MATCH_YES)
continue;
@@ -1129,11 +1225,82 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask,
if (gfc_match_omp_eos () != MATCH_YES)
{
- gfc_free_omp_clauses (c);
+ gfc_omp_clauses *t;
+ c = base_clauses->dtype_clauses;
+ while (c)
+ {
+ t = c->dtype_clauses;
+ gfc_free_omp_clauses (c);
+ c = t;
+ }
+ gfc_free_omp_clauses (base_clauses);
return MATCH_ERROR;
}
- *cp = c;
+ /* Filter out the device_type clauses. */
+ if (base_clauses->dtype_clauses)
+ {
+ gfc_omp_clauses *t;
+ gfc_omp_clauses *seen_default = NULL;
+ gfc_omp_clauses *seen_nvidia = NULL;
+
+ /* Scan for device_type clauses. */
+ c = base_clauses->dtype_clauses;
+ while (c)
+ {
+ if (c->dtype == GOMP_DEVICE_DEFAULT)
+ {
+ if (seen_default)
+ gfc_error ("duplicate device_type (*)");
+ else
+ seen_default = c;
+ }
+ else if (c->dtype == GOMP_DEVICE_NVIDIA_PTX)
+ {
+ if (seen_nvidia)
+ gfc_error ("duplicate device_type (nvidia)");
+ else
+ seen_nvidia = c;
+ }
+ c = c->dtype_clauses;
+ }
+
+ /* Update the clauses in the original set of clauses. */
+ c = seen_nvidia ? seen_nvidia : seen_default;
+ if (c)
+ {
+#define acc_clause0(mask) do if (c->mask) { base_clauses->mask = 1; } while (0)
+#define acc_clause1(mask, expr, type) do if (c->mask) { type t; \
+ base_clauses->mask = 1; t = base_clauses->expr; \
+ base_clauses->expr = c->expr; c->expr = t; } while (0)
+
+ acc_clause1 (acc_collapse, collapse, int);
+ acc_clause1 (gang, gang_expr, gfc_expr *);
+ acc_clause1 (worker, worker_expr, gfc_expr *);
+ acc_clause1 (vector, vector_expr, gfc_expr *);
+ acc_clause0 (par_auto);
+ acc_clause0 (independent);
+ acc_clause0 (seq);
+ acc_clause1 (tile, tile_list, gfc_expr_list *);
+ acc_clause1 (async, async_expr, gfc_expr *);
+ acc_clause1 (wait, wait_list, gfc_expr_list *);
+ acc_clause1 (num_gangs, num_gangs_expr, gfc_expr *);
+ acc_clause1 (num_workers, num_workers_expr, gfc_expr *);
+ acc_clause1 (vector_length, vector_length_expr, gfc_expr *);
+ acc_clause1 (bind, routine_bind, gfc_symbol *);
+ }
+
+ /* Remove the device_type clauses. */
+ c = base_clauses->dtype_clauses;
+ while (c)
+ {
+ t = c->dtype_clauses;
+ gfc_free_omp_clauses (c);
+ c = t;
+ }
+ }
+
+ *cp = base_clauses;
return MATCH_YES;
}
@@ -1145,13 +1312,15 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask,
| OMP_CLAUSE_CREATE | 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_DEVICEPTR | OMP_CLAUSE_PRIVATE \
- | OMP_CLAUSE_FIRSTPRIVATE | OMP_CLAUSE_DEFAULT | OMP_CLAUSE_WAIT)
+ | OMP_CLAUSE_FIRSTPRIVATE | OMP_CLAUSE_DEFAULT | OMP_CLAUSE_WAIT \
+ | OMP_CLAUSE_DEVICE_TYPE)
#define OACC_KERNELS_CLAUSES \
(OMP_CLAUSE_IF | OMP_CLAUSE_ASYNC | OMP_CLAUSE_DEVICEPTR \
| OMP_CLAUSE_COPY | OMP_CLAUSE_COPYIN | OMP_CLAUSE_COPYOUT \
| OMP_CLAUSE_CREATE | 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_DEFAULT | OMP_CLAUSE_WAIT)
+ | OMP_CLAUSE_PRESENT_OR_CREATE | OMP_CLAUSE_DEFAULT | OMP_CLAUSE_WAIT \
+ | OMP_CLAUSE_DEVICE_TYPE)
#define OACC_DATA_CLAUSES \
(OMP_CLAUSE_IF | OMP_CLAUSE_DEVICEPTR | OMP_CLAUSE_COPY \
| OMP_CLAUSE_COPYIN | OMP_CLAUSE_COPYOUT | OMP_CLAUSE_CREATE \
@@ -1162,7 +1331,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask,
(OMP_CLAUSE_COLLAPSE | OMP_CLAUSE_GANG | OMP_CLAUSE_WORKER \
| OMP_CLAUSE_VECTOR | OMP_CLAUSE_SEQ | OMP_CLAUSE_INDEPENDENT \
| OMP_CLAUSE_PRIVATE | OMP_CLAUSE_REDUCTION | OMP_CLAUSE_AUTO \
- | OMP_CLAUSE_TILE)
+ | OMP_CLAUSE_TILE | OMP_CLAUSE_DEVICE_TYPE)
#define OACC_PARALLEL_LOOP_CLAUSES \
(OACC_LOOP_CLAUSES | OACC_PARALLEL_CLAUSES)
#define OACC_KERNELS_LOOP_CLAUSES \
@@ -1175,8 +1344,8 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask,
| OMP_CLAUSE_PRESENT_OR_COPYIN | OMP_CLAUSE_PRESENT_OR_COPYOUT \
| OMP_CLAUSE_PRESENT_OR_CREATE)
#define OACC_UPDATE_CLAUSES \
- (OMP_CLAUSE_IF | OMP_CLAUSE_ASYNC | OMP_CLAUSE_HOST_SELF \
- | OMP_CLAUSE_OACC_DEVICE | OMP_CLAUSE_WAIT)
+ (OMP_CLAUSE_IF | OMP_CLAUSE_ASYNC | OMP_CLAUSE_HOST \
+ | OMP_CLAUSE_OACC_DEVICE | OMP_CLAUSE_WAIT | OMP_CLAUSE_DEVICE_TYPE)
#define OACC_ENTER_DATA_CLAUSES \
(OMP_CLAUSE_IF | OMP_CLAUSE_ASYNC | OMP_CLAUSE_WAIT | OMP_CLAUSE_COPYIN \
| OMP_CLAUSE_CREATE | OMP_CLAUSE_PRESENT_OR_COPYIN \
@@ -1186,14 +1355,35 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask,
| OMP_CLAUSE_DELETE)
#define OACC_WAIT_CLAUSES \
(OMP_CLAUSE_ASYNC)
+#define OACC_ROUTINE_CLAUSES \
+ (OMP_CLAUSE_GANG | OMP_CLAUSE_WORKER | OMP_CLAUSE_VECTOR | OMP_CLAUSE_SEQ \
+ | OMP_CLAUSE_BIND | OMP_CLAUSE_OACC_DEVICE | OMP_CLAUSE_NOHOST \
+ | OMP_CLAUSE_DEVICE_TYPE)
+
+#define OACC_LOOP_CLAUSE_DEVICE_TYPE_MASK \
+ (OMP_CLAUSE_COLLAPSE | OMP_CLAUSE_GANG | OMP_CLAUSE_WORKER \
+ | OMP_CLAUSE_VECTOR | OMP_CLAUSE_AUTO | OMP_CLAUSE_INDEPENDENT \
+ | OMP_CLAUSE_SEQ | OMP_CLAUSE_TILE)
+#define OACC_KERNELS_CLAUSE_DEVICE_TYPE_MASK \
+ (OMP_CLAUSE_ASYNC | OMP_CLAUSE_WAIT)
+#define OACC_PARALLEL_CLAUSE_DEVICE_TYPE_MASK \
+ (OMP_CLAUSE_ASYNC | OMP_CLAUSE_NUM_GANGS | OMP_CLAUSE_NUM_WORKERS \
+ | OMP_CLAUSE_VECTOR_LENGTH | OMP_CLAUSE_WAIT)
+#define OACC_ROUTINE_CLAUSE_DEVICE_TYPE_MASK \
+ (OMP_CLAUSE_GANG | OMP_CLAUSE_WORKER | OMP_CLAUSE_VECTOR \
+ | OMP_CLAUSE_SEQ | OMP_CLAUSE_BIND)
+#define OACC_UPDATE_CLAUSE_DEVICE_TYPE_MASK \
+ (OMP_CLAUSE_ASYNC | OMP_CLAUSE_WAIT)
match
gfc_match_oacc_parallel_loop (void)
{
gfc_omp_clauses *c;
- if (gfc_match_omp_clauses (&c, OACC_PARALLEL_LOOP_CLAUSES, false, false,
- true) != MATCH_YES)
+ if (gfc_match_omp_clauses (&c, OACC_PARALLEL_LOOP_CLAUSES,
+ OACC_PARALLEL_CLAUSE_DEVICE_TYPE_MASK
+ | OACC_LOOP_CLAUSE_DEVICE_TYPE_MASK, false,
+ false, true) != MATCH_YES)
return MATCH_ERROR;
new_st.op = EXEC_OACC_PARALLEL_LOOP;
@@ -1206,7 +1396,9 @@ match
gfc_match_oacc_parallel (void)
{
gfc_omp_clauses *c;
- if (gfc_match_omp_clauses (&c, OACC_PARALLEL_CLAUSES, false, false, true)
+ if (gfc_match_omp_clauses (&c, OACC_PARALLEL_CLAUSES,
+ OACC_PARALLEL_CLAUSE_DEVICE_TYPE_MASK, false,
+ false, true)
!= MATCH_YES)
return MATCH_ERROR;
@@ -1220,8 +1412,10 @@ match
gfc_match_oacc_kernels_loop (void)
{
gfc_omp_clauses *c;
- if (gfc_match_omp_clauses (&c, OACC_KERNELS_LOOP_CLAUSES, false, false,
- true) != MATCH_YES)
+ if (gfc_match_omp_clauses (&c, OACC_KERNELS_LOOP_CLAUSES,
+ OACC_KERNELS_CLAUSE_DEVICE_TYPE_MASK
+ | OACC_LOOP_CLAUSE_DEVICE_TYPE_MASK, false,
+ false, true) != MATCH_YES)
return MATCH_ERROR;
new_st.op = EXEC_OACC_KERNELS_LOOP;
@@ -1234,7 +1428,9 @@ match
gfc_match_oacc_kernels (void)
{
gfc_omp_clauses *c;
- if (gfc_match_omp_clauses (&c, OACC_KERNELS_CLAUSES, false, false, true)
+ if (gfc_match_omp_clauses (&c, OACC_KERNELS_CLAUSES,
+ OACC_KERNELS_CLAUSE_DEVICE_TYPE_MASK, false,
+ false, true)
!= MATCH_YES)
return MATCH_ERROR;
@@ -1248,7 +1444,7 @@ match
gfc_match_oacc_data (void)
{
gfc_omp_clauses *c;
- if (gfc_match_omp_clauses (&c, OACC_DATA_CLAUSES, false, false, true)
+ if (gfc_match_omp_clauses (&c, OACC_DATA_CLAUSES, 0, false, false, true)
!= MATCH_YES)
return MATCH_ERROR;
@@ -1262,7 +1458,7 @@ match
gfc_match_oacc_host_data (void)
{
gfc_omp_clauses *c;
- if (gfc_match_omp_clauses (&c, OACC_HOST_DATA_CLAUSES, false, false, true)
+ if (gfc_match_omp_clauses (&c, OACC_HOST_DATA_CLAUSES, 0, false, false, true)
!= MATCH_YES)
return MATCH_ERROR;
@@ -1276,7 +1472,9 @@ match
gfc_match_oacc_loop (void)
{
gfc_omp_clauses *c;
- if (gfc_match_omp_clauses (&c, OACC_LOOP_CLAUSES, false, false, true)
+ if (gfc_match_omp_clauses (&c, OACC_LOOP_CLAUSES,
+ OACC_LOOP_CLAUSE_DEVICE_TYPE_MASK, false, false,
+ true)
!= MATCH_YES)
return MATCH_ERROR;
@@ -1290,12 +1488,90 @@ match
gfc_match_oacc_declare (void)
{
gfc_omp_clauses *c;
- if (gfc_match_omp_clauses (&c, OACC_DECLARE_CLAUSES, false, false, true)
+ gfc_omp_namelist *n;
+ gfc_namespace *ns = gfc_current_ns;
+ gfc_oacc_declare *new_oc, *oc;
+ locus where = gfc_current_locus;
+
+ if (gfc_match_omp_clauses (&c, OACC_DECLARE_CLAUSES, 0, 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_MAP]; n != NULL; n = n->next)
+ {
+ gfc_symbol *s = n->sym;
+
+ 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 %C");
+ return MATCH_ERROR;
+ }
+ }
+
+ if (s->attr.in_common)
+ {
+ gfc_error ("Unsupported: variable in a common block with "
+ "$!ACC DECLARE at %C");
+ return MATCH_ERROR;
+ }
+
+ if (s->attr.use_assoc)
+ {
+ gfc_error ("Unsupported: variable is USE-associated with "
+ "$!ACC DECLARE at %C");
+ 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");
+ return MATCH_ERROR;
+ }
+ }
+
+ new_oc = gfc_get_oacc_declare ();
+ new_oc->next = ns->oacc_declare;
+ new_oc->where = where;
+ new_oc->clauses = c;
+
+ 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;
+ }
+
+ ns->oacc_declare = new_oc;
+
return MATCH_YES;
}
@@ -1304,10 +1580,21 @@ match
gfc_match_oacc_update (void)
{
gfc_omp_clauses *c;
- if (gfc_match_omp_clauses (&c, OACC_UPDATE_CLAUSES, false, false, true)
+ locus here = gfc_current_locus;
+
+ if (gfc_match_omp_clauses (&c, OACC_UPDATE_CLAUSES,
+ OACC_UPDATE_CLAUSE_DEVICE_TYPE_MASK, false,
+ false, true)
!= MATCH_YES)
return MATCH_ERROR;
+ if (!c->lists[OMP_LIST_MAP])
+ {
+ gfc_error ("%<acc update%> must contain at least one "
+ "%<device%> or %<host/self%> clause at %L", &here);
+ return MATCH_ERROR;
+ }
+
new_st.op = EXEC_OACC_UPDATE;
new_st.ext.omp_clauses = c;
return MATCH_YES;
@@ -1318,7 +1605,7 @@ match
gfc_match_oacc_enter_data (void)
{
gfc_omp_clauses *c;
- if (gfc_match_omp_clauses (&c, OACC_ENTER_DATA_CLAUSES, false, false, true)
+ if (gfc_match_omp_clauses (&c, OACC_ENTER_DATA_CLAUSES, 0, false, false, true)
!= MATCH_YES)
return MATCH_ERROR;
@@ -1332,7 +1619,7 @@ match
gfc_match_oacc_exit_data (void)
{
gfc_omp_clauses *c;
- if (gfc_match_omp_clauses (&c, OACC_EXIT_DATA_CLAUSES, false, false, true)
+ if (gfc_match_omp_clauses (&c, OACC_EXIT_DATA_CLAUSES, 0, false, false, true)
!= MATCH_YES)
return MATCH_ERROR;
@@ -1349,7 +1636,7 @@ gfc_match_oacc_wait (void)
gfc_expr_list *wait_list = NULL, *el;
match_oacc_expr_list (" (", &wait_list, true);
- gfc_match_omp_clauses (&c, OACC_WAIT_CLAUSES, false, false, true);
+ gfc_match_omp_clauses (&c, OACC_WAIT_CLAUSES, 0, false, false, true);
if (gfc_match_omp_eos () != MATCH_YES)
{
@@ -1389,7 +1676,8 @@ gfc_match_oacc_cache (void)
{
gfc_omp_clauses *c = gfc_get_omp_clauses ();
match m = gfc_match_omp_variable_list (" (",
- &c->lists[OMP_LIST_CACHE], true);
+ &c->lists[OMP_LIST_CACHE], true,
+ NULL, NULL, true);
if (m != MATCH_YES)
{
gfc_free_omp_clauses(c);
@@ -1414,8 +1702,10 @@ match
gfc_match_oacc_routine (void)
{
locus old_loc;
- gfc_symbol *sym;
+ gfc_symbol *sym = NULL;
match m;
+ gfc_omp_clauses *c = NULL;
+ gfc_oacc_routine_name *n = NULL;
old_loc = gfc_current_locus;
@@ -1430,52 +1720,73 @@ gfc_match_oacc_routine (void)
goto cleanup;
}
- if (m == MATCH_NO
- && gfc_current_ns->proc_name
- && gfc_match_omp_eos () == MATCH_YES)
+ if (m == MATCH_YES)
+ {
+ /* Scan for a function name/string. */
+ m = gfc_match_symbol (&sym, 0);
+
+ if (m == MATCH_NO)
+ {
+ gfc_error ("Syntax error in !$ACC ROUTINE ( NAME ) at %C");
+ gfc_current_locus = old_loc;
+ return MATCH_ERROR;
+ }
+
+ if (!sym->attr.external && !sym->attr.function && !sym->attr.subroutine)
+ {
+ gfc_error ("Syntax error in !$ACC ROUTINE ( NAME ) at %C, invalid"
+ " function name %qs", sym->name);
+ gfc_current_locus = old_loc;
+ return MATCH_ERROR;
+ }
+
+ if (gfc_match_char (')') != MATCH_YES)
+ {
+ gfc_error ("Syntax error in !$ACC ROUTINE ( NAME ) at %C, expecting"
+ " ')' after NAME");
+ gfc_current_locus = old_loc;
+ return MATCH_ERROR;
+ }
+ }
+
+ if (sym != NULL)
+ {
+ n = gfc_get_oacc_routine_name ();
+ n->sym = sym;
+ n->clauses = NULL;
+ n->next = NULL;
+ if (gfc_current_ns->oacc_routine_names != NULL)
+ n->next = gfc_current_ns->oacc_routine_names;
+
+ gfc_current_ns->oacc_routine_names = n;
+ }
+ else if (gfc_current_ns->proc_name)
{
if (!gfc_add_omp_declare_target (&gfc_current_ns->proc_name->attr,
gfc_current_ns->proc_name->name,
&old_loc))
goto cleanup;
- return MATCH_YES;
}
+ else
+ gcc_unreachable ();
- if (m != MATCH_YES)
- return m;
+ if (gfc_match_omp_eos () == MATCH_YES)
+ return MATCH_YES;
- /* Scan for a function name. */
- m = gfc_match_symbol (&sym, 0);
+ if (gfc_match_omp_clauses (&c, OACC_ROUTINE_CLAUSES,
+ OACC_ROUTINE_CLAUSE_DEVICE_TYPE_MASK, false,
+ false, true)
+ != MATCH_YES)
+ return MATCH_ERROR;
- if (m != MATCH_YES)
- {
- gfc_error ("Syntax error in !$ACC ROUTINE ( NAME ) at %C");
- gfc_current_locus = old_loc;
- return MATCH_ERROR;
- }
-
- if (!sym->attr.external && !sym->attr.function && !sym->attr.subroutine)
- {
- gfc_error ("Syntax error in !$ACC ROUTINE ( NAME ) at %C, invalid"
- " function name %qs", sym->name);
- gfc_current_locus = old_loc;
- return MATCH_ERROR;
- }
+ if (n)
+ n->clauses = c;
+ else if (gfc_current_ns->oacc_routine)
+ gfc_current_ns->oacc_routine_clauses = c;
- if (gfc_match_char (')') != MATCH_YES)
- {
- gfc_error ("Syntax error in !$ACC ROUTINE ( NAME ) at %C, expecting"
- " ')' after NAME");
- gfc_current_locus = old_loc;
- return MATCH_ERROR;
- }
-
- if (gfc_match_omp_eos () != MATCH_YES)
- {
- gfc_error ("Unexpected junk after !$ACC ROUTINE at %C");
- goto cleanup;
- }
- return MATCH_YES;
+ new_st.op = EXEC_OACC_ROUTINE;
+ new_st.ext.omp_clauses = c;
+ return MATCH_YES;
cleanup:
gfc_current_locus = old_loc;
@@ -1524,7 +1835,7 @@ static match
match_omp (gfc_exec_op op, unsigned int mask)
{
gfc_omp_clauses *c;
- if (gfc_match_omp_clauses (&c, mask) != MATCH_YES)
+ if (gfc_match_omp_clauses (&c, mask, 0) != MATCH_YES)
return MATCH_ERROR;
new_st.op = op;
new_st.ext.omp_clauses = c;
@@ -1627,7 +1938,7 @@ gfc_match_omp_declare_simd (void)
if (gfc_match (" ( %s ) ", &proc_name) != MATCH_YES)
return MATCH_ERROR;
- if (gfc_match_omp_clauses (&c, OMP_DECLARE_SIMD_CLAUSES, true,
+ if (gfc_match_omp_clauses (&c, OMP_DECLARE_SIMD_CLAUSES, 0, true,
false) != MATCH_YES)
return MATCH_ERROR;
@@ -2450,9 +2761,8 @@ gfc_match_omp_ordered (void)
return MATCH_YES;
}
-
-match
-gfc_match_omp_atomic (void)
+static match
+gfc_match_omp_oacc_atomic (bool omp_p)
{
gfc_omp_atomic_op op = GFC_OMP_ATOMIC_UPDATE;
int seq_cst = 0;
@@ -2490,13 +2800,24 @@ gfc_match_omp_atomic (void)
gfc_error ("Unexpected junk after $OMP ATOMIC statement at %C");
return MATCH_ERROR;
}
- new_st.op = EXEC_OMP_ATOMIC;
+ new_st.op = (omp_p ? EXEC_OMP_ATOMIC : EXEC_OACC_ATOMIC);
if (seq_cst)
op = (gfc_omp_atomic_op) (op | GFC_OMP_ATOMIC_SEQ_CST);
new_st.ext.omp_atomic = op;
return MATCH_YES;
}
+match
+gfc_match_oacc_atomic (void)
+{
+ return gfc_match_omp_oacc_atomic (false);
+}
+
+match
+gfc_match_omp_atomic (void)
+{
+ return gfc_match_omp_oacc_atomic (true);
+}
match
gfc_match_omp_barrier (void)
@@ -2549,7 +2870,7 @@ gfc_match_omp_cancel (void)
enum gfc_omp_cancel_kind kind = gfc_match_omp_cancel_kind ();
if (kind == OMP_CANCEL_UNKNOWN)
return MATCH_ERROR;
- if (gfc_match_omp_clauses (&c, OMP_CLAUSE_IF, false) != MATCH_YES)
+ if (gfc_match_omp_clauses (&c, OMP_CLAUSE_IF, 0, false) != MATCH_YES)
return MATCH_ERROR;
c->cancel = kind;
new_st.op = EXEC_OMP_CANCEL;
@@ -2606,7 +2927,7 @@ gfc_match_omp_end_single (void)
new_st.ext.omp_bool = true;
return MATCH_YES;
}
- if (gfc_match_omp_clauses (&c, OMP_CLAUSE_COPYPRIVATE) != MATCH_YES)
+ if (gfc_match_omp_clauses (&c, OMP_CLAUSE_COPYPRIVATE, 0) != MATCH_YES)
return MATCH_ERROR;
new_st.op = EXEC_OMP_END_SINGLE;
new_st.ext.omp_clauses = c;
@@ -2686,10 +3007,6 @@ check_array_not_assumed (gfc_symbol *sym, locus loc, const char *name)
if (sym->as && sym->as->type == AS_ASSUMED_RANK)
gfc_error ("Assumed rank array %qs in %s clause at %L",
sym->name, name, &loc);
- if (sym->as && sym->as->type == AS_DEFERRED && sym->attr.pointer
- && !sym->attr.contiguous)
- gfc_error ("Noncontiguous deferred shape array %qs in %s clause at %L",
- sym->name, name, &loc);
}
static void
@@ -4302,6 +4619,8 @@ oacc_code_to_statement (gfc_code *code)
{
switch (code->op)
{
+ case EXEC_OACC_ATOMIC:
+ return ST_OACC_ATOMIC;
case EXEC_OACC_PARALLEL:
return ST_OACC_PARALLEL;
case EXEC_OACC_KERNELS:
@@ -4514,22 +4833,8 @@ resolve_oacc_loop_blocks (gfc_code *code)
if (code->ext.omp_clauses->vector)
gfc_error ("Clause AUTO conflicts with VECTOR at %L", &code->loc);
}
- if (!code->ext.omp_clauses->tile_list)
- {
- if (code->ext.omp_clauses->gang)
- {
- if (code->ext.omp_clauses->worker)
- gfc_error ("Clause GANG conflicts with WORKER at %L", &code->loc);
- if (code->ext.omp_clauses->vector)
- gfc_error ("Clause GANG conflicts with VECTOR at %L", &code->loc);
- }
- if (code->ext.omp_clauses->worker)
- if (code->ext.omp_clauses->vector)
- gfc_error ("Clause WORKER conflicts with VECTOR at %L", &code->loc);
- }
- else if (code->ext.omp_clauses->gang
- && code->ext.omp_clauses->worker
- && code->ext.omp_clauses->vector)
+ if (code->ext.omp_clauses->tile_list && code->ext.omp_clauses->gang
+ && code->ext.omp_clauses->worker && code->ext.omp_clauses->vector)
gfc_error ("Tiled loop cannot be parallelized across gangs, workers and "
"vectors at the same time at %L", &code->loc);
@@ -4599,48 +4904,52 @@ resolve_oacc_loop (gfc_code *code)
}
-static void
-resolve_oacc_cache (gfc_code *code ATTRIBUTE_UNUSED)
-{
- sorry ("Sorry, !$ACC cache unimplemented yet");
-}
-
-
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)
+ if (ns->oacc_declare == NULL)
return;
- loc = ns->oacc_declare_clauses->loc;
+ 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 (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);
- }
+ for (list = OMP_LIST_DEVICE_RESIDENT;
+ list <= OMP_LIST_DEVICE_RESIDENT; 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);
+ }
- 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 (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;
+ }
- for (n = ns->oacc_declare_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_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);
+ }
+ }
}
@@ -4667,8 +4976,8 @@ gfc_resolve_oacc_directive (gfc_code *code, gfc_namespace *ns ATTRIBUTE_UNUSED)
case EXEC_OACC_LOOP:
resolve_oacc_loop (code);
break;
- case EXEC_OACC_CACHE:
- resolve_oacc_cache (code);
+ case EXEC_OACC_ATOMIC:
+ resolve_omp_atomic (code);
break;
default:
break;
diff --git gcc/fortran/parse.c gcc/fortran/parse.c
index 2c7c554..69217c0 100644
--- gcc/fortran/parse.c
+++ gcc/fortran/parse.c
@@ -615,6 +615,9 @@ decode_oacc_directive (void)
switch (c)
{
+ case 'a':
+ match ("atomic", gfc_match_oacc_atomic, ST_OACC_ATOMIC);
+ break;
case 'c':
match ("cache", gfc_match_oacc_cache, ST_OACC_CACHE);
break;
@@ -623,6 +626,7 @@ decode_oacc_directive (void)
match ("declare", gfc_match_oacc_declare, ST_OACC_DECLARE);
break;
case 'e':
+ match ("end atomic", gfc_match_omp_eos, ST_OACC_END_ATOMIC);
match ("end data", gfc_match_omp_eos, ST_OACC_END_DATA);
match ("end host_data", gfc_match_omp_eos, ST_OACC_END_HOST_DATA);
match ("end kernels loop", gfc_match_omp_eos, ST_OACC_END_KERNELS_LOOP);
@@ -1351,7 +1355,8 @@ next_statement (void)
case ST_OMP_DISTRIBUTE_PARALLEL_DO_SIMD: \
case ST_CRITICAL: \
case ST_OACC_PARALLEL_LOOP: case ST_OACC_PARALLEL: case ST_OACC_KERNELS: \
- case ST_OACC_DATA: case ST_OACC_HOST_DATA: case ST_OACC_LOOP: case ST_OACC_KERNELS_LOOP
+ case ST_OACC_DATA: case ST_OACC_HOST_DATA: case ST_OACC_LOOP: \
+ case ST_OACC_KERNELS_LOOP: case ST_OACC_ATOMIC
/* Declaration statements */
@@ -1359,7 +1364,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(). */
@@ -1380,7 +1385,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_clauses = NULL;
+ p->ext.oacc_declare = 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,
@@ -1909,6 +1914,12 @@ gfc_ascii_statement (gfc_statement st)
case ST_OACC_ROUTINE:
p = "!$ACC ROUTINE";
break;
+ case ST_OACC_ATOMIC:
+ p = "!ACC ATOMIC";
+ break;
+ case ST_OACC_END_ATOMIC:
+ p = "!ACC END ATOMIC";
+ break;
case ST_OMP_ATOMIC:
p = "!$OMP ATOMIC";
break;
@@ -2410,7 +2421,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;
@@ -3312,19 +3322,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;
}
@@ -4190,14 +4187,24 @@ parse_omp_do (gfc_statement omp_st)
/* Parse the statements of OpenMP atomic directive. */
static gfc_statement
-parse_omp_atomic (void)
+parse_omp_oacc_atomic (bool omp_p)
{
- gfc_statement st;
+ gfc_statement st, st_atomic, st_end_atomic;
gfc_code *cp, *np;
gfc_state_data s;
int count;
- accept_statement (ST_OMP_ATOMIC);
+ if (omp_p)
+ {
+ st_atomic = ST_OMP_ATOMIC;
+ st_end_atomic = ST_OMP_END_ATOMIC;
+ }
+ else
+ {
+ st_atomic = ST_OACC_ATOMIC;
+ st_end_atomic = ST_OACC_END_ATOMIC;
+ }
+ accept_statement (st_atomic);
cp = gfc_state_stack->tail;
push_state (&s, COMP_OMP_STRUCTURED_BLOCK, NULL);
@@ -4224,7 +4231,7 @@ parse_omp_atomic (void)
pop_state ();
st = next_statement ();
- if (st == ST_OMP_END_ATOMIC)
+ if (st == st_end_atomic)
{
gfc_clear_new_st ();
gfc_commit_symbols ();
@@ -4518,7 +4525,7 @@ parse_omp_structured_block (gfc_statement omp_st, bool workshare_stmts_only)
continue;
case ST_OMP_ATOMIC:
- st = parse_omp_atomic ();
+ st = parse_omp_oacc_atomic (true);
continue;
default:
@@ -4737,8 +4744,12 @@ parse_executable (gfc_statement st)
return st;
continue;
+ case ST_OACC_ATOMIC:
+ st = parse_omp_oacc_atomic (false);
+ continue;
+
case ST_OMP_ATOMIC:
- st = parse_omp_atomic ();
+ st = parse_omp_oacc_atomic (true);
continue;
default:
@@ -5024,13 +5035,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;
}
@@ -5568,6 +5572,7 @@ is_oacc (gfc_state_data *sd)
case EXEC_OACC_CACHE:
case EXEC_OACC_ENTER_DATA:
case EXEC_OACC_EXIT_DATA:
+ case EXEC_OACC_ROUTINE:
return true;
default:
diff --git gcc/fortran/parse.h gcc/fortran/parse.h
index 8a1613f..11f1e20 100644
--- gcc/fortran/parse.h
+++ gcc/fortran/parse.h
@@ -49,7 +49,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;
}
ext;
}
diff --git gcc/fortran/resolve.c gcc/fortran/resolve.c
index 316b413..bfcb6be 100644
--- gcc/fortran/resolve.c
+++ gcc/fortran/resolve.c
@@ -9209,6 +9209,9 @@ 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_ATOMIC:
+ case EXEC_OACC_ROUTINE:
+ case EXEC_OACC_DECLARE:
case EXEC_OMP_ATOMIC:
case EXEC_OMP_CRITICAL:
case EXEC_OMP_DISTRIBUTE:
@@ -10385,6 +10388,7 @@ gfc_resolve_code (gfc_code *code, gfc_namespace *ns)
"expression", &code->expr1->where);
break;
+ case EXEC_OACC_ATOMIC:
case EXEC_OACC_PARALLEL_LOOP:
case EXEC_OACC_PARALLEL:
case EXEC_OACC_KERNELS_LOOP:
@@ -10397,6 +10401,7 @@ gfc_resolve_code (gfc_code *code, gfc_namespace *ns)
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 gcc/fortran/st.c gcc/fortran/st.c
index 116af15..78099b8 100644
--- gcc/fortran/st.c
+++ 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_declares (p->ext.oacc_declare);
+ break;
+
case EXEC_OACC_PARALLEL_LOOP:
case EXEC_OACC_PARALLEL:
case EXEC_OACC_KERNELS_LOOP:
@@ -197,6 +202,7 @@ gfc_free_statement (gfc_code *p)
case EXEC_OACC_CACHE:
case EXEC_OACC_ENTER_DATA:
case EXEC_OACC_EXIT_DATA:
+ case EXEC_OACC_ROUTINE:
case EXEC_OMP_CANCEL:
case EXEC_OMP_CANCELLATION_POINT:
case EXEC_OMP_DISTRIBUTE:
@@ -240,6 +246,7 @@ gfc_free_statement (gfc_code *p)
gfc_free_omp_namelist (p->ext.omp_namelist);
break;
+ case EXEC_OACC_ATOMIC:
case EXEC_OMP_ATOMIC:
case EXEC_OMP_BARRIER:
case EXEC_OMP_MASTER:
diff --git gcc/fortran/trans-decl.c gcc/fortran/trans-decl.c
index 4c18920..3dbf128 100644
--- gcc/fortran/trans-decl.c
+++ gcc/fortran/trans-decl.c
@@ -5750,6 +5750,61 @@ is_ieee_module_used (gfc_namespace *ns)
}
+static gfc_code *
+find_end (gfc_code *code)
+{
+ gcc_assert (code);
+
+ if (code->op == EXEC_END_PROCEDURE)
+ return code;
+
+ if (code->next)
+ {
+ if (code->next->op == EXEC_END_PROCEDURE)
+ return code;
+ else
+ return find_end (code->next);
+ }
+
+ return NULL;
+}
+
+
+void
+insert_oacc_declare (gfc_namespace *ns)
+{
+ gfc_code *code;
+
+ code = XCNEW (gfc_code);
+ code->op = EXEC_OACC_DECLARE;
+ code->loc = ns->oacc_declare->where;
+
+ code->ext.oacc_declare = ns->oacc_declare;
+
+ code->block = XCNEW (gfc_code);
+ code->block->op = EXEC_OACC_DECLARE;
+ code->block->loc = ns->oacc_declare->where;
+
+ if (ns->code)
+ {
+ gfc_code *c;
+
+ c = find_end (ns->code);
+ if (c)
+ {
+ code->next = c->next;
+ c->next = NULL;
+ }
+
+ code->block->next = ns->code;
+ code->block->ext.oacc_declare = NULL;
+ }
+
+ ns->code = code;
+ ns->oacc_declare = NULL;
+}
+
+
/* Generate code for a function. */
void
@@ -5887,11 +5942,8 @@ 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);
- }
+ if (ns->oacc_declare)
+ insert_oacc_declare (ns);
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 9642a7d..60e06d2 100644
--- gcc/fortran/trans-openmp.c
+++ gcc/fortran/trans-openmp.c
@@ -563,7 +563,8 @@ gfc_omp_clause_copy_ctor (tree clause, tree dest, tree src)
stmtblock_t block, cond_block;
gcc_assert (OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_FIRSTPRIVATE
- || OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_LINEAR);
+ || OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_LINEAR
+ || OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_REDUCTION);
if ((! GFC_DESCRIPTOR_TYPE_P (type)
|| GFC_TYPE_ARRAY_AKIND (type) != GFC_ARRAY_ALLOCATABLE)
@@ -1725,7 +1726,7 @@ gfc_convert_expr_to_tree (stmtblock_t *block, gfc_expr *expr)
gfc_se se;
tree result;
- gfc_init_se (&se, NULL );
+ gfc_init_se (&se, NULL);
gfc_conv_expr (&se, expr);
gfc_add_block_to_block (block, &se.pre);
result = gfc_evaluate_now (se.expr, block);
@@ -2528,7 +2529,12 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
}
if (clauses->seq)
{
- c = build_omp_clause (where.lb->location, OMP_CLAUSE_ORDERED);
+ c = build_omp_clause (where.lb->location, OMP_CLAUSE_SEQ);
+ omp_clauses = gfc_trans_add_clause (c, omp_clauses);
+ }
+ if (clauses->par_auto)
+ {
+ c = build_omp_clause (where.lb->location, OMP_CLAUSE_AUTO);
omp_clauses = gfc_trans_add_clause (c, omp_clauses);
}
if (clauses->independent)
@@ -2572,6 +2578,21 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
OMP_CLAUSE_VECTOR_LENGTH_EXPR (c) = vector_length_var;
omp_clauses = gfc_trans_add_clause (c, omp_clauses);
}
+ if (clauses->tile_list)
+ {
+ vec<tree, va_gc> *tvec;
+ gfc_expr_list *el;
+
+ vec_alloc (tvec, 4);
+
+ for (el = clauses->tile_list; el; el = el->next)
+ vec_safe_push (tvec, gfc_convert_expr_to_tree (block, el->expr));
+
+ c = build_omp_clause (where.lb->location, OMP_CLAUSE_TILE);
+ OMP_CLAUSE_TILE_LIST (c) = build_tree_list_vec (tvec);
+ omp_clauses = gfc_trans_add_clause (c, omp_clauses);
+ tvec->truncate (0);
+ }
if (clauses->vector)
{
if (clauses->vector_expr)
@@ -2714,7 +2735,7 @@ gfc_trans_oacc_executable_directive (gfc_code *code)
gfc_start_block (&block);
oacc_clauses = gfc_trans_omp_clauses (&block, code->ext.omp_clauses,
code->loc);
- stmt = build1_loc (input_location, construct_code, void_type_node,
+ stmt = build1_loc (input_location, construct_code, void_type_node,
oacc_clauses);
gfc_add_expr_to_block (&block, stmt);
return gfc_finish_block (&block);
@@ -3465,10 +3486,6 @@ gfc_trans_oacc_combined_directive (gfc_code *code)
poplevel (0, 0);
stmt = build2_loc (input_location, construct_code, void_type_node, stmt,
oacc_clauses);
- if (code->op == EXEC_OACC_KERNELS_LOOP)
- OACC_KERNELS_COMBINED (stmt) = 1;
- else
- OACC_PARALLEL_COMBINED (stmt) = 1;
gfc_add_expr_to_block (&block, stmt);
return gfc_finish_block (&block);
}
@@ -4363,13 +4380,30 @@ 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;
+ struct gfc_oacc_declare *d;
+ tree stmt, clauses = NULL_TREE;
+
+ gfc_start_block (&block);
+
+ for (d = code->ext.oacc_declare; d; d = d->next)
+ {
+ tree t;
+
+ t = gfc_trans_omp_clauses (&block, d->clauses, d->clauses->loc);
+
+ if (clauses)
+ OMP_CLAUSE_CHAIN (clauses) = t;
+ else
+ clauses = t;
+ }
+
+ stmt = gfc_trans_omp_code (code->block->next, true);
+ stmt = build2_loc (input_location, OACC_DATA, void_type_node, stmt, clauses);
+ gfc_add_expr_to_block (&block, stmt);
+ return gfc_finish_block (&block);
}
tree
@@ -4395,6 +4429,10 @@ 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_ATOMIC:
+ return gfc_trans_omp_atomic (code);
+ case EXEC_OACC_DECLARE:
+ return gfc_trans_oacc_declare (code);
default:
gcc_unreachable ();
}
diff --git gcc/fortran/trans-stmt.c gcc/fortran/trans-stmt.c
index 53e9bcc..2b988d0 100644
--- gcc/fortran/trans-stmt.c
+++ gcc/fortran/trans-stmt.c
@@ -1588,11 +1588,8 @@ 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);
- }
+ if (ns->oacc_declare)
+ insert_oacc_declare (ns);
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/fortran/trans-stmt.h gcc/fortran/trans-stmt.h
index 2f2a0b3..0ff93c4 100644
--- gcc/fortran/trans-stmt.h
+++ 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 gcc/fortran/trans.c gcc/fortran/trans.c
index 2dabf08..b20ec37 100644
--- gcc/fortran/trans.c
+++ gcc/fortran/trans.c
@@ -1932,6 +1932,7 @@ trans_code (gfc_code * code, tree cond)
res = gfc_trans_omp_directive (code);
break;
+ case EXEC_OACC_ATOMIC:
case EXEC_OACC_CACHE:
case EXEC_OACC_WAIT:
case EXEC_OACC_UPDATE:
@@ -1944,6 +1945,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;
Grüße,
Thomas
[-- Attachment #2: Type: application/pgp-signature, Size: 472 bytes --]
^ permalink raw reply [flat|nested] 4+ messages in thread
end of thread, other threads:[~2015-05-06 12:48 UTC | newest]
Thread overview: 4+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2015-05-05 10:01 Next set of OpenACC changes: Fortran Tobias Burnus
2015-05-06 12:48 ` James Norris
-- strict thread matches above, loose matches on Subject: below --
2015-05-05 8:54 Next set of OpenACC changes Thomas Schwinge
2015-05-05 8:59 ` Next set of OpenACC changes: Fortran Thomas Schwinge
2015-05-05 10:42 ` Bernhard Reutner-Fischer
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).