* FWD: Re: OpenACC subarray specifications in the GCC Fortran front end
[not found] ` <53763254.1000402@samsung.com>
@ 2014-05-22 7:32 ` Ilmir Usmanov
2014-07-11 10:11 ` Thomas Schwinge
0 siblings, 1 reply; 12+ messages in thread
From: Ilmir Usmanov @ 2014-05-22 7:32 UTC (permalink / raw)
To: Thomas Schwinge, Ilmir Usmanov; +Cc: Cesar Philippidis, gcc-patches
[-- Attachment #1: Type: text/plain, Size: 1347 bytes --]
On 16.05.2014 19:44, Ilmir Usmanov wrote:
> Hi Thomas!
>
> On 16.05.2014 19:12, Thomas Schwinge wrote:
>> Hi Ilmir!
>>
>> You recently indicated that you have already begun implementing OpenACC
>> subarray specifications in the GCC Fortran front end, but have not
>> been/are not currently able to complete that. Would you be willing to
>> share your WIP patch with Cesar, who is now working on this, so that he
>> doesn't have to duplicate your work?
> Sure! I'm glad to know that my work won't go directly to trash.
>
> BTW, another patch is still pending:
> http://gcc.gnu.org/ml/gcc-patches/2014-04/msg00027.html
>
> Cesar,
>
> You can find the patch in attachment.
>
> I started to implement sub-arrays in gfortran by implementing OpenMP
> 4.0 target map clause. This clause was already implemented in C/C++
> FEs, so I could check the behavior. I don't know whether it's already
> implemented in gfortran or not.
>
> To represent OpenMP array sections (or OpenACC subarrays) I used
> gfc_expr.
>
> After implementing OpenMP target map clauses I was going to use it to
> represent OpenACC data clauses, just as Thomas recommended in his
> mail: http://gcc.gnu.org/ml/gcc-patches/2014-01/msg02040.html
>
> I hope this will be useful for you. If you will have any question feel
> free to ask.
>>
>> Grüße,
>> Thomas
--
Ilmir.
[-- Attachment #2: 0001-Subarrays.patch --]
[-- Type: text/x-diff, Size: 41901 bytes --]
From 5ba154b9af6499f567172b92f9abcf362584be58 Mon Sep 17 00:00:00 2001
From: Ilmir Usmanov <i.usmanov@samsung.com>
Date: Tue, 8 Apr 2014 17:08:02 +0400
Subject: [PATCH] Subarrays
---
gcc/fortran/dump-parse-tree.c | 55 +++--
gcc/fortran/gfortran.h | 21 +-
gcc/fortran/match.h | 1 +
gcc/fortran/openmp.c | 292 +++++++++++++++++++++++---
gcc/fortran/parse.c | 17 +-
gcc/fortran/resolve.c | 3 +
gcc/fortran/st.c | 1 +
gcc/fortran/trans-openmp.c | 185 +++++++++++++++-
gcc/fortran/trans.c | 1 +
gcc/testsuite/gfortran.dg/goacc/subarrays.f95 | 36 ++++
gcc/testsuite/gfortran.dg/gomp/map-1.f90 | 101 +++++++++
gcc/testsuite/gfortran.dg/gomp/target-1.f90 | 21 ++
12 files changed, 674 insertions(+), 60 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/goacc/subarrays.f95
create mode 100644 gcc/testsuite/gfortran.dg/gomp/map-1.f90
create mode 100644 gcc/testsuite/gfortran.dg/gomp/target-1.f90
diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c
index b6679ab..bdc30c2 100644
--- a/gcc/fortran/dump-parse-tree.c
+++ b/gcc/fortran/dump-parse-tree.c
@@ -1023,6 +1023,17 @@ show_namelist (gfc_namelist *n)
fprintf (dumpfile, "%s", n->sym->name);
}
+static void
+show_expr_list (gfc_expr_list *el)
+{
+ for (; el->next; el = el->next)
+ {
+ show_expr (el->expr);
+ fputc (',', dumpfile);
+ }
+ show_expr (el->expr);
+}
+
/* Show OpenMP or OpenACC clauses. */
@@ -1043,6 +1054,12 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses)
show_expr (omp_clauses->final_expr);
fputc (')', dumpfile);
}
+ if (omp_clauses->device_id)
+ {
+ fputs (" DEVICE(", dumpfile);
+ show_expr (omp_clauses->device_id);
+ fputc (')', dumpfile);
+ }
if (omp_clauses->num_threads)
{
fputs (" NUM_THREADS(", dumpfile);
@@ -1148,28 +1165,35 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses)
}
fprintf (dumpfile, " DEFAULT(%s)", type);
}
- if (omp_clauses->tile_list)
+ for (int kind = 0; kind < OMP_MAP_LIST_LAST; kind++)
{
- gfc_expr_list *list;
- fputs (" TILE(", dumpfile);
- for (list = omp_clauses->tile_list; list; list = list->next)
+ const char *type;
+ if (omp_clauses->map_lists[kind] == NULL)
+ continue;
+
+ switch (kind)
{
- show_expr (list->expr);
- if (list->next)
- fputs (", ", dumpfile);
+ case OMP_MAP_LIST_ALLOC: type = "ALLOC"; break;
+ case OMP_MAP_LIST_TO: type = "TO"; break;
+ case OMP_MAP_LIST_FROM: type = "FROM"; break;
+ case OMP_MAP_LIST_TOFROM: type = "TOFROM"; break;
+ default:
+ gcc_unreachable ();
}
+ fprintf (dumpfile, " MAP(%s:", type);
+ show_expr_list (omp_clauses->map_lists[kind]);
+ fputc (')', dumpfile);
+ }
+ if (omp_clauses->tile_list)
+ {
+ fputs (" TILE(", dumpfile);
+ show_expr_list (omp_clauses->tile_list);
fputc (')', dumpfile);
}
if (omp_clauses->wait_list)
{
- gfc_expr_list *list;
fputs (" WAIT(", dumpfile);
- for (list = omp_clauses->wait_list; list; list = list->next)
- {
- show_expr (list->expr);
- if (list->next)
- fputs (", ", dumpfile);
- }
+ show_expr_list (omp_clauses->wait_list);
fputc (')', dumpfile);
}
if (omp_clauses->seq)
@@ -1286,6 +1310,7 @@ show_omp_node (int level, gfc_code *c)
case EXEC_OMP_PARALLEL_WORKSHARE: name = "PARALLEL WORKSHARE"; break;
case EXEC_OMP_SECTIONS: name = "SECTIONS"; break;
case EXEC_OMP_SINGLE: name = "SINGLE"; break;
+ case EXEC_OMP_TARGET: name = "TARGET"; break;
case EXEC_OMP_TASK: name = "TASK"; break;
case EXEC_OMP_TASKWAIT: name = "TASKWAIT"; break;
case EXEC_OMP_TASKYIELD: name = "TASKYIELD"; break;
@@ -1316,6 +1341,7 @@ show_omp_node (int level, gfc_code *c)
case EXEC_OMP_SINGLE:
case EXEC_OMP_WORKSHARE:
case EXEC_OMP_PARALLEL_WORKSHARE:
+ case EXEC_OMP_TARGET:
case EXEC_OMP_TASK:
omp_clauses = c->ext.omp_clauses;
break;
@@ -2368,6 +2394,7 @@ show_code_node (int level, gfc_code *c)
case EXEC_OMP_PARALLEL_WORKSHARE:
case EXEC_OMP_SECTIONS:
case EXEC_OMP_SINGLE:
+ case EXEC_OMP_TARGET:
case EXEC_OMP_TASK:
case EXEC_OMP_TASKWAIT:
case EXEC_OMP_TASKYIELD:
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 69e77b7..0d92f8b 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -217,6 +217,7 @@ typedef enum
ST_OMP_PARALLEL, ST_OMP_PARALLEL_DO, ST_OMP_PARALLEL_SECTIONS,
ST_OMP_PARALLEL_WORKSHARE, ST_OMP_SECTIONS, ST_OMP_SECTION, ST_OMP_SINGLE,
ST_OMP_THREADPRIVATE, ST_OMP_WORKSHARE, ST_OMP_TASK, ST_OMP_END_TASK,
+ ST_OMP_TARGET, ST_OMP_END_TARGET,
ST_OMP_TASKWAIT, ST_OMP_TASKYIELD, ST_PROCEDURE, ST_GENERIC, ST_CRITICAL,
ST_END_CRITICAL, ST_GET_FCN_CHARACTERISTICS, ST_LOCK, ST_UNLOCK, ST_NONE
}
@@ -1084,6 +1085,22 @@ enum
OMP_LIST_NUM
};
+/* OpenMP 4.0: map clause kind.
+ OpenACC 2.0: data clauses kind. */
+enum gfc_omp_clause_map_kind
+{
+ /* If not already present, allocate. */
+ OMP_MAP_LIST_ALLOC,
+ /* ..., and copy to device. */
+ OMP_MAP_LIST_TO,
+ /* ..., and copy from device. */
+ OMP_MAP_LIST_FROM,
+ /* ..., and copy to and from device. */
+ OMP_MAP_LIST_TOFROM,
+ /* End marker. */
+ OMP_MAP_LIST_LAST
+};
+
/* Because a symbol can belong to multiple namelists, they must be
linked externally to the symbol itself. */
@@ -1112,8 +1129,10 @@ typedef struct gfc_omp_clauses
struct gfc_expr *final_expr;
struct gfc_expr *num_threads;
gfc_namelist *lists[OMP_LIST_NUM];
+ gfc_expr_list *map_lists[OMP_MAP_LIST_LAST];
enum gfc_omp_sched_kind sched_kind;
struct gfc_expr *chunk_size;
+ struct gfc_expr *device_id;
enum gfc_omp_default_sharing default_sharing;
int collapse;
bool nowait, ordered, untied, mergeable;
@@ -2170,7 +2189,7 @@ typedef enum
EXEC_OMP_PARALLEL_SECTIONS, EXEC_OMP_PARALLEL_WORKSHARE,
EXEC_OMP_SECTIONS, EXEC_OMP_SINGLE, EXEC_OMP_WORKSHARE,
EXEC_OMP_ATOMIC, EXEC_OMP_BARRIER, EXEC_OMP_END_NOWAIT,
- EXEC_OMP_END_SINGLE, EXEC_OMP_TASK, EXEC_OMP_TASKWAIT,
+ EXEC_OMP_END_SINGLE, EXEC_OMP_TASK, EXEC_OMP_TARGET, EXEC_OMP_TASKWAIT,
EXEC_OMP_TASKYIELD
}
gfc_exec_op;
diff --git a/gcc/fortran/match.h b/gcc/fortran/match.h
index 80ba44f..6605617 100644
--- a/gcc/fortran/match.h
+++ b/gcc/fortran/match.h
@@ -152,6 +152,7 @@ match gfc_match_omp_parallel_sections (void);
match gfc_match_omp_parallel_workshare (void);
match gfc_match_omp_sections (void);
match gfc_match_omp_single (void);
+match gfc_match_omp_target (void);
match gfc_match_omp_task (void);
match gfc_match_omp_taskwait (void);
match gfc_match_omp_taskyield (void);
diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index 447faf8..fbba82f 100644
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -69,6 +69,7 @@ gfc_free_omp_clauses (gfc_omp_clauses *c)
gfc_free_expr (c->final_expr);
gfc_free_expr (c->num_threads);
gfc_free_expr (c->chunk_size);
+ gfc_free_expr (c->device_id);
gfc_free_expr (c->async_expr);
gfc_free_expr (c->gang_expr);
gfc_free_expr (c->worker_expr);
@@ -81,6 +82,9 @@ gfc_free_omp_clauses (gfc_omp_clauses *c)
for (i = 0; i < OMP_LIST_NUM; i++)
gfc_free_namelist (c->lists[i]);
+ for (i = 0; i < OMP_MAP_LIST_LAST; i++)
+ gfc_free_expr_list (c->map_lists[i]);
+
gfc_free_expr_list (c->wait_list);
gfc_free_expr_list (c->tile_list);
@@ -196,7 +200,7 @@ cleanup:
}
static match
-match_oacc_expr_list (const char *str, gfc_expr_list **list, bool allow_asterisk)
+match_omp_expr_list (const char *str, gfc_expr_list **list, bool allow_asterisk)
{
gfc_expr_list *head, *tail, *p;
locus old_loc;
@@ -248,7 +252,7 @@ match_oacc_expr_list (const char *str, gfc_expr_list **list, bool allow_asterisk
return MATCH_YES;
syntax:
- gfc_error ("Syntax error in OpenACC expression list at %C");
+ gfc_error ("Syntax error in expression list at %C");
cleanup:
gfc_free_expr_list (head);
@@ -294,33 +298,37 @@ match_oacc_clause_gang (gfc_omp_clauses *cp)
#define OMP_CLAUSE_MERGEABLE (1 << 15)
/* OpenACC 2.0 clauses. */
-#define OMP_CLAUSE_ASYNC (1 << 16)
-#define OMP_CLAUSE_NUM_GANGS (1 << 17)
-#define OMP_CLAUSE_NUM_WORKERS (1 << 18)
-#define OMP_CLAUSE_VECTOR_LENGTH (1 << 19)
-#define OMP_CLAUSE_COPY (1 << 20)
-#define OMP_CLAUSE_COPYOUT (1 << 21)
-#define OMP_CLAUSE_CREATE (1 << 22)
-#define OMP_CLAUSE_PRESENT (1 << 23)
-#define OMP_CLAUSE_PRESENT_OR_COPY (1 << 24)
-#define OMP_CLAUSE_PRESENT_OR_COPYIN (1 << 25)
-#define OMP_CLAUSE_PRESENT_OR_COPYOUT (1 << 26)
-#define OMP_CLAUSE_PRESENT_OR_CREATE (1 << 27)
-#define OMP_CLAUSE_DEVICEPTR (1 << 28)
-#define OMP_CLAUSE_GANG (1 << 29)
-#define OMP_CLAUSE_WORKER (1 << 30)
-#define OMP_CLAUSE_VECTOR (1 << 31)
-#define OMP_CLAUSE_SEQ (1LL << 32)
-#define OMP_CLAUSE_INDEPENDENT (1LL << 33)
-#define OMP_CLAUSE_USE_DEVICE (1LL << 34)
-#define OMP_CLAUSE_DEVICE_RESIDENT (1LL << 35)
-#define OMP_CLAUSE_HOST (1LL << 36)
-#define OMP_CLAUSE_DEVICE (1LL << 37)
-#define OMP_CLAUSE_OACC_COPYIN (1LL << 38)
-#define OMP_CLAUSE_WAIT (1LL << 39)
-#define OMP_CLAUSE_DELETE (1LL << 40)
-#define OMP_CLAUSE_AUTO (1LL << 41)
-#define OMP_CLAUSE_TILE (1LL << 42)
+#define OMP_CLAUSE_ASYNC (1 << 16)
+#define OMP_CLAUSE_NUM_GANGS (1 << 17)
+#define OMP_CLAUSE_NUM_WORKERS (1 << 18)
+#define OMP_CLAUSE_VECTOR_LENGTH (1 << 19)
+#define OMP_CLAUSE_COPY (1 << 20)
+#define OMP_CLAUSE_COPYOUT (1 << 21)
+#define OMP_CLAUSE_CREATE (1 << 22)
+#define OMP_CLAUSE_PRESENT (1 << 23)
+#define OMP_CLAUSE_PRESENT_OR_COPY (1 << 24)
+#define OMP_CLAUSE_PRESENT_OR_COPYIN (1 << 25)
+#define OMP_CLAUSE_PRESENT_OR_COPYOUT (1 << 26)
+#define OMP_CLAUSE_PRESENT_OR_CREATE (1 << 27)
+#define OMP_CLAUSE_DEVICEPTR (1 << 28)
+#define OMP_CLAUSE_GANG (1 << 29)
+#define OMP_CLAUSE_WORKER (1 << 30)
+#define OMP_CLAUSE_VECTOR (1 << 31)
+#define OMP_CLAUSE_SEQ (1LL << 32)
+#define OMP_CLAUSE_INDEPENDENT (1LL << 33)
+#define OMP_CLAUSE_USE_DEVICE (1LL << 34)
+#define OMP_CLAUSE_DEVICE_RESIDENT (1LL << 35)
+#define OMP_CLAUSE_HOST (1LL << 36)
+#define OMP_CLAUSE_OACC_DEVICE (1LL << 37)
+#define OMP_CLAUSE_OACC_COPYIN (1LL << 38)
+#define OMP_CLAUSE_WAIT (1LL << 39)
+#define OMP_CLAUSE_DELETE (1LL << 40)
+#define OMP_CLAUSE_AUTO (1LL << 41)
+#define OMP_CLAUSE_TILE (1LL << 42)
+
+/* OpenMP 4.0 clauses. */
+#define OMP_CLAUSE_DEVICE (1LL << 43)
+#define OMP_CLAUSE_MAP (1LL << 44)
/* Match OpenMP and OpenACC directive clauses. MASK is a bitmask of
clauses that are allowed for a particular directive. */
@@ -393,6 +401,9 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, long long mask)
if ((mask & OMP_CLAUSE_FINAL) && c->final_expr == NULL
&& gfc_match ("final ( %e )", &c->final_expr) == MATCH_YES)
continue;
+ if ((mask & OMP_CLAUSE_DEVICE) && c->device_id == NULL
+ && gfc_match ("device ( %e )", &c->device_id) == MATCH_YES)
+ continue;
if ((mask & OMP_CLAUSE_NUM_THREADS) && c->num_threads == NULL
&& gfc_match ("num_threads ( %e )", &c->num_threads) == MATCH_YES)
continue;
@@ -535,13 +546,13 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, long long mask)
&c->lists[OMP_LIST_HOST], true)
== MATCH_YES)
continue;
- if ((mask & OMP_CLAUSE_DEVICE)
+ if ((mask & OMP_CLAUSE_OACC_DEVICE)
&& gfc_match_omp_variable_list ("device (",
&c->lists[OMP_LIST_DEVICE], true)
== MATCH_YES)
continue;
if ((mask & OMP_CLAUSE_TILE)
- && match_oacc_expr_list ("tile (", &c->tile_list, true) == MATCH_YES)
+ && match_omp_expr_list ("tile (", &c->tile_list, true) == MATCH_YES)
continue;
if ((mask & OMP_CLAUSE_SEQ) && !c->seq
&& gfc_match ("seq") == MATCH_YES)
@@ -568,7 +579,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, long long mask)
&& gfc_match ("wait") == MATCH_YES)
{
c->wait = true;
- match_oacc_expr_list (" (", &c->wait_list, false);
+ match_omp_expr_list (" (", &c->wait_list, false);
continue;
}
old_loc = gfc_current_locus;
@@ -700,6 +711,23 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, long long mask)
else
gfc_current_locus = old_loc;
}
+ old_loc = gfc_current_locus;
+ if ((mask & OMP_CLAUSE_MAP)
+ && gfc_match ("map ( ") == MATCH_YES)
+ {
+ enum gfc_omp_clause_map_kind kind = OMP_MAP_LIST_TOFROM;
+ if (gfc_match ("alloc : ") == MATCH_YES)
+ kind = OMP_MAP_LIST_ALLOC;
+ if (gfc_match ("to : ") == MATCH_YES)
+ kind = OMP_MAP_LIST_TO;
+ if (gfc_match ("from : ") == MATCH_YES)
+ kind = OMP_MAP_LIST_FROM;
+ if (gfc_match ("tofrom : ") == MATCH_YES)
+ kind = OMP_MAP_LIST_TOFROM;
+ if (match_omp_expr_list ("", &c->map_lists[kind], false) == MATCH_YES)
+ continue;
+ gfc_current_locus = old_loc;
+ }
if ((mask & OMP_CLAUSE_ORDERED) && !c->ordered
&& gfc_match ("ordered") == MATCH_YES)
{
@@ -794,7 +822,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, long long 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 | OMP_CLAUSE_DEVICE)
+ (OMP_CLAUSE_IF | OMP_CLAUSE_ASYNC | OMP_CLAUSE_HOST | OMP_CLAUSE_OACC_DEVICE)
#define OACC_ENTER_DATA_CLAUSES \
(OMP_CLAUSE_IF | OMP_CLAUSE_ASYNC | OMP_CLAUSE_WAIT | OMP_CLAUSE_OACC_COPYIN \
| OMP_CLAUSE_CREATE | OMP_CLAUSE_PRESENT_OR_COPYIN \
@@ -814,6 +842,9 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, long long mask)
#define OMP_SECTIONS_CLAUSES \
(OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE \
| OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_REDUCTION)
+#define OMP_TARGET_CLAUSES \
+ ( OMP_CLAUSE_IF | OMP_CLAUSE_DEVICE | OMP_CLAUSE_MAP)
+#define OMP_TARGET_DATA_CLAUSES OMP_TARGET_CLAUSES
#define OMP_TASK_CLAUSES \
(OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE | OMP_CLAUSE_SHARED \
| OMP_CLAUSE_IF | OMP_CLAUSE_DEFAULT | OMP_CLAUSE_UNTIED \
@@ -1013,6 +1044,18 @@ gfc_match_omp_parallel (void)
match
+gfc_match_omp_target (void)
+{
+ gfc_omp_clauses *c;
+ if (gfc_match_omp_clauses (&c, OMP_TARGET_CLAUSES) != MATCH_YES)
+ return MATCH_ERROR;
+ new_st.op = EXEC_OMP_TARGET;
+ new_st.ext.omp_clauses = c;
+ return MATCH_YES;
+}
+
+
+match
gfc_match_omp_task (void)
{
gfc_omp_clauses *c;
@@ -1352,6 +1395,23 @@ oacc_is_loop (gfc_code *code)
|| code->op == EXEC_OACC_LOOP;
}
+static const char*
+map_list_to_ascii (gfc_code *code, int list)
+{
+ gcc_assert (code->op == EXEC_OMP_TARGET);
+
+ switch (list)
+ {
+ case OMP_MAP_LIST_ALLOC:
+ case OMP_MAP_LIST_TO:
+ case OMP_MAP_LIST_FROM:
+ case OMP_MAP_LIST_TOFROM:
+ return ("MAP");
+ default:
+ gcc_unreachable ();
+ }
+}
+
static void
resolve_oacc_scalar_int_expr (gfc_expr *expr, const char *clause)
{
@@ -1438,6 +1498,31 @@ resolve_oacc_data_clauses (gfc_symbol *sym, locus loc, const char *name)
}
static void
+resolve_omp_map_clauses (gfc_symbol *sym, locus loc)
+{
+ const char *name = "MAP";
+ if (sym->ts.type == BT_DERIVED && sym->attr.allocatable)
+ gfc_error ("ALLOCATABLE object '%s' of derived type in %s clause at %L",
+ sym->name, name, &loc);
+ if ((sym->ts.type == BT_ASSUMED && sym->attr.allocatable)
+ || (sym->ts.type == BT_CLASS && CLASS_DATA (sym)
+ && CLASS_DATA (sym)->attr.allocatable))
+ gfc_error ("ALLOCATABLE object '%s' of polymorphic type "
+ "in %s clause at %L", sym->name, name, &loc);
+ check_symbol_not_pointer (sym, loc, name);
+ if (sym->as && sym->as->type == AS_ASSUMED_RANK)
+ gfc_error ("Assumed rank array '%s' 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 '%s' in %s clause at %L",
+ sym->name, name, &loc);
+ if (sym->attr.threadprivate)
+ gfc_error ("Threadprivate variable '%s' is not allowed in %s clause at %L",
+ sym->name, name, &loc);
+}
+
+static void
resolve_oacc_deviceptr_clause (gfc_symbol *sym, locus loc, const char *name)
{
if (sym->attr.pointer
@@ -1466,6 +1551,58 @@ resolve_oacc_deviceptr_clause (gfc_symbol *sym, locus loc, const char *name)
check_array_not_assumed (sym, loc, name);
}
+static void
+resolve_omp_array_section (gfc_array_ref *ar, gfc_code *code,
+ const char *clause, const char *sym_name,
+ bool component)
+{
+ int i;
+ const char *str;
+
+ switch (code->op)
+ {
+ case EXEC_OACC_KERNELS:
+ case EXEC_OACC_PARALLEL:
+ case EXEC_OACC_DATA:
+ case EXEC_OACC_CACHE:
+ str = "OpenACC subarray";
+ break;
+ default:
+ str = "OpenMP array section";
+ }
+ if (ar->type == AR_UNKNOWN)
+ {
+ gfc_error ("Expression in %s clause is not %s of "
+ "array '%s' at %L", clause, str, sym_name, &code->loc);
+ return;
+ }
+ if (component && ar->type == AR_FULL)
+ {
+ gfc_error ("Component of derived type '%s' in %s clause must be single "
+ "array element or %s at %L", sym_name, clause, str,
+ &code->loc);
+ return;
+ }
+ for (i = 0; i < ar->as->rank; i++)
+ {
+ gfc_expr *start = ar->start[i];
+ gfc_expr *end = ar->end[i];
+ if (ar->stride[i])
+ {
+ gfc_error ("Stride is not allowed in %s at %L", str, &ar->c_where[i]);
+ continue;
+ }
+ /* Since stride is not allowed, lower bound cannot be greater
+ than upper one. */
+ if (start && end
+ && mpz_cmp (start->value.integer, end->value.integer) > 0)
+ gfc_error ("Lower bound of %s in greater than "
+ "upper (%ld > %ld) at %L", str,
+ mpz_get_si (start->value.integer),
+ mpz_get_si (end->value.integer), &ar->c_where[i]);
+ }
+}
+
/* OpenMP directive resolving routines. */
static void
@@ -1501,6 +1638,8 @@ resolve_omp_clauses (gfc_code *code)
gfc_error ("FINAL clause at %L requires a scalar LOGICAL expression",
&expr->where);
}
+ if (omp_clauses->device_id)
+ resolve_oacc_scalar_int_expr (omp_clauses->device_id, "DEVICE");
if (omp_clauses->num_threads)
{
gfc_expr *expr = omp_clauses->num_threads;
@@ -1598,6 +1737,90 @@ resolve_omp_clauses (gfc_code *code)
else
n->sym->mark = 1;
}
+
+ for (list = 0; list < OMP_MAP_LIST_LAST; list++)
+ for (el = omp_clauses->map_lists[list]; el; el = el->next)
+ {
+ gfc_ref *ref;
+ gfc_symbol *sym;
+ bool component = false;
+
+ gfc_resolve_expr (el->expr);
+
+ if (el->expr->expr_type != EXPR_VARIABLE)
+ {
+ gfc_error ("Expression in %s clause is not a variable at %L",
+ map_list_to_ascii (code, list), &code->loc);
+ continue;
+ }
+
+ sym = el->expr->symtree->n.sym;
+ sym->mark = 0;
+ if (sym->attr.flavor != FL_VARIABLE && !sym->attr.proc_pointer)
+ {
+ gfc_error ("Object '%s' is not a variable at %L", sym->name,
+ &code->loc);
+ continue;
+ }
+
+ if (el->expr->ts.type == BT_CLASS)
+ {
+ gfc_error ("CLASS object '%s' cannot appear in %s clause at %L",
+ sym->name, map_list_to_ascii (code, list), &code->loc);
+ continue;
+ }
+
+ if (el->expr->rank != 0 && !gfc_is_simply_contiguous(el->expr, false))
+ {
+ gfc_error ("Object %s in %s clause is not contiguous at %L",
+ sym->name, map_list_to_ascii (code, list), &code->loc);
+ continue;
+ }
+
+ for (ref = el->expr->ref; ref; ref = ref->next)
+ if (ref->type == REF_ARRAY)
+ resolve_omp_array_section (&ref->u.ar, code,
+ map_list_to_ascii (code, list),
+ sym->name, component);
+ else if (ref->type == REF_COMPONENT)
+ {
+ if (!ref->u.c.component->as)
+ {
+ gfc_error ("Component '%s' of derived type in %s clause must "
+ "be single array element or array section at %L",
+ ref->u.c.component->name,
+ map_list_to_ascii (code, list), &code->loc);
+ continue;
+ }
+ component = true;
+ }
+ else if (ref->type == REF_SUBSTRING)
+ gfc_error ("Substrings are not allowed in array section in %s "
+ "clause at %L", map_list_to_ascii (code, list),
+ &code->loc);
+ else
+ gcc_unreachable ();
+ }
+
+
+ for (list = 0; list < OMP_MAP_LIST_LAST; list++)
+ for (el = omp_clauses->map_lists[list]; el; el = el->next)
+ {
+ gfc_symbol *sym;
+
+ if (el->expr->expr_type != EXPR_VARIABLE)
+ continue;
+
+ sym = el->expr->symtree->n.sym;
+ if (sym->mark)
+ gfc_error ("Symbol '%s' present on multiple clauses at %L",
+ sym->name, &code->loc);
+ else
+ sym->mark = 1;
+
+ resolve_omp_map_clauses (sym, code->loc);
+ }
+
for (list = 0; list < OMP_LIST_NUM; list++)
if ((n = omp_clauses->lists[list]) != NULL)
{
@@ -2492,6 +2715,8 @@ switch (code->op)
return ST_OMP_MASTER;
case EXEC_OMP_SINGLE:
return ST_OMP_SINGLE;
+ case EXEC_OMP_TARGET:
+ return ST_OMP_TARGET;
case EXEC_OMP_TASK:
return ST_OMP_TASK;
case EXEC_OMP_WORKSHARE:
@@ -2934,6 +3159,7 @@ gfc_resolve_omp_directive (gfc_code *code, gfc_namespace *ns ATTRIBUTE_UNUSED)
case EXEC_OMP_PARALLEL_SECTIONS:
case EXEC_OMP_SECTIONS:
case EXEC_OMP_SINGLE:
+ case EXEC_OMP_TARGET:
case EXEC_OMP_TASK:
if (code->ext.omp_clauses)
resolve_omp_clauses (code);
diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index 65613d2..3434ceb 100644
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -674,6 +674,7 @@ decode_omp_directive (void)
match ("end parallel", gfc_match_omp_eos, ST_OMP_END_PARALLEL);
match ("end sections", gfc_match_omp_end_nowait, ST_OMP_END_SECTIONS);
match ("end single", gfc_match_omp_end_single, ST_OMP_END_SINGLE);
+ match ("end target", gfc_match_omp_eos, ST_OMP_END_TARGET);
match ("end task", gfc_match_omp_eos, ST_OMP_END_TASK);
match ("end workshare", gfc_match_omp_end_nowait,
ST_OMP_END_WORKSHARE);
@@ -701,6 +702,7 @@ decode_omp_directive (void)
match ("single", gfc_match_omp_single, ST_OMP_SINGLE);
break;
case 't':
+ match ("target", gfc_match_omp_target, ST_OMP_TARGET);
match ("task", gfc_match_omp_task, ST_OMP_TASK);
match ("taskwait", gfc_match_omp_taskwait, ST_OMP_TASKWAIT);
match ("taskyield", gfc_match_omp_taskyield, ST_OMP_TASKYIELD);
@@ -1187,9 +1189,10 @@ next_statement (void)
case ST_OMP_CRITICAL: case ST_OMP_MASTER: case ST_OMP_SINGLE: \
case ST_OMP_DO: case ST_OMP_PARALLEL_DO: case ST_OMP_ATOMIC: \
case ST_OMP_WORKSHARE: case ST_OMP_PARALLEL_WORKSHARE: \
- case ST_OMP_TASK: case ST_CRITICAL: \
+ case ST_OMP_TARGET: case ST_OMP_TASK: 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
/* Declaration statements */
@@ -1788,6 +1791,9 @@ gfc_ascii_statement (gfc_statement st)
case ST_OMP_END_SINGLE:
p = "!$OMP END SINGLE";
break;
+ case ST_OMP_END_TARGET:
+ p = "!$OMP END TARGET";
+ break;
case ST_OMP_END_TASK:
p = "!$OMP END TASK";
break;
@@ -1824,6 +1830,9 @@ gfc_ascii_statement (gfc_statement st)
case ST_OMP_SINGLE:
p = "!$OMP SINGLE";
break;
+ case ST_OMP_TARGET:
+ p = "!$OMP TARGET";
+ break;
case ST_OMP_TASK:
p = "!$OMP TASK";
break;
@@ -4047,6 +4056,9 @@ parse_omp_structured_block (gfc_statement omp_st, bool workshare_stmts_only)
case ST_OMP_SINGLE:
omp_end_st = ST_OMP_END_SINGLE;
break;
+ case ST_OMP_TARGET:
+ omp_end_st = ST_OMP_END_TARGET;
+ break;
case ST_OMP_TASK:
omp_end_st = ST_OMP_END_TASK;
break;
@@ -4296,6 +4308,7 @@ parse_executable (gfc_statement st)
case ST_OMP_CRITICAL:
case ST_OMP_MASTER:
case ST_OMP_SINGLE:
+ case ST_OMP_TARGET:
case ST_OMP_TASK:
parse_omp_structured_block (st, false);
break;
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 9277cd4..745ecdc 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -9005,6 +9005,7 @@ gfc_resolve_blocks (gfc_code *b, gfc_namespace *ns)
case EXEC_OMP_PARALLEL_WORKSHARE:
case EXEC_OMP_SECTIONS:
case EXEC_OMP_SINGLE:
+ case EXEC_OMP_TARGET:
case EXEC_OMP_TASK:
case EXEC_OMP_TASKWAIT:
case EXEC_OMP_TASKYIELD:
@@ -9760,6 +9761,7 @@ resolve_code (gfc_code *code, gfc_namespace *ns)
case EXEC_OMP_PARALLEL:
case EXEC_OMP_PARALLEL_DO:
case EXEC_OMP_PARALLEL_SECTIONS:
+ case EXEC_OMP_TARGET:
case EXEC_OMP_TASK:
omp_workshare_save = omp_workshare_flag;
omp_workshare_flag = 0;
@@ -10112,6 +10114,7 @@ resolve_code (gfc_code *code, gfc_namespace *ns)
case EXEC_OMP_PARALLEL_DO:
case EXEC_OMP_PARALLEL_SECTIONS:
case EXEC_OMP_PARALLEL_WORKSHARE:
+ case EXEC_OMP_TARGET:
case EXEC_OMP_TASK:
omp_workshare_save = omp_workshare_flag;
omp_workshare_flag = 0;
diff --git a/gcc/fortran/st.c b/gcc/fortran/st.c
index b582efe..77d58f1 100644
--- a/gcc/fortran/st.c
+++ b/gcc/fortran/st.c
@@ -204,6 +204,7 @@ gfc_free_statement (gfc_code *p)
case EXEC_OMP_PARALLEL_SECTIONS:
case EXEC_OMP_SECTIONS:
case EXEC_OMP_SINGLE:
+ case EXEC_OMP_TARGET:
case EXEC_OMP_TASK:
case EXEC_OMP_WORKSHARE:
case EXEC_OMP_PARALLEL_WORKSHARE:
diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
index 29364f4..0933529 100644
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -768,7 +768,7 @@ gfc_trans_omp_reduction_list (gfc_namelist *namelist, tree list,
static tree
gfc_trans_omp_map_clause_list (enum omp_clause_map_kind kind,
- gfc_namelist *namelist, tree list)
+ gfc_namelist *namelist, tree list, locus where)
{
for (; namelist != NULL; namelist = namelist->next)
if (namelist->sym->attr.referenced)
@@ -776,7 +776,7 @@ gfc_trans_omp_map_clause_list (enum omp_clause_map_kind kind,
tree t = gfc_trans_omp_variable (namelist->sym);
if (t != error_mark_node)
{
- tree node = build_omp_clause (input_location, OMP_CLAUSE_MAP);
+ tree node = build_omp_clause (where.lb->location, OMP_CLAUSE_MAP);
OMP_CLAUSE_DECL (node) = t;
OMP_CLAUSE_MAP_KIND (node) = kind;
list = gfc_trans_add_clause (node, list);
@@ -791,7 +791,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);
@@ -801,6 +801,22 @@ gfc_convert_expr_to_tree (stmtblock_t *block, gfc_expr *expr)
}
static tree
+gfc_convert_array_section_to_array_ref (gfc_array_ref ar, gfc_expr *expr,
+ tree t)
+{
+ gfc_se se;
+ int i;
+ for (i = 0; i < ar.dimen; i++)
+ if (ar.start[i] == NULL)
+ ar.start[i] = ar.as->lower[i];
+ ar.type = AR_ELEMENT;
+ gfc_init_se (&se, NULL);
+ se.expr = t;
+ gfc_conv_array_ref (&se, &ar, expr, &expr->where);
+ return se.expr;
+}
+
+static tree
gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
locus where)
{
@@ -910,7 +926,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
default:
gcc_unreachable ();
}
- omp_clauses = gfc_trans_omp_map_clause_list (kind, n, omp_clauses);
+ omp_clauses = gfc_trans_omp_map_clause_list (kind, n, omp_clauses, where);
continue;
}
switch (list)
@@ -987,6 +1003,15 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
omp_clauses = gfc_trans_add_clause (c, omp_clauses);
}
+ if (clauses->device_id)
+ {
+ tree device_var =
+ gfc_convert_expr_to_tree (block, clauses->device_id);
+ c = build_omp_clause (where.lb->location, OMP_CLAUSE_DEVICE);
+ OMP_CLAUSE_DEVICE_ID (c)= device_var;
+ omp_clauses = gfc_trans_add_clause (c, omp_clauses);
+ }
+
if (clauses->num_threads)
{
tree num_threads;
@@ -1062,6 +1087,128 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
omp_clauses = gfc_trans_add_clause (c, omp_clauses);
}
+ for (int kind = OMP_MAP_LIST_ALLOC; kind < OMP_MAP_LIST_LAST; kind++)
+ {
+ enum omp_clause_map_kind type;
+ gfc_expr_list *el = clauses->map_lists[kind];
+
+ if (el == NULL)
+ continue;
+
+ switch (kind)
+ {
+ case OMP_MAP_LIST_ALLOC:
+ type = OMP_CLAUSE_MAP_ALLOC;
+ break;
+ case OMP_MAP_LIST_TO:
+ type = OMP_CLAUSE_MAP_TO;
+ break;
+ case OMP_MAP_LIST_FROM:
+ type = OMP_CLAUSE_MAP_FROM;
+ break;
+ case OMP_MAP_LIST_TOFROM:
+ type = OMP_CLAUSE_MAP_TOFROM;
+ break;
+ default:
+ gcc_unreachable ();
+ }
+ for (; el; el = el->next)
+ {
+ gfc_symbol *sym;
+ tree t, var_decl = NULL_TREE;
+ tree size = NULL_TREE, bias = NULL_TREE;
+
+ gcc_assert (el->expr->expr_type == EXPR_VARIABLE);
+ sym = el->expr->symtree->n.sym;
+
+ if (!sym->attr.referenced)
+ continue;
+
+ t = gfc_trans_omp_variable (sym);
+ if (el->expr->ref)
+ {
+ gfc_ref *ref = el->expr->ref;
+ for (; ref; ref = ref->next)
+ if (ref->type == REF_ARRAY)
+ if (ref->u.ar.type == AR_SECTION)
+ {
+ mpz_t ar_size, ar_kind, ar_bias;
+ bool computable;
+ int i;
+
+ /* In OpenMP implementation array sections are represented
+ as ARRAY_REF tree node with SIZE (in bytes).
+ Also one need to set bias of array section. */
+ var_decl = t;
+ t = gfc_convert_array_section_to_array_ref (ref->u.ar,
+ el->expr, t);
+ computable = gfc_array_size(el->expr, &ar_size);
+ gcc_assert (computable);
+ mpz_init_set_ui (ar_kind, el->expr->ts.kind);
+ mpz_init_set_ui (ar_bias, el->expr->ts.kind);
+ mpz_mul (ar_size, ar_size, ar_kind);
+ for (i = 0; i < ref->u.ar.dimen; i++)
+ {
+ mpz_t start, end, diff;
+ mpz_init (end);
+ mpz_init (diff);
+ mpz_init_set (start,
+ ref->u.ar.as->lower[i]->value.integer);
+ if (i < ref->u.ar.dimen - 1)
+ mpz_set (end, ref->u.ar.as->upper[i]->value.integer);
+ else
+ mpz_set (end, ref->u.ar.start[i]->value.integer);
+ mpz_sub (diff, end, start);
+ if (i < ref->u.ar.dimen - 1)
+ mpz_add_ui (diff, diff, 1);
+ mpz_mul (ar_bias, ar_bias, diff);
+ mpz_clear (start);
+ mpz_clear (end);
+ mpz_clear (diff);
+ }
+ size = gfc_conv_mpz_to_tree (ar_size, el->expr->ts.kind);
+ bias = gfc_conv_mpz_to_tree (ar_bias, el->expr->ts.kind);
+ mpz_clear (ar_size);
+ mpz_clear (ar_kind);
+ mpz_clear (ar_bias);
+ }
+ else if (ref->u.ar.type == AR_ELEMENT)
+ {
+ gfc_init_se (&se, NULL);
+ se.expr = t;
+ gfc_conv_array_ref (&se, &ref->u.ar, el->expr,
+ &el->expr->where);
+ t = se.expr;
+ size = build_int_cst (gfc_array_index_type,
+ gfc_index_integer_kind);
+ }
+ else if (ref->u.ar.type == AR_FULL)
+ ; /* Nothing to do: T already contains necessary data. */
+ else
+ gcc_unreachable ();
+ else
+ gcc_unreachable ();
+ }
+ if (t != error_mark_node)
+ {
+ tree node = build_omp_clause (where.lb->location, OMP_CLAUSE_MAP);
+ OMP_CLAUSE_DECL (node) = t;
+ OMP_CLAUSE_MAP_KIND (node) = type;
+ if (size)
+ OMP_CLAUSE_SIZE (node) = size;
+ omp_clauses = gfc_trans_add_clause (node, omp_clauses);
+ if (bias)
+ {
+ node = build_omp_clause (where.lb->location, OMP_CLAUSE_MAP);
+ OMP_CLAUSE_DECL (node) = var_decl;
+ OMP_CLAUSE_MAP_KIND (node) = OMP_CLAUSE_MAP_POINTER;
+ OMP_CLAUSE_SIZE (node) = bias;
+ omp_clauses = gfc_trans_add_clause (node, omp_clauses);
+ }
+ }
+ }
+ }
+
if (clauses->nowait)
{
c = build_omp_clause (where.lb->location, OMP_CLAUSE_NOWAIT);
@@ -1127,7 +1274,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
tree num_workers_var =
gfc_convert_expr_to_tree (block, clauses->num_workers_expr);
c = build_omp_clause (where.lb->location, OMP_CLAUSE_NUM_WORKERS);
- OMP_CLAUSE_NUM_WORKERS_EXPR (c)= num_workers_var;
+ OMP_CLAUSE_NUM_WORKERS_EXPR (c) = num_workers_var;
omp_clauses = gfc_trans_add_clause (c, omp_clauses);
}
if (clauses->vector_length_expr)
@@ -1135,7 +1282,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
tree vector_length_var =
gfc_convert_expr_to_tree (block, clauses->vector_length_expr);
c = build_omp_clause (where.lb->location, OMP_CLAUSE_VECTOR_LENGTH);
- OMP_CLAUSE_VECTOR_LENGTH_EXPR (c)= vector_length_var;
+ OMP_CLAUSE_VECTOR_LENGTH_EXPR (c) = vector_length_var;
omp_clauses = gfc_trans_add_clause (c, omp_clauses);
}
if (clauses->vector)
@@ -1145,7 +1292,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
tree vector_var =
gfc_convert_expr_to_tree (block, clauses->vector_expr);
c = build_omp_clause (where.lb->location, OMP_CLAUSE_VECTOR);
- OMP_CLAUSE_VECTOR_EXPR (c)= vector_var;
+ OMP_CLAUSE_VECTOR_EXPR (c) = vector_var;
omp_clauses = gfc_trans_add_clause (c, omp_clauses);
}
else
@@ -1161,7 +1308,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
tree worker_var =
gfc_convert_expr_to_tree (block, clauses->worker_expr);
c = build_omp_clause (where.lb->location, OMP_CLAUSE_WORKER);
- OMP_CLAUSE_WORKER_EXPR (c)= worker_var;
+ OMP_CLAUSE_WORKER_EXPR (c) = worker_var;
omp_clauses = gfc_trans_add_clause (c, omp_clauses);
}
else
@@ -1177,7 +1324,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
tree gang_var =
gfc_convert_expr_to_tree (block, clauses->gang_expr);
c = build_omp_clause (where.lb->location, OMP_CLAUSE_GANG);
- OMP_CLAUSE_GANG_EXPR (c)= gang_var;
+ OMP_CLAUSE_GANG_EXPR (c) = gang_var;
omp_clauses = gfc_trans_add_clause (c, omp_clauses);
}
else
@@ -1191,7 +1338,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
tree wait_var =
gfc_convert_expr_to_tree (block, clauses->non_clause_wait_expr);
c = build_omp_clause (where.lb->location, OMP_CLAUSE_WAIT);
- OMP_CLAUSE_WAIT_EXPR (c)= wait_var;
+ OMP_CLAUSE_WAIT_EXPR (c) = wait_var;
omp_clauses = gfc_trans_add_clause (c, omp_clauses);
}
@@ -2047,6 +2194,22 @@ gfc_trans_omp_single (gfc_code *code, gfc_omp_clauses *clauses)
}
static tree
+gfc_trans_omp_target (gfc_code *code)
+{
+ stmtblock_t block;
+ tree stmt, omp_clauses;
+
+ gfc_start_block (&block);
+ omp_clauses = gfc_trans_omp_clauses (&block, code->ext.omp_clauses,
+ code->loc);
+ stmt = gfc_trans_omp_code (code->block->next, true);
+ stmt = build2_loc (input_location, OMP_TARGET, void_type_node, stmt,
+ omp_clauses);
+ gfc_add_expr_to_block (&block, stmt);
+ return gfc_finish_block (&block);
+}
+
+static tree
gfc_trans_omp_task (gfc_code *code)
{
stmtblock_t block;
@@ -2302,6 +2465,8 @@ gfc_trans_omp_directive (gfc_code *code)
return gfc_trans_omp_sections (code, code->ext.omp_clauses);
case EXEC_OMP_SINGLE:
return gfc_trans_omp_single (code, code->ext.omp_clauses);
+ case EXEC_OMP_TARGET:
+ return gfc_trans_omp_target (code);
case EXEC_OMP_TASK:
return gfc_trans_omp_task (code);
case EXEC_OMP_TASKWAIT:
diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c
index 78b48d4..7b2ac43 100644
--- a/gcc/fortran/trans.c
+++ b/gcc/fortran/trans.c
@@ -1843,6 +1843,7 @@ trans_code (gfc_code * code, tree cond)
case EXEC_OMP_PARALLEL_WORKSHARE:
case EXEC_OMP_SECTIONS:
case EXEC_OMP_SINGLE:
+ case EXEC_OMP_TARGET:
case EXEC_OMP_TASK:
case EXEC_OMP_TASKWAIT:
case EXEC_OMP_TASKYIELD:
diff --git a/gcc/testsuite/gfortran.dg/goacc/subarrays.f95 b/gcc/testsuite/gfortran.dg/goacc/subarrays.f95
new file mode 100644
index 0000000..4740dab
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/subarrays.f95
@@ -0,0 +1,36 @@
+! { dg-do compile }
+program test
+ implicit none
+ integer :: a(10), b(10, 10), c(3:7), i
+
+ !$acc parallel copy(a(1:5))
+ !$acc end parallel
+ !$acc parallel copy(a(1 + 0 : 5 + 2))
+ !$acc end parallel
+ !$acc parallel copy(a(:3))
+ !$acc end parallel
+ !$acc parallel copy(a(3:))
+ !$acc end parallel
+ !$acc parallel copy(a(:)) ! { dg-error "Syntax error in variable list" }
+ !$acc parallel copy(a(2:3,2:3)) ! { dg-error "Number of dimensions" }
+ !$acc end parallel
+ ! TODO: there must be warning
+ !$acc parallel copy (a(:11))
+ !$acc end parallel
+ !$acc parallel copy (a(i:))
+ !$acc end parallel
+
+ !$acc parallel copy (a(:b)) ! { dg-error "scalar INTEGER expression" }
+ !$acc end parallel
+
+ !$acc parallel copy (b(1:3,2:4))
+ !$acc end parallel
+ !$acc parallel copy (b(2:3)) ! { dg-error "Number of dimensions" }
+ !$acc end parallel
+ !$acc parallel copy (b(1:, 4:6)) ! { dg-warning "whole dimension" }
+ !$acc end parallel
+
+ ! TODO: there must be warning
+ !$acc parallel copy (c(2:))
+ !$acc end parallel
+end program test
\ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/gomp/map-1.f90 b/gcc/testsuite/gfortran.dg/gomp/map-1.f90
new file mode 100644
index 0000000..bd30ef6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/map-1.f90
@@ -0,0 +1,101 @@
+subroutine test(aas)
+ implicit none
+
+ integer :: i, j(10), k(10, 10), aas(*)
+ integer, save :: tp
+ !$omp threadprivate(tp)
+ integer, parameter :: p = 1
+
+ type t
+ integer :: i, j(10)
+ end type t
+
+ type(t) :: tt
+
+ !$omp target map(i)
+ !$omp end target
+
+ !$omp target map(j)
+ !$omp end target
+
+ !$omp target map(p) ! { dg-error "Expression in MAP clause is not a variable" }
+ !$omp end target
+
+ !$omp target map(j(1))
+ !$omp end target
+
+ !$omp target map(j(i))
+ !$omp end target
+
+ !$omp target map(j(i:))
+ !$omp end target
+
+ !$omp target map(j(:i))
+ !$omp end target
+
+ !$omp target map(j(i:i+1))
+ !$omp end target
+
+ !$omp target map(j(11)) ! { dg-warning "out of bounds" }
+ !$omp end target
+
+ !$omp target map(j(:11)) ! { dg-warning "out of bounds" }
+ !$omp end target
+
+ !$omp target map(j(0:)) ! { dg-warning "out of bounds" }
+ !$omp end target
+
+ !$omp target map(j(5:4)) ! { dg-error "Lower bound of OpenMP array section in greater than upper" }
+ !$omp end target
+
+ !$omp target map(j(5:))
+ !$omp end target
+
+ !$omp target map(j(:5))
+ !$omp end target
+
+ !$omp target map(j(:))
+ !$omp end target
+
+ !$omp target map(j(1:9:2)) ! { dg-error "Stride is not allowed in OpenMP array section" }
+ !$omp end target
+
+ !$omp target map(aas(5:)) ! { dg-error "Rightmost upper bound of assumed size array section not specified" }
+ !$omp end target
+
+ !$omp target map(aas(:)) ! { dg-error "Rightmost upper bound of assumed size array section not specified" }
+ !$omp end target
+
+ !$omp target map(aas) ! { dg-error "The upper bound in the last dimension must appear" }
+ !$omp end target
+
+ !$omp target map(aas(5:7))
+ !$omp end target
+
+ !$omp target map(aas(:7))
+ !$omp end target
+
+ !$omp target map(k(5:)) ! { dg-error "Rank mismatch in array reference" }
+ !$omp end target
+
+ !$omp target map(k(5:,:,3)) ! { dg-error "Rank mismatch in array reference" }
+ !$omp end target
+
+ !$omp target map(tt)
+ !$omp end target
+
+ !$omp target map(tt%i) ! { dg-error "must be single array element or array section" }
+ !$omp end target
+
+ !$omp target map(tt%j) ! { dg-error "must be single array element or OpenMP array section" }
+ !$omp end target
+
+ !$omp target map(tt%j(1))
+ !$omp end target
+
+ !$omp target map(tt%j(1:))
+ !$omp end target
+
+ !$omp target map(tp) ! { dg-error "Threadprivate variable" }
+ !$omp end target
+end subroutine test
\ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/gomp/target-1.f90 b/gcc/testsuite/gfortran.dg/gomp/target-1.f90
new file mode 100644
index 0000000..7f4439c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/target-1.f90
@@ -0,0 +1,21 @@
+! { dg-additional-options "-fdump-tree-original" }
+
+program test
+ implicit none
+ integer :: i, j(10), k(10), l(10), m(10), n(10)
+ !$omp target if (.true.) device(1+1) map(to:j(1:)) map(from:k(:8)) map(tofrom:l(4:7)) &
+ !$omp& map(alloc:m(1)) map(n(:))
+ i = 1
+ !$omp end target
+end program test
+! { dg-final { scan-tree-dump-times "pragma omp target" 2 "original" } }
+! { dg-final { scan-tree-dump-times "pragma omp target data" 1 "original" } }
+! { dg-final { scan-tree-dump-times "if" 2 "original" } }
+! { dg-final { scan-tree-dump-times "device" 2 "original" } }
+! { dg-final { scan-tree-dump-times "map\\(tofrom:l\\)" 2 "original" } }
+! { dg-final { scan-tree-dump-times "map\\(tofrom:n\\)" 2 "original" } }
+! { dg-final { scan-tree-dump-times "map\\(to:j\\)" 2 "original" } }
+! { dg-final { scan-tree-dump-times "map\\(from:k\\)" 2 "original" } }
+! { dg-final { scan-tree-dump-times "map\\(alloc:m\\)" 2 "original" } }
+
+! { dg-final { cleanup-tree-dump "original" } }
\ No newline at end of file
--
1.8.3.2
^ permalink raw reply [flat|nested] 12+ messages in thread
* Re: FWD: Re: OpenACC subarray specifications in the GCC Fortran front end
2014-05-22 7:32 ` FWD: Re: OpenACC subarray specifications in the GCC Fortran front end Ilmir Usmanov
@ 2014-07-11 10:11 ` Thomas Schwinge
2014-07-11 10:29 ` Jakub Jelinek
0 siblings, 1 reply; 12+ messages in thread
From: Thomas Schwinge @ 2014-07-11 10:11 UTC (permalink / raw)
To: jakub, Cesar Philippidis, gcc-patches, fortran
Cc: Ilmir Usmanov, Ilmir Usmanov
[-- Attachment #1: Type: text/plain, Size: 27412 bytes --]
Hi!
On Thu, 22 May 2014 11:31:25 +0400, Ilmir Usmanov <i.usmanov@samsung.com> wrote:
> On 16.05.2014 19:44, Ilmir Usmanov wrote:
> > On 16.05.2014 19:12, Thomas Schwinge wrote:
> >> You recently indicated that you have already begun implementing OpenACC
> >> subarray specifications in the GCC Fortran front end, but have not
> >> been/are not currently able to complete that. Would you be willing to
> >> share your WIP patch with Cesar, who is now working on this, so that he
> >> doesn't have to duplicate your work?
> > Sure! I'm glad to know that my work won't go directly to trash.
:-)
> > You can find the patch in attachment.
> >
> > I started to implement sub-arrays in gfortran by implementing OpenMP
> > 4.0 target map clause. This clause was already implemented in C/C++
> > FEs, so I could check the behavior. I don't know whether it's already
> > implemented in gfortran or not.
To avoid duplication of work: with Jakub's Fortran OpenMP 4 target
changes recently committed to trunk, and now merged into gomp-4_0-branch,
I have trimmed down Ilmir's patch to just the OpenACC bits, OpenMP 4
target changes removed, and TODO markers added to integrate into that.
Jakub, before your Fortran OpenMP 4 target changes, Ilmir had written the
test case gcc/testsuite/gfortran.dg/gomp/map-1.f90 (based on his
interpretation and implementation of OpenMP 4 target), which I have now
amended with XFAILs and changed error messages -- anything in there that
you'd like to see addressed for Fortran OpenMP 4 target?
> > To represent OpenMP array sections (or OpenACC subarrays) I used
> > gfc_expr.
> >
> > After implementing OpenMP target map clauses I was going to use it to
> > represent OpenACC data clauses, just as Thomas recommended in his
> > mail: http://gcc.gnu.org/ml/gcc-patches/2014-01/msg02040.html
> >
> > I hope this will be useful for you. If you will have any question feel
> > free to ask.
gcc/fortran/dump-parse-tree.c | 47 +++++--
gcc/fortran/gfortran.h | 18 +++
gcc/fortran/openmp.c | 182 ++++++++++++++++++++++++++
gcc/fortran/trans-openmp.c | 145 +++++++++++++++++++-
gcc/testsuite/gfortran.dg/goacc/subarrays.f95 | 36 +++++
gcc/testsuite/gfortran.dg/gomp/map-1.f90 | 109 +++++++++++++++
6 files changed, 520 insertions(+), 17 deletions(-)
diff --git gcc/fortran/dump-parse-tree.c gcc/fortran/dump-parse-tree.c
index c3671395..8d7c38c 100644
--- gcc/fortran/dump-parse-tree.c
+++ gcc/fortran/dump-parse-tree.c
@@ -1072,6 +1072,18 @@ show_omp_namelist (int list_type, gfc_omp_namelist *n)
}
}
+/* TODO: remove; use show_omp_namelist. */
+static void
+show_expr_list (gfc_expr_list *el)
+{
+ for (; el->next; el = el->next)
+ {
+ show_expr (el->expr);
+ fputc (',', dumpfile);
+ }
+ show_expr (el->expr);
+}
+
/* Show OpenMP or OpenACC clauses. */
@@ -1214,28 +1226,35 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses)
}
fprintf (dumpfile, " DEFAULT(%s)", type);
}
+ for (int kind = 0; kind < OMP_MAP_LIST_LAST; kind++)
+ {
+ const char *type;
+ if (omp_clauses->map_lists[kind] == NULL)
+ continue;
+
+ switch (kind)
+ {
+ case OMP_MAP_LIST_ALLOC: type = "ALLOC"; break;
+ case OMP_MAP_LIST_TO: type = "TO"; break;
+ case OMP_MAP_LIST_FROM: type = "FROM"; break;
+ case OMP_MAP_LIST_TOFROM: type = "TOFROM"; break;
+ default:
+ gcc_unreachable ();
+ }
+ fprintf (dumpfile, " MAP(%s:", type);
+ show_expr_list (omp_clauses->map_lists[kind]);
+ fputc (')', dumpfile);
+ }
if (omp_clauses->tile_list)
{
- gfc_expr_list *list;
fputs (" TILE(", dumpfile);
- for (list = omp_clauses->tile_list; list; list = list->next)
- {
- show_expr (list->expr);
- if (list->next)
- fputs (", ", dumpfile);
- }
+ show_expr_list (omp_clauses->tile_list);
fputc (')', dumpfile);
}
if (omp_clauses->wait_list)
{
- gfc_expr_list *list;
fputs (" WAIT(", dumpfile);
- for (list = omp_clauses->wait_list; list; list = list->next)
- {
- show_expr (list->expr);
- if (list->next)
- fputs (", ", dumpfile);
- }
+ show_expr_list (omp_clauses->wait_list);
fputc (')', dumpfile);
}
if (omp_clauses->seq)
diff --git gcc/fortran/gfortran.h gcc/fortran/gfortran.h
index cc445e6..09da2d1 100644
--- gcc/fortran/gfortran.h
+++ gcc/fortran/gfortran.h
@@ -1172,6 +1172,22 @@ enum
OMP_LIST_NUM
};
+/* OpenACC 2.0: data clauses kind. */
+/* TODO: remove; use OpenMP 4 target infrastructure. */
+enum gfc_omp_clause_map_kind
+{
+ /* If not already present, allocate. */
+ OMP_MAP_LIST_ALLOC,
+ /* ..., and copy to device. */
+ OMP_MAP_LIST_TO,
+ /* ..., and copy from device. */
+ OMP_MAP_LIST_FROM,
+ /* ..., and copy to and from device. */
+ OMP_MAP_LIST_TOFROM,
+ /* End marker. */
+ OMP_MAP_LIST_LAST
+};
+
/* Because a symbol can belong to multiple namelists, they must be
linked externally to the symbol itself. */
@@ -1217,6 +1233,8 @@ typedef struct gfc_omp_clauses
struct gfc_expr *final_expr;
struct gfc_expr *num_threads;
gfc_omp_namelist *lists[OMP_LIST_NUM];
+ /* TODO: remove; use OpenMP 4 target infrastructure. */
+ gfc_expr_list *map_lists[OMP_MAP_LIST_LAST];
enum gfc_omp_sched_kind sched_kind;
struct gfc_expr *chunk_size;
enum gfc_omp_default_sharing default_sharing;
diff --git gcc/fortran/openmp.c gcc/fortran/openmp.c
index 7b87e78..1cf9128 100644
--- gcc/fortran/openmp.c
+++ gcc/fortran/openmp.c
@@ -86,6 +86,8 @@ gfc_free_omp_clauses (gfc_omp_clauses *c)
gfc_free_expr (c->non_clause_wait_expr);
for (i = 0; i < OMP_LIST_NUM; i++)
gfc_free_omp_namelist (c->lists[i]);
+ for (i = 0; i < OMP_MAP_LIST_LAST; i++)
+ gfc_free_expr_list (c->map_lists[i]);
gfc_free_expr_list (c->wait_list);
gfc_free_expr_list (c->tile_list);
free (c);
@@ -2475,6 +2477,24 @@ oacc_is_loop (gfc_code *code)
|| code->op == EXEC_OACC_LOOP;
}
+/* TODO: use OpenMP 4 target infrastructure. */
+static const char*
+map_list_to_ascii (gfc_code *code, int list)
+{
+ gcc_assert (code->op == EXEC_OMP_TARGET);
+
+ switch (list)
+ {
+ case OMP_MAP_LIST_ALLOC:
+ case OMP_MAP_LIST_TO:
+ case OMP_MAP_LIST_FROM:
+ case OMP_MAP_LIST_TOFROM:
+ return ("MAP");
+ default:
+ gcc_unreachable ();
+ }
+}
+
static void
resolve_oacc_scalar_int_expr (gfc_expr *expr, const char *clause)
{
@@ -2560,6 +2580,32 @@ resolve_oacc_data_clauses (gfc_symbol *sym, locus loc, const char *name)
check_array_not_assumed (sym, loc, name);
}
+/* TODO: use OpenMP 4 target infrastructure. */
+static void
+resolve_omp_map_clauses (gfc_symbol *sym, locus loc)
+{
+ const char *name = "MAP";
+ if (sym->ts.type == BT_DERIVED && sym->attr.allocatable)
+ gfc_error ("ALLOCATABLE object '%s' of derived type in %s clause at %L",
+ sym->name, name, &loc);
+ if ((sym->ts.type == BT_ASSUMED && sym->attr.allocatable)
+ || (sym->ts.type == BT_CLASS && CLASS_DATA (sym)
+ && CLASS_DATA (sym)->attr.allocatable))
+ gfc_error ("ALLOCATABLE object '%s' of polymorphic type "
+ "in %s clause at %L", sym->name, name, &loc);
+ check_symbol_not_pointer (sym, loc, name);
+ if (sym->as && sym->as->type == AS_ASSUMED_RANK)
+ gfc_error ("Assumed rank array '%s' 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 '%s' in %s clause at %L",
+ sym->name, name, &loc);
+ if (sym->attr.threadprivate)
+ gfc_error ("Threadprivate variable '%s' is not allowed in %s clause at %L",
+ sym->name, name, &loc);
+}
+
static void
resolve_oacc_deviceptr_clause (gfc_symbol *sym, locus loc, const char *name)
{
@@ -2688,6 +2734,59 @@ resolve_omp_udr_clause (gfc_omp_namelist *n, gfc_namespace *ns,
}
+/* TODO: use OpenMP 4 target infrastructure. */
+static void
+resolve_omp_array_section (gfc_array_ref *ar, gfc_code *code,
+ const char *clause, const char *sym_name,
+ bool component)
+{
+ int i;
+ const char *str;
+
+ switch (code->op)
+ {
+ case EXEC_OACC_KERNELS:
+ case EXEC_OACC_PARALLEL:
+ case EXEC_OACC_DATA:
+ case EXEC_OACC_CACHE:
+ str = "OpenACC subarray";
+ break;
+ default:
+ str = "OpenMP array section";
+ }
+ if (ar->type == AR_UNKNOWN)
+ {
+ gfc_error ("Expression in %s clause is not %s of "
+ "array '%s' at %L", clause, str, sym_name, &code->loc);
+ return;
+ }
+ if (component && ar->type == AR_FULL)
+ {
+ gfc_error ("Component of derived type '%s' in %s clause must be single "
+ "array element or %s at %L", sym_name, clause, str,
+ &code->loc);
+ return;
+ }
+ for (i = 0; i < ar->as->rank; i++)
+ {
+ gfc_expr *start = ar->start[i];
+ gfc_expr *end = ar->end[i];
+ if (ar->stride[i])
+ {
+ gfc_error ("Stride is not allowed in %s at %L", str, &ar->c_where[i]);
+ continue;
+ }
+ /* Since stride is not allowed, lower bound cannot be greater
+ than upper one. */
+ if (start && end
+ && mpz_cmp (start->value.integer, end->value.integer) > 0)
+ gfc_error ("Lower bound of %s in greater than "
+ "upper (%ld > %ld) at %L", str,
+ mpz_get_si (start->value.integer),
+ mpz_get_si (end->value.integer), &ar->c_where[i]);
+ }
+}
+
/* OpenMP directive resolving routines. */
static void
@@ -2862,6 +2961,89 @@ resolve_omp_clauses (gfc_code *code, locus *where,
n->sym->mark = 1;
}
+ for (list = 0; list < OMP_MAP_LIST_LAST; list++)
+ for (el = omp_clauses->map_lists[list]; el; el = el->next)
+ {
+ gfc_ref *ref;
+ gfc_symbol *sym;
+ bool component = false;
+
+ gfc_resolve_expr (el->expr);
+
+ if (el->expr->expr_type != EXPR_VARIABLE)
+ {
+ gfc_error ("Expression in %s clause is not a variable at %L",
+ map_list_to_ascii (code, list), &code->loc);
+ continue;
+ }
+
+ sym = el->expr->symtree->n.sym;
+ sym->mark = 0;
+ if (sym->attr.flavor != FL_VARIABLE && !sym->attr.proc_pointer)
+ {
+ gfc_error ("Object '%s' is not a variable at %L", sym->name,
+ &code->loc);
+ continue;
+ }
+
+ if (el->expr->ts.type == BT_CLASS)
+ {
+ gfc_error ("CLASS object '%s' cannot appear in %s clause at %L",
+ sym->name, map_list_to_ascii (code, list), &code->loc);
+ continue;
+ }
+
+ if (el->expr->rank != 0 && !gfc_is_simply_contiguous(el->expr, false))
+ {
+ gfc_error ("Object %s in %s clause is not contiguous at %L",
+ sym->name, map_list_to_ascii (code, list), &code->loc);
+ continue;
+ }
+
+ for (ref = el->expr->ref; ref; ref = ref->next)
+ if (ref->type == REF_ARRAY)
+ resolve_omp_array_section (&ref->u.ar, code,
+ map_list_to_ascii (code, list),
+ sym->name, component);
+ else if (ref->type == REF_COMPONENT)
+ {
+ if (!ref->u.c.component->as)
+ {
+ gfc_error ("Component '%s' of derived type in %s clause must "
+ "be single array element or array section at %L",
+ ref->u.c.component->name,
+ map_list_to_ascii (code, list), &code->loc);
+ continue;
+ }
+ component = true;
+ }
+ else if (ref->type == REF_SUBSTRING)
+ gfc_error ("Substrings are not allowed in array section in %s "
+ "clause at %L", map_list_to_ascii (code, list),
+ &code->loc);
+ else
+ gcc_unreachable ();
+ }
+
+
+ for (list = 0; list < OMP_MAP_LIST_LAST; list++)
+ for (el = omp_clauses->map_lists[list]; el; el = el->next)
+ {
+ gfc_symbol *sym;
+
+ if (el->expr->expr_type != EXPR_VARIABLE)
+ continue;
+
+ sym = el->expr->symtree->n.sym;
+ if (sym->mark)
+ gfc_error ("Symbol '%s' present on multiple clauses at %L",
+ sym->name, &code->loc);
+ else
+ sym->mark = 1;
+
+ resolve_omp_map_clauses (sym, code->loc);
+ }
+
for (list = 0; list < OMP_LIST_NUM; list++)
if ((n = omp_clauses->lists[list]) != NULL)
{
diff --git gcc/fortran/trans-openmp.c gcc/fortran/trans-openmp.c
index aaf50d3..96d5cd9 100644
--- gcc/fortran/trans-openmp.c
+++ gcc/fortran/trans-openmp.c
@@ -1687,7 +1687,7 @@ gfc_trans_omp_reduction_list (gfc_omp_namelist *namelist, tree list,
static tree
gfc_trans_omp_map_clause_list (enum omp_clause_map_kind kind,
- gfc_omp_namelist *namelist, tree list)
+ gfc_omp_namelist *namelist, tree list, locus where)
{
for (; namelist != NULL; namelist = namelist->next)
if (namelist->sym->attr.referenced)
@@ -1695,7 +1695,7 @@ gfc_trans_omp_map_clause_list (enum omp_clause_map_kind kind,
tree t = gfc_trans_omp_variable (namelist->sym, false);
if (t != error_mark_node)
{
- tree node = build_omp_clause (input_location, OMP_CLAUSE_MAP);
+ tree node = build_omp_clause (where.lb->location, OMP_CLAUSE_MAP);
OMP_CLAUSE_DECL (node) = t;
OMP_CLAUSE_MAP_KIND (node) = kind;
list = gfc_trans_add_clause (node, list);
@@ -1719,6 +1719,23 @@ gfc_convert_expr_to_tree (stmtblock_t *block, gfc_expr *expr)
return result;
}
+/* TODO: use OpenMP 4 target infrastructure. */
+static tree
+gfc_convert_array_section_to_array_ref (gfc_array_ref ar, gfc_expr *expr,
+ tree t)
+{
+ gfc_se se;
+ int i;
+ for (i = 0; i < ar.dimen; i++)
+ if (ar.start[i] == NULL)
+ ar.start[i] = ar.as->lower[i];
+ ar.type = AR_ELEMENT;
+ gfc_init_se (&se, NULL);
+ se.expr = t;
+ gfc_conv_array_ref (&se, &ar, expr, &expr->where);
+ return se.expr;
+}
+
static tree
gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
locus where, bool declare_simd = false)
@@ -1779,7 +1796,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
default:
gcc_unreachable ();
}
- omp_clauses = gfc_trans_omp_map_clause_list (kind, n, omp_clauses);
+ omp_clauses = gfc_trans_omp_map_clause_list (kind, n, omp_clauses, where);
continue;
}
switch (list)
@@ -2336,6 +2353,128 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
omp_clauses = gfc_trans_add_clause (c, omp_clauses);
}
+ for (int kind = OMP_MAP_LIST_ALLOC; kind < OMP_MAP_LIST_LAST; kind++)
+ {
+ enum omp_clause_map_kind type;
+ gfc_expr_list *el = clauses->map_lists[kind];
+
+ if (el == NULL)
+ continue;
+
+ switch (kind)
+ {
+ case OMP_MAP_LIST_ALLOC:
+ type = OMP_CLAUSE_MAP_ALLOC;
+ break;
+ case OMP_MAP_LIST_TO:
+ type = OMP_CLAUSE_MAP_TO;
+ break;
+ case OMP_MAP_LIST_FROM:
+ type = OMP_CLAUSE_MAP_FROM;
+ break;
+ case OMP_MAP_LIST_TOFROM:
+ type = OMP_CLAUSE_MAP_TOFROM;
+ break;
+ default:
+ gcc_unreachable ();
+ }
+ for (; el; el = el->next)
+ {
+ gfc_symbol *sym;
+ tree t, var_decl = NULL_TREE;
+ tree size = NULL_TREE, bias = NULL_TREE;
+
+ gcc_assert (el->expr->expr_type == EXPR_VARIABLE);
+ sym = el->expr->symtree->n.sym;
+
+ if (!sym->attr.referenced)
+ continue;
+
+ t = gfc_trans_omp_variable (sym, false);
+ if (el->expr->ref)
+ {
+ gfc_ref *ref = el->expr->ref;
+ for (; ref; ref = ref->next)
+ if (ref->type == REF_ARRAY)
+ if (ref->u.ar.type == AR_SECTION)
+ {
+ mpz_t ar_size, ar_kind, ar_bias;
+ bool computable;
+ int i;
+
+ /* In OpenMP implementation array sections are represented
+ as ARRAY_REF tree node with SIZE (in bytes).
+ Also one need to set bias of array section. */
+ var_decl = t;
+ t = gfc_convert_array_section_to_array_ref (ref->u.ar,
+ el->expr, t);
+ computable = gfc_array_size(el->expr, &ar_size);
+ gcc_assert (computable);
+ mpz_init_set_ui (ar_kind, el->expr->ts.kind);
+ mpz_init_set_ui (ar_bias, el->expr->ts.kind);
+ mpz_mul (ar_size, ar_size, ar_kind);
+ for (i = 0; i < ref->u.ar.dimen; i++)
+ {
+ mpz_t start, end, diff;
+ mpz_init (end);
+ mpz_init (diff);
+ mpz_init_set (start,
+ ref->u.ar.as->lower[i]->value.integer);
+ if (i < ref->u.ar.dimen - 1)
+ mpz_set (end, ref->u.ar.as->upper[i]->value.integer);
+ else
+ mpz_set (end, ref->u.ar.start[i]->value.integer);
+ mpz_sub (diff, end, start);
+ if (i < ref->u.ar.dimen - 1)
+ mpz_add_ui (diff, diff, 1);
+ mpz_mul (ar_bias, ar_bias, diff);
+ mpz_clear (start);
+ mpz_clear (end);
+ mpz_clear (diff);
+ }
+ size = gfc_conv_mpz_to_tree (ar_size, el->expr->ts.kind);
+ bias = gfc_conv_mpz_to_tree (ar_bias, el->expr->ts.kind);
+ mpz_clear (ar_size);
+ mpz_clear (ar_kind);
+ mpz_clear (ar_bias);
+ }
+ else if (ref->u.ar.type == AR_ELEMENT)
+ {
+ gfc_init_se (&se, NULL);
+ se.expr = t;
+ gfc_conv_array_ref (&se, &ref->u.ar, el->expr,
+ &el->expr->where);
+ t = se.expr;
+ size = build_int_cst (gfc_array_index_type,
+ gfc_index_integer_kind);
+ }
+ else if (ref->u.ar.type == AR_FULL)
+ ; /* Nothing to do: T already contains necessary data. */
+ else
+ gcc_unreachable ();
+ else
+ gcc_unreachable ();
+ }
+ if (t != error_mark_node)
+ {
+ tree node = build_omp_clause (where.lb->location, OMP_CLAUSE_MAP);
+ OMP_CLAUSE_DECL (node) = t;
+ OMP_CLAUSE_MAP_KIND (node) = type;
+ if (size)
+ OMP_CLAUSE_SIZE (node) = size;
+ omp_clauses = gfc_trans_add_clause (node, omp_clauses);
+ if (bias)
+ {
+ node = build_omp_clause (where.lb->location, OMP_CLAUSE_MAP);
+ OMP_CLAUSE_DECL (node) = var_decl;
+ OMP_CLAUSE_MAP_KIND (node) = OMP_CLAUSE_MAP_POINTER;
+ OMP_CLAUSE_SIZE (node) = bias;
+ omp_clauses = gfc_trans_add_clause (node, omp_clauses);
+ }
+ }
+ }
+ }
+
if (clauses->nowait)
{
c = build_omp_clause (where.lb->location, OMP_CLAUSE_NOWAIT);
diff --git gcc/testsuite/gfortran.dg/goacc/subarrays.f95 gcc/testsuite/gfortran.dg/goacc/subarrays.f95
new file mode 100644
index 0000000..4740dab
--- /dev/null
+++ gcc/testsuite/gfortran.dg/goacc/subarrays.f95
@@ -0,0 +1,36 @@
+! { dg-do compile }
+program test
+ implicit none
+ integer :: a(10), b(10, 10), c(3:7), i
+
+ !$acc parallel copy(a(1:5))
+ !$acc end parallel
+ !$acc parallel copy(a(1 + 0 : 5 + 2))
+ !$acc end parallel
+ !$acc parallel copy(a(:3))
+ !$acc end parallel
+ !$acc parallel copy(a(3:))
+ !$acc end parallel
+ !$acc parallel copy(a(:)) ! { dg-error "Syntax error in variable list" }
+ !$acc parallel copy(a(2:3,2:3)) ! { dg-error "Number of dimensions" }
+ !$acc end parallel
+ ! TODO: there must be warning
+ !$acc parallel copy (a(:11))
+ !$acc end parallel
+ !$acc parallel copy (a(i:))
+ !$acc end parallel
+
+ !$acc parallel copy (a(:b)) ! { dg-error "scalar INTEGER expression" }
+ !$acc end parallel
+
+ !$acc parallel copy (b(1:3,2:4))
+ !$acc end parallel
+ !$acc parallel copy (b(2:3)) ! { dg-error "Number of dimensions" }
+ !$acc end parallel
+ !$acc parallel copy (b(1:, 4:6)) ! { dg-warning "whole dimension" }
+ !$acc end parallel
+
+ ! TODO: there must be warning
+ !$acc parallel copy (c(2:))
+ !$acc end parallel
+end program test
\ No newline at end of file
diff --git gcc/testsuite/gfortran.dg/gomp/map-1.f90 gcc/testsuite/gfortran.dg/gomp/map-1.f90
new file mode 100644
index 0000000..603d19d
--- /dev/null
+++ gcc/testsuite/gfortran.dg/gomp/map-1.f90
@@ -0,0 +1,109 @@
+subroutine test(aas)
+ implicit none
+
+ integer :: i, j(10), k(10, 10), aas(*)
+ integer, save :: tp
+ !$omp threadprivate(tp)
+ integer, parameter :: p = 1
+
+ type t
+ integer :: i, j(10)
+ end type t
+
+ type(t) :: tt
+
+ !$omp target map(i)
+ !$omp end target
+
+ !$omp target map(j)
+ !$omp end target
+
+ !$omp target map(p) ! { dg-error "Object 'p' is not a variable" }
+ !$omp end target
+
+ !$omp target map(j(1))
+ !$omp end target
+
+ !$omp target map(j(i))
+ !$omp end target
+
+ !$omp target map(j(i:))
+ !$omp end target
+
+ !$omp target map(j(:i))
+ !$omp end target
+
+ !$omp target map(j(i:i+1))
+ !$omp end target
+
+ !$omp target map(j(11)) ! { dg-warning "out of bounds" }
+ !$omp end target
+
+ !$omp target map(j(:11)) ! { dg-warning "out of bounds" }
+ !$omp end target
+
+ !$omp target map(j(0:)) ! { dg-warning "out of bounds" }
+ !$omp end target
+
+ !$omp target map(j(5:4)) ! { dg-error "Lower bound of OpenMP array section in greater than upper" "" { xfail *-*-* } }
+ !$omp end target
+
+ !$omp target map(j(5:))
+ !$omp end target
+
+ !$omp target map(j(:5))
+ !$omp end target
+
+ !$omp target map(j(:))
+ !$omp end target
+
+ !$omp target map(j(1:9:2)) ! { dg-error "Stride should not be specified for array section in MAP clause" }
+ !$omp end target
+
+ !$omp target map(aas(5:))
+ !$omp end target
+ ! { dg-error "Rightmost upper bound of assumed size array section not specified" "" { target *-*-* } 63 }
+ ! { dg-error "'aas' in MAP clause at \\\(1\\\) is not a proper array section" "" { target *-*-* } 63 }
+
+ !$omp target map(aas(:))
+ !$omp end target
+ ! { dg-error "Rightmost upper bound of assumed size array section not specified" "" { target *-*-* } 68 }
+ ! { dg-error "'aas' in MAP clause at \\\(1\\\) is not a proper array section" "" { target *-*-* } 68 }
+
+ !$omp target map(aas) ! { dg-error "The upper bound in the last dimension must appear" "" { xfail *-*-* } }
+ !$omp end target
+
+ !$omp target map(aas(5:7))
+ !$omp end target
+
+ !$omp target map(aas(:7))
+ !$omp end target
+
+ !$omp target map(k(5:))
+ !$omp end target
+ ! { dg-error "Rank mismatch in array reference" "" { target *-*-* } 82 }
+ ! { dg-error "'k' in MAP clause at \\\(1\\\) is not a proper array section" "" { target *-*-* } 82 }
+
+ !$omp target map(k(5:,:,3))
+ !$omp end target
+ ! { dg-error "Rank mismatch in array reference" "" { target *-*-* } 87 }
+ ! { dg-error "'k' in MAP clause at \\\(1\\\) is not a proper array section" "" { target *-*-* } 87 }
+
+ !$omp target map(tt)
+ !$omp end target
+
+ !$omp target map(tt%i) ! { dg-error "Syntax error in OpenMP variable list" }
+ !$omp end target ! { dg-bogus "Unexpected !\\\$OMP END TARGET statement" "" { xfail *-*-* } }
+
+ !$omp target map(tt%j) ! { dg-error "Syntax error in OpenMP variable list" }
+ !$omp end target ! { dg-bogus "Unexpected !\\\$OMP END TARGET statement" "" { xfail *-*-* } }
+
+ !$omp target map(tt%j(1)) ! { dg-bogus "Syntax error in OpenMP variable list" "" { xfail *-*-* } }
+ !$omp end target ! { dg-bogus "Unexpected !\\\$OMP END TARGET statement" "" { xfail *-*-* } }
+
+ !$omp target map(tt%j(1:)) ! { dg-bogus "Syntax error in OpenMP variable list" "" { xfail *-*-* } }
+ !$omp end target ! { dg-bogus "Unexpected !\\\$OMP END TARGET statement" "" { xfail *-*-* } }
+
+ !$omp target map(tp) ! { dg-error "THREADPRIVATE object 'tp' in MAP clause" }
+ !$omp end target
+end subroutine test
\ No newline at end of file
Also, I think the following is wanted, too, to allow subarray
specifications for all OpenACC data clauses:
--- gcc/fortran/openmp.c
+++ gcc/fortran/openmp.c
@@ -577,80 +577,86 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, unsigned long long mask,
continue;
if ((mask & OMP_CLAUSE_COPY)
&& gfc_match_omp_variable_list ("copy (",
- &c->lists[OMP_LIST_COPY], true)
+ &c->lists[OMP_LIST_COPY], true,
+ NULL, NULL, true)
== MATCH_YES)
continue;
if ((mask & OMP_CLAUSE_OACC_COPYIN)
&& gfc_match_omp_variable_list ("copyin (",
- &c->lists[OMP_LIST_OACC_COPYIN], true)
+ &c->lists[OMP_LIST_OACC_COPYIN], true,
+ NULL, NULL, true)
== MATCH_YES)
continue;
if ((mask & OMP_CLAUSE_COPYOUT)
&& gfc_match_omp_variable_list ("copyout (",
- &c->lists[OMP_LIST_COPYOUT], true)
+ &c->lists[OMP_LIST_COPYOUT], true,
+ NULL, NULL, true)
== MATCH_YES)
continue;
if ((mask & OMP_CLAUSE_CREATE)
&& gfc_match_omp_variable_list ("create (",
- &c->lists[OMP_LIST_CREATE], true)
+ &c->lists[OMP_LIST_CREATE], true,
+ NULL, NULL, true)
== MATCH_YES)
continue;
if ((mask & OMP_CLAUSE_DELETE)
&& gfc_match_omp_variable_list ("delete (",
- &c->lists[OMP_LIST_DELETE], true)
+ &c->lists[OMP_LIST_DELETE], true,
+ NULL, NULL, true)
== MATCH_YES)
continue;
if ((mask & OMP_CLAUSE_PRESENT)
&& gfc_match_omp_variable_list ("present (",
- &c->lists[OMP_LIST_PRESENT], true)
+ &c->lists[OMP_LIST_PRESENT], true,
+ NULL, NULL, true)
== MATCH_YES)
continue;
if ((mask & OMP_CLAUSE_PRESENT_OR_COPY)
&& gfc_match_omp_variable_list ("present_or_copy (",
&c->lists[OMP_LIST_PRESENT_OR_COPY],
- true)
+ true, NULL, NULL, true)
== MATCH_YES)
continue;
if ((mask & OMP_CLAUSE_PRESENT_OR_COPY)
&& gfc_match_omp_variable_list ("pcopy (",
&c->lists[OMP_LIST_PRESENT_OR_COPY],
- true)
+ true, NULL, NULL, true)
== MATCH_YES)
continue;
if ((mask & OMP_CLAUSE_PRESENT_OR_COPYIN)
&& gfc_match_omp_variable_list ("present_or_copyin (",
&c->lists[OMP_LIST_PRESENT_OR_COPYIN],
- true)
+ true, NULL, NULL, true)
== MATCH_YES)
continue;
if ((mask & OMP_CLAUSE_PRESENT_OR_COPYIN)
&& gfc_match_omp_variable_list ("pcopyin (",
&c->lists[OMP_LIST_PRESENT_OR_COPYIN],
- true)
+ true, NULL, NULL, true)
== MATCH_YES)
continue;
if ((mask & OMP_CLAUSE_PRESENT_OR_COPYOUT)
&& gfc_match_omp_variable_list ("present_or_copyout (",
&c->lists[OMP_LIST_PRESENT_OR_COPYOUT],
- true)
+ true, NULL, NULL, true)
== MATCH_YES)
continue;
if ((mask & OMP_CLAUSE_PRESENT_OR_COPYOUT)
&& gfc_match_omp_variable_list ("pcopyout (",
&c->lists[OMP_LIST_PRESENT_OR_COPYOUT],
- true)
+ true, NULL, NULL, true)
== MATCH_YES)
continue;
if ((mask & OMP_CLAUSE_PRESENT_OR_CREATE)
&& gfc_match_omp_variable_list ("present_or_create (",
&c->lists[OMP_LIST_PRESENT_OR_CREATE],
- true)
+ true, NULL, NULL, true)
== MATCH_YES)
continue;
if ((mask & OMP_CLAUSE_PRESENT_OR_CREATE)
&& gfc_match_omp_variable_list ("pcreate (",
&c->lists[OMP_LIST_PRESENT_OR_CREATE],
- true)
+ true, NULL, NULL, true)
== MATCH_YES)
continue;
if ((mask & OMP_CLAUSE_DEVICEPTR)
Grüße,
Thomas
[-- Attachment #2: Type: application/pgp-signature, Size: 472 bytes --]
^ permalink raw reply [flat|nested] 12+ messages in thread
* Re: FWD: Re: OpenACC subarray specifications in the GCC Fortran front end
2014-07-11 10:11 ` Thomas Schwinge
@ 2014-07-11 10:29 ` Jakub Jelinek
2014-07-24 0:57 ` Cesar Philippidis
0 siblings, 1 reply; 12+ messages in thread
From: Jakub Jelinek @ 2014-07-11 10:29 UTC (permalink / raw)
To: Thomas Schwinge
Cc: Cesar Philippidis, gcc-patches, fortran, Ilmir Usmanov, Ilmir Usmanov
On Fri, Jul 11, 2014 at 12:11:10PM +0200, Thomas Schwinge wrote:
> To avoid duplication of work: with Jakub's Fortran OpenMP 4 target
> changes recently committed to trunk, and now merged into gomp-4_0-branch,
> I have trimmed down Ilmir's patch to just the OpenACC bits, OpenMP 4
> target changes removed, and TODO markers added to integrate into that.
Resolving the TODO markers would be nice, indeed.
> Jakub, before your Fortran OpenMP 4 target changes, Ilmir had written the
> test case gcc/testsuite/gfortran.dg/gomp/map-1.f90 (based on his
> interpretation and implementation of OpenMP 4 target), which I have now
> amended with XFAILs and changed error messages -- anything in there that
> you'd like to see addressed for Fortran OpenMP 4 target?
> + !$omp target map(j(5:4)) ! { dg-error "Lower bound of OpenMP array section in greater than upper" "" { xfail *-*-* } }
> + !$omp end target
I think this isn't an error in Fortran, if low bound is above upper bound,
then it is considered a zero size array section. Though supposedly for
depend clause we might want to diagnose that.
> + !$omp target map(aas) ! { dg-error "The upper bound in the last dimension must appear" "" { xfail *-*-* } }
> + !$omp end target
Assumed-size in map without array section would be indeed nice thing to
diagnose.
> + !$omp target map(tt%i) ! { dg-error "Syntax error in OpenMP variable list" }
> + !$omp end target ! { dg-bogus "Unexpected !\\\$OMP END TARGET statement" "" { xfail *-*-* } }
Right now the parsing of !$omp directives in case of parsing error rejects
the whole directive, perhaps it should be reconsidered unless it is a fatal
error from which there is no easy way out.
> + !$omp target map(tt%j(1)) ! { dg-bogus "Syntax error in OpenMP variable list" "" { xfail *-*-* } }
> + !$omp end target ! { dg-bogus "Unexpected !\\\$OMP END TARGET statement" "" { xfail *-*-* } }
> +
> + !$omp target map(tt%j(1:)) ! { dg-bogus "Syntax error in OpenMP variable list" "" { xfail *-*-* } }
> + !$omp end target ! { dg-bogus "Unexpected !\\\$OMP END TARGET statement" "" { xfail *-*-* } }
These two are pending resolution on omp-lang, I had exchanged a few mails
about it, I think we shouldn't support those for consistency with the C/C++
support, where tt.j[1] or tt.j[1:] and similar is explicitly invalid.
Jakub
^ permalink raw reply [flat|nested] 12+ messages in thread
* Re: FWD: Re: OpenACC subarray specifications in the GCC Fortran front end
2014-07-11 10:29 ` Jakub Jelinek
@ 2014-07-24 0:57 ` Cesar Philippidis
2014-07-24 13:16 ` Thomas Schwinge
2014-08-01 7:48 ` Jakub Jelinek
0 siblings, 2 replies; 12+ messages in thread
From: Cesar Philippidis @ 2014-07-24 0:57 UTC (permalink / raw)
To: Jakub Jelinek, Thomas Schwinge
Cc: gcc-patches, fortran, Ilmir Usmanov, Ilmir Usmanov
[-- Attachment #1: Type: text/plain, Size: 2858 bytes --]
On 07/11/2014 03:29 AM, Jakub Jelinek wrote:
> On Fri, Jul 11, 2014 at 12:11:10PM +0200, Thomas Schwinge wrote:
>> To avoid duplication of work: with Jakub's Fortran OpenMP 4 target
>> changes recently committed to trunk, and now merged into gomp-4_0-branch,
>> I have trimmed down Ilmir's patch to just the OpenACC bits, OpenMP 4
>> target changes removed, and TODO markers added to integrate into that.
>
> Resolving the TODO markers would be nice, indeed.
This patch has the openacc data clauses use the new openmp maps. In the
process of doing so, I removed a lot of the old OMP_LIST_ enums and
added a few OMP_MAP enums to match what the c frontend currently supports.
Thomas, is this OK for gomp-4_0-branch? There are no new regressions.
This patch doesn't depend on the nested function patch I posted a while ago.
>> Jakub, before your Fortran OpenMP 4 target changes, Ilmir had written the
>> test case gcc/testsuite/gfortran.dg/gomp/map-1.f90 (based on his
>> interpretation and implementation of OpenMP 4 target), which I have now
>> amended with XFAILs and changed error messages -- anything in there that
>> you'd like to see addressed for Fortran OpenMP 4 target?
>
>> + !$omp target map(j(5:4)) ! { dg-error "Lower bound of OpenMP array section in greater than upper" "" { xfail *-*-* } }
>> + !$omp end target
>
> I think this isn't an error in Fortran, if low bound is above upper bound,
> then it is considered a zero size array section. Though supposedly for
> depend clause we might want to diagnose that.
>
>> + !$omp target map(aas) ! { dg-error "The upper bound in the last dimension must appear" "" { xfail *-*-* } }
>> + !$omp end target
>
> Assumed-size in map without array section would be indeed nice thing to
> diagnose.
>
>> + !$omp target map(tt%i) ! { dg-error "Syntax error in OpenMP variable list" }
>> + !$omp end target ! { dg-bogus "Unexpected !\\\$OMP END TARGET statement" "" { xfail *-*-* } }
>
> Right now the parsing of !$omp directives in case of parsing error rejects
> the whole directive, perhaps it should be reconsidered unless it is a fatal
> error from which there is no easy way out.
>
>> + !$omp target map(tt%j(1)) ! { dg-bogus "Syntax error in OpenMP variable list" "" { xfail *-*-* } }
>> + !$omp end target ! { dg-bogus "Unexpected !\\\$OMP END TARGET statement" "" { xfail *-*-* } }
>> +
>> + !$omp target map(tt%j(1:)) ! { dg-bogus "Syntax error in OpenMP variable list" "" { xfail *-*-* } }
>> + !$omp end target ! { dg-bogus "Unexpected !\\\$OMP END TARGET statement" "" { xfail *-*-* } }
>
> These two are pending resolution on omp-lang, I had exchanged a few mails
> about it, I think we shouldn't support those for consistency with the C/C++
> support, where tt.j[1] or tt.j[1:] and similar is explicitly invalid.
Jakub, should I drop the map-1.f90 test?
Thanks,
Cesar
[-- Attachment #2: subarrays-mappings-gcc.diff --]
[-- Type: text/x-patch, Size: 37653 bytes --]
2014-07-23 Cesar Philippidis <cesar@codesourcery.com>
Thomas Schwinge <thomas@codesourcery.com>
Ilmir Usmanov <i.usmanov@samsung.com>
gcc/fortran/
* gfortran.h (gfc_omp_map_op): Add OMP_MAP_TOFROM,
OMP_MAP_FORCE_ALLOC, OMP_MAP_FORCE_DEALLOC, OMP_MAP_FORCE_TO,
OMP_MAP_FORCE_FROM, OMP_MAP_FORCE_TOFROM, OMP_MAP_FORCE_PRESENT.
(enum) Remove OMP_LIST_OACC_COPYIN, OMP_LIST_COPYOUT,
OMP_LIST_CREATE, OMP_LIST_DELETE, OMP_LIST_PRESENT,
OMP_LIST_PRESENT_OR_COPY, OMP_LIST_PRESENT_OR_COPYIN,
OMP_LIST_PRESENT_OR_COPYOUT, OMP_LIST_PRESENT_OR_CREATE.
* dump-parse-tree.c (show_omp_clauses): Remove handling of
OMP_LIST_OACC_COPYIN, OMP_LIST_COPYOUT, OMP_LIST_CREATE,
OMP_LIST_DELETE, OMP_LIST_PRESENT, OMP_LIST_PRESENT_OR_COPY,
OMP_LIST_PRESENT_OR_COPYIN, OMP_LIST_PRESENT_OR_COPYOUT,
OMP_LIST_PRESENT_OR_CREATE.
* openmp.c (OMP_CLAUSE_OACC_COPYIN): Remove define.
(gfc_match_omp_map_clause): New function.
(gfc_match_oacc_data_clauses): New function.
(gfc_match_omp_data_clauses): New function.
(gfc_match_omp_clauses): And an openacc argument. Treat openacc
data clauses as OMP maps.
(gfc_match_oacc_parallel_loop): Call gfc_match_omp_clauses with
the openacc parameter as true.
(gfc_match_oacc_parallel): Likewise.
(gfc_match_oacc_kernels_loop): Likewise.
(gfc_match_oacc_kernels): LIkewise.
(gfc_match_oacc_data): Likewise.
(gfc_match_oacc_host_data): Likewise.
(gfc_match_oacc_loop): Likewise.
(gfc_match_oacc_declare): Likewise.
(gfc_match_oacc_update): Likewise.
(gfc_match_oacc_enter_data): Likwise.
(gfc_match_oacc_exit_data): Likewise.
(resolve_omp_clauses): New openacc argument. Call
resolve_oacc_data_clauses to check additional errors.
(resolve_oacc_loop): Update call to resolve_omp_clauses.
(resolve_oacc_wait): Likewise.
(gfc_resolve_oacc_declare): Likewise.
(gfc_resolve_oacc_directive): Likewise.
* trans-openmp.c (gfc_trans_omp_clauses): Remove
OMP_LIST_OACC_COPYIN, OMP_LIST_COPYOUT, OMP_LIST_CREATE,
OMP_LIST_DELETE, OMP_LIST_PRESENT, OMP_LIST_PRESENT_OR_COPY,
OMP_LIST_PRESENT_OR_COPYIN, OMP_LIST_PRESENT_OR_COPYOUT,
OMP_LIST_PRESENT_OR_CREATE switch items.
gcc/testsuite/
* gfortran.dg/goacc/subarrays.f95: New test.
* gfortran.dg/gomp/map-1.f90: New test.
diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c
index c367139..d7f2182 100644
--- a/gcc/fortran/dump-parse-tree.c
+++ b/gcc/fortran/dump-parse-tree.c
@@ -1258,15 +1258,6 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses)
switch (list_type)
{
case OMP_LIST_COPY: type = "COPY"; break;
- case OMP_LIST_OACC_COPYIN: type = "COPYIN"; break;
- case OMP_LIST_COPYOUT: type = "COPYOUT"; break;
- case OMP_LIST_CREATE: type = "CREATE"; break;
- case OMP_LIST_DELETE: type = "DELETE"; break;
- case OMP_LIST_PRESENT: type = "PRESENT"; break;
- case OMP_LIST_PRESENT_OR_COPY: type = "PRESENT_OR_COPY"; break;
- case OMP_LIST_PRESENT_OR_COPYIN: type = "PRESENT_OR_COPYIN"; break;
- case OMP_LIST_PRESENT_OR_COPYOUT: type = "PRESENT_OR_COPYOUT"; break;
- case OMP_LIST_PRESENT_OR_CREATE: type = "PRESENT_OR_CREATE"; break;
case OMP_LIST_DEVICEPTR: type = "DEVICEPTR"; break;
case OMP_LIST_USE_DEVICE: type = "USE_DEVICE"; break;
case OMP_LIST_DEVICE_RESIDENT: type = "USE_DEVICE"; break;
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index cc445e6..0cde668 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -1111,7 +1111,13 @@ typedef enum
OMP_MAP_ALLOC,
OMP_MAP_TO,
OMP_MAP_FROM,
- OMP_MAP_TOFROM
+ OMP_MAP_TOFROM,
+ OMP_MAP_FORCE_ALLOC,
+ OMP_MAP_FORCE_DEALLOC,
+ OMP_MAP_FORCE_TO,
+ OMP_MAP_FORCE_FROM,
+ OMP_MAP_FORCE_TOFROM,
+ OMP_MAP_FORCE_PRESENT
}
gfc_omp_map_op;
@@ -1153,15 +1159,6 @@ enum
OMP_LIST_REDUCTION,
OMP_LIST_COPY,
OMP_LIST_DATA_CLAUSE_FIRST = OMP_LIST_COPY,
- OMP_LIST_OACC_COPYIN,
- OMP_LIST_COPYOUT,
- OMP_LIST_CREATE,
- OMP_LIST_DELETE,
- OMP_LIST_PRESENT,
- OMP_LIST_PRESENT_OR_COPY,
- OMP_LIST_PRESENT_OR_COPYIN,
- OMP_LIST_PRESENT_OR_COPYOUT,
- OMP_LIST_PRESENT_OR_CREATE,
OMP_LIST_DEVICEPTR,
OMP_LIST_DATA_CLAUSE_LAST = OMP_LIST_DEVICEPTR,
OMP_LIST_DEVICE_RESIDENT,
diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index 7b87e78..785456c 100644
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -448,18 +448,177 @@ match_oacc_clause_gang (gfc_omp_clauses *cp)
#define OMP_CLAUSE_DEVICE_RESIDENT (1ULL << 51)
#define OMP_CLAUSE_HOST (1ULL << 52)
#define OMP_CLAUSE_OACC_DEVICE (1ULL << 53)
-#define OMP_CLAUSE_OACC_COPYIN (1ULL << 54)
-#define OMP_CLAUSE_WAIT (1ULL << 55)
-#define OMP_CLAUSE_DELETE (1ULL << 56)
-#define OMP_CLAUSE_AUTO (1ULL << 57)
-#define OMP_CLAUSE_TILE (1ULL << 58)
+#define OMP_CLAUSE_WAIT (1ULL << 54)
+#define OMP_CLAUSE_DELETE (1ULL << 55)
+#define OMP_CLAUSE_AUTO (1ULL << 56)
+#define OMP_CLAUSE_TILE (1ULL << 57)
+
+/* 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_omp_namelist **head = NULL;
+ if (gfc_match_omp_variable_list ("", list, false, NULL, &head, true)
+ == MATCH_YES)
+ {
+ gfc_omp_namelist *n;
+ for (n = *head; n; n = n->next)
+ n->u.map_op = map_op;
+ return true;
+ }
+
+ return false;
+}
+
+/* Match OpenACC data clauses. */
+
+static bool
+gfc_match_oacc_data_clauses (unsigned long long mask, gfc_omp_clauses *c)
+{
+ if ((mask & OMP_CLAUSE_COPYIN)
+ && gfc_match ("copyin ( ") == MATCH_YES
+ && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
+ OMP_MAP_FORCE_TO))
+ return true;
+ if ((mask & OMP_CLAUSE_COPY)
+ && gfc_match ("copy ( ") == MATCH_YES
+ && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
+ OMP_MAP_FORCE_TOFROM))
+ return true;
+ if ((mask & OMP_CLAUSE_COPYOUT)
+ && gfc_match ("copyout ( ") == MATCH_YES
+ && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
+ OMP_MAP_FORCE_FROM))
+ return true;
+ if ((mask & OMP_CLAUSE_CREATE)
+ && gfc_match ("create ( ") == MATCH_YES
+ && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
+ OMP_MAP_FORCE_ALLOC))
+ return true;
+ if ((mask & OMP_CLAUSE_DELETE)
+ && gfc_match ("delete ( ") == MATCH_YES
+ && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
+ OMP_MAP_FORCE_DEALLOC))
+ return true;
+ if ((mask & OMP_CLAUSE_PRESENT)
+ && gfc_match ("present ( ") == MATCH_YES
+ && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
+ OMP_MAP_FORCE_PRESENT))
+ return true;
+ if ((mask & OMP_CLAUSE_PRESENT_OR_COPY)
+ && gfc_match ("present_or_copy ( ") == MATCH_YES
+ && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
+ OMP_MAP_TOFROM))
+ return true;
+ if ((mask & OMP_CLAUSE_PRESENT_OR_COPY)
+ && gfc_match ("pcopy ( ") == MATCH_YES
+ && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
+ OMP_MAP_TOFROM))
+ return true;
+ if ((mask & OMP_CLAUSE_PRESENT_OR_COPYIN)
+ && gfc_match ("present_or_copyin ( ") == MATCH_YES
+ && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
+ OMP_MAP_TO))
+ return true;
+ if ((mask & OMP_CLAUSE_PRESENT_OR_COPYIN)
+ && gfc_match ("pcopyin ( ") == MATCH_YES
+ && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
+ OMP_MAP_TO))
+ return true;
+ if ((mask & OMP_CLAUSE_PRESENT_OR_COPYOUT)
+ && gfc_match ("present_or_copyout ( ") == MATCH_YES
+ && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
+ OMP_MAP_FROM))
+ return true;
+ if ((mask & OMP_CLAUSE_PRESENT_OR_COPYOUT)
+ && gfc_match ("pcopyout ( ") == MATCH_YES
+ && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
+ OMP_MAP_FROM))
+ return true;
+ if ((mask & OMP_CLAUSE_PRESENT_OR_CREATE)
+ && gfc_match ("present_or_create ( ") == MATCH_YES
+ && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
+ OMP_MAP_ALLOC))
+ return true;
+ if ((mask & OMP_CLAUSE_PRESENT_OR_CREATE)
+ && gfc_match ("pcreate ( ") == MATCH_YES
+ && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
+ OMP_MAP_ALLOC))
+ return true;
+ /* TODO */
+ if ((mask & OMP_CLAUSE_DEVICEPTR)
+ && gfc_match_omp_variable_list ("deviceptr (",
+ &c->lists[OMP_LIST_DEVICEPTR], true)
+ == MATCH_YES)
+ return true;
+ /* TODO */
+ if ((mask & OMP_CLAUSE_HOST)
+ && gfc_match_omp_variable_list ("host (",
+ &c->lists[OMP_LIST_HOST], true)
+ == MATCH_YES)
+ return true;
+ /* TODO */
+ if ((mask & OMP_CLAUSE_OACC_DEVICE)
+ && gfc_match_omp_variable_list ("device (",
+ &c->lists[OMP_LIST_DEVICE], true)
+ == MATCH_YES)
+ return true;
+
+ return false;
+}
+
+/* Match OpenMP data clauses. */
+
+static bool
+gfc_match_omp_data_clauses (unsigned long long mask, gfc_omp_clauses *c)
+{
+ if ((mask & OMP_CLAUSE_COPYIN)
+ && gfc_match_omp_variable_list ("copyin (",
+ &c->lists[OMP_LIST_COPYIN], true)
+ == MATCH_YES)
+ return true;
+ if ((mask & OMP_CLAUSE_COPY)
+ && gfc_match_omp_variable_list ("copy (",
+ &c->lists[OMP_LIST_COPY], true)
+ == MATCH_YES)
+ return true;
+ if (mask & OMP_CLAUSE_COPYOUT)
+ gfc_error ("Invalid OpenMP clause COPYOUT");
+ if (mask & OMP_CLAUSE_CREATE)
+ gfc_error ("Invalid OpenMP clause CREATE");
+ if (mask & OMP_CLAUSE_DELETE)
+ gfc_error ("Invalid OpenMP clause DELETE");
+ if (mask & OMP_CLAUSE_PRESENT)
+ gfc_error ("Invalid OpenMP clause PRESENT");
+ if (mask & OMP_CLAUSE_PRESENT_OR_COPY)
+ gfc_error ("Invalid OpenMP clause PRESENT_OR_COPY");
+ if (mask & OMP_CLAUSE_PRESENT_OR_COPY)
+ gfc_error ("Invalid OpenMP clause PRESENT_OR_COPY");
+ if (mask & OMP_CLAUSE_PRESENT_OR_COPYIN)
+ gfc_error ("Invalid OpenMP clause PRESENT_OR_COPYIN");
+ if (mask & OMP_CLAUSE_PRESENT_OR_COPYIN)
+ gfc_error ("Invalid OpenMP clause PRESENT_OR_COPYIN");
+ if (mask & OMP_CLAUSE_PRESENT_OR_COPYOUT)
+ gfc_error ("Invalid OpenMP clause PRESENT_OR_COPYOUT");
+ if (mask & OMP_CLAUSE_PRESENT_OR_COPYOUT)
+ gfc_error ("Invalid OpenMP clause PRESENT_OR_COPYOUT");
+ if (mask & OMP_CLAUSE_PRESENT_OR_CREATE)
+ gfc_error ("Invalid OpenMP clause PRESENT_OR_CREATE");
+ if (mask & OMP_CLAUSE_PRESENT_OR_CREATE)
+ gfc_error ("Invalid OpenMP clause PRESENT_OR_CREATE");
+
+ return false;
+}
/* Match OpenMP and OpenACC directive clauses. MASK is a bitmask of
clauses that are allowed for a particular directive. */
static match
gfc_match_omp_clauses (gfc_omp_clauses **cp, unsigned long long mask,
- bool first = true, bool needs_space = true)
+ bool first = true, bool needs_space = true,
+ bool openacc = false)
{
gfc_omp_clauses *c = gfc_get_omp_clauses ();
locus old_loc;
@@ -533,181 +692,109 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, unsigned long long mask,
if ((mask & OMP_CLAUSE_NUM_THREADS) && c->num_threads == NULL
&& gfc_match ("num_threads ( %e )", &c->num_threads) == MATCH_YES)
continue;
+ if ((mask & OMP_CLAUSE_NUM_GANGS) && c->num_gangs_expr == NULL
+ && gfc_match ("num_gangs ( %e )", &c->num_gangs_expr) == MATCH_YES)
+ continue;
+ if ((mask & OMP_CLAUSE_NUM_WORKERS) && c->num_workers_expr == NULL
+ && gfc_match ("num_workers ( %e )", &c->num_workers_expr)
+ == MATCH_YES)
+ continue;
+ if ((mask & OMP_CLAUSE_TILE)
+ && match_oacc_expr_list ("tile (", &c->tile_list, true) == MATCH_YES)
+ continue;
+ if ((mask & OMP_CLAUSE_SEQ) && !c->seq
+ && gfc_match ("seq") == MATCH_YES)
+ {
+ c->seq = true;
+ needs_space = true;
+ continue;
+ }
+ if ((mask & OMP_CLAUSE_INDEPENDENT) && !c->independent
+ && gfc_match ("independent") == MATCH_YES)
+ {
+ c->independent = true;
+ needs_space = true;
+ continue;
+ }
+ if ((mask & OMP_CLAUSE_AUTO) && !c->par_auto
+ && gfc_match ("auto") == MATCH_YES)
+ {
+ c->par_auto = true;
+ needs_space = true;
+ continue;
+ }
+ if ((mask & OMP_CLAUSE_WAIT) && !c->wait
+ && gfc_match ("wait") == MATCH_YES)
+ {
+ c->wait = true;
+ match_oacc_expr_list (" (", &c->wait_list, false);
+ continue;
+ }
+ /* Common, in the sense that no special handling is required,
+ OpenACC and OpenMP data clauses. */
if ((mask & OMP_CLAUSE_PRIVATE)
&& gfc_match_omp_variable_list ("private (",
&c->lists[OMP_LIST_PRIVATE], true)
- == MATCH_YES)
+ == MATCH_YES)
continue;
if ((mask & OMP_CLAUSE_FIRSTPRIVATE)
&& gfc_match_omp_variable_list ("firstprivate (",
&c->lists[OMP_LIST_FIRSTPRIVATE],
true)
- == MATCH_YES)
+ == MATCH_YES)
continue;
if ((mask & OMP_CLAUSE_LASTPRIVATE)
&& gfc_match_omp_variable_list ("lastprivate (",
&c->lists[OMP_LIST_LASTPRIVATE],
true)
- == MATCH_YES)
+ == MATCH_YES)
continue;
if ((mask & OMP_CLAUSE_COPYPRIVATE)
&& gfc_match_omp_variable_list ("copyprivate (",
&c->lists[OMP_LIST_COPYPRIVATE],
true)
- == MATCH_YES)
+ == MATCH_YES)
continue;
if ((mask & OMP_CLAUSE_SHARED)
&& gfc_match_omp_variable_list ("shared (",
&c->lists[OMP_LIST_SHARED], true)
- == MATCH_YES)
- continue;
- if ((mask & OMP_CLAUSE_COPYIN)
- && gfc_match_omp_variable_list ("copyin (",
- &c->lists[OMP_LIST_COPYIN], true)
- == MATCH_YES)
- continue;
- if ((mask & OMP_CLAUSE_NUM_GANGS) && c->num_gangs_expr == NULL
- && gfc_match ("num_gangs ( %e )", &c->num_gangs_expr) == MATCH_YES)
- continue;
- if ((mask & OMP_CLAUSE_NUM_WORKERS) && c->num_workers_expr == NULL
- && gfc_match ("num_workers ( %e )", &c->num_workers_expr)
== MATCH_YES)
continue;
- if ((mask & OMP_CLAUSE_COPY)
- && gfc_match_omp_variable_list ("copy (",
- &c->lists[OMP_LIST_COPY], true)
- == MATCH_YES)
- continue;
- if ((mask & OMP_CLAUSE_OACC_COPYIN)
- && gfc_match_omp_variable_list ("copyin (",
- &c->lists[OMP_LIST_OACC_COPYIN], true)
- == MATCH_YES)
- continue;
- if ((mask & OMP_CLAUSE_COPYOUT)
- && gfc_match_omp_variable_list ("copyout (",
- &c->lists[OMP_LIST_COPYOUT], true)
- == MATCH_YES)
- continue;
- if ((mask & OMP_CLAUSE_CREATE)
- && gfc_match_omp_variable_list ("create (",
- &c->lists[OMP_LIST_CREATE], true)
- == MATCH_YES)
- continue;
- if ((mask & OMP_CLAUSE_DELETE)
- && gfc_match_omp_variable_list ("delete (",
- &c->lists[OMP_LIST_DELETE], true)
- == MATCH_YES)
- continue;
- if ((mask & OMP_CLAUSE_PRESENT)
- && gfc_match_omp_variable_list ("present (",
- &c->lists[OMP_LIST_PRESENT], true)
- == MATCH_YES)
- continue;
- if ((mask & OMP_CLAUSE_PRESENT_OR_COPY)
- && gfc_match_omp_variable_list ("present_or_copy (",
- &c->lists[OMP_LIST_PRESENT_OR_COPY],
- true)
- == MATCH_YES)
- continue;
- if ((mask & OMP_CLAUSE_PRESENT_OR_COPY)
- && gfc_match_omp_variable_list ("pcopy (",
- &c->lists[OMP_LIST_PRESENT_OR_COPY],
- true)
- == MATCH_YES)
- continue;
- if ((mask & OMP_CLAUSE_PRESENT_OR_COPYIN)
- && gfc_match_omp_variable_list ("present_or_copyin (",
- &c->lists[OMP_LIST_PRESENT_OR_COPYIN],
- true)
- == MATCH_YES)
- continue;
- if ((mask & OMP_CLAUSE_PRESENT_OR_COPYIN)
- && gfc_match_omp_variable_list ("pcopyin (",
- &c->lists[OMP_LIST_PRESENT_OR_COPYIN],
- true)
- == MATCH_YES)
- continue;
- if ((mask & OMP_CLAUSE_PRESENT_OR_COPYOUT)
- && gfc_match_omp_variable_list ("present_or_copyout (",
- &c->lists[OMP_LIST_PRESENT_OR_COPYOUT],
- true)
- == MATCH_YES)
- continue;
- if ((mask & OMP_CLAUSE_PRESENT_OR_COPYOUT)
- && gfc_match_omp_variable_list ("pcopyout (",
- &c->lists[OMP_LIST_PRESENT_OR_COPYOUT],
- true)
- == MATCH_YES)
- continue;
- if ((mask & OMP_CLAUSE_PRESENT_OR_CREATE)
- && gfc_match_omp_variable_list ("present_or_create (",
- &c->lists[OMP_LIST_PRESENT_OR_CREATE],
- true)
- == MATCH_YES)
- continue;
- if ((mask & OMP_CLAUSE_PRESENT_OR_CREATE)
- && gfc_match_omp_variable_list ("pcreate (",
- &c->lists[OMP_LIST_PRESENT_OR_CREATE],
- true)
- == MATCH_YES)
+ if ((mask & OMP_CLAUSE_USE_DEVICE)
+ && gfc_match_omp_variable_list ("use_device (",
+ &c->lists[OMP_LIST_USE_DEVICE], true)
+ == MATCH_YES)
continue;
if ((mask & OMP_CLAUSE_DEVICEPTR)
&& gfc_match_omp_variable_list ("deviceptr (",
&c->lists[OMP_LIST_DEVICEPTR], true)
- == MATCH_YES)
- continue;
- if ((mask & OMP_CLAUSE_USE_DEVICE)
- && gfc_match_omp_variable_list ("use_device (",
- &c->lists[OMP_LIST_USE_DEVICE], true)
- == MATCH_YES)
+ == MATCH_YES)
continue;
if ((mask & OMP_CLAUSE_DEVICE_RESIDENT)
&& gfc_match_omp_variable_list ("device_resident (",
&c->lists[OMP_LIST_DEVICE_RESIDENT],
true)
- == MATCH_YES)
+ == MATCH_YES)
continue;
if ((mask & OMP_CLAUSE_HOST)
&& gfc_match_omp_variable_list ("host (",
&c->lists[OMP_LIST_HOST], true)
- == MATCH_YES)
+ == MATCH_YES)
continue;
if ((mask & OMP_CLAUSE_OACC_DEVICE)
&& gfc_match_omp_variable_list ("device (",
&c->lists[OMP_LIST_DEVICE], true)
- == MATCH_YES)
- continue;
- if ((mask & OMP_CLAUSE_TILE)
- && match_oacc_expr_list ("tile (", &c->tile_list, true) == MATCH_YES)
+ == MATCH_YES)
continue;
- if ((mask & OMP_CLAUSE_SEQ) && !c->seq
- && gfc_match ("seq") == MATCH_YES)
+ /* Both OpenACC and OpenMP handle the data clauses a bit differently.
+ Process them separately. */
+ if (openacc)
{
- c->seq = true;
- needs_space = true;
- continue;
- }
- if ((mask & OMP_CLAUSE_INDEPENDENT) && !c->independent
- && gfc_match ("independent") == MATCH_YES)
- {
- c->independent = true;
- needs_space = true;
- continue;
- }
- if ((mask & OMP_CLAUSE_AUTO) && !c->par_auto
- && gfc_match ("auto") == MATCH_YES)
- {
- c->par_auto = true;
- needs_space = true;
- continue;
- }
- if ((mask & OMP_CLAUSE_WAIT) && !c->wait
- && gfc_match ("wait") == MATCH_YES)
- {
- c->wait = true;
- match_oacc_expr_list (" (", &c->wait_list, false);
- continue;
+ if (gfc_match_oacc_data_clauses (mask, c))
+ continue;
}
+ else if (gfc_match_omp_data_clauses (mask, c))
+ continue;
old_loc = gfc_current_locus;
if ((mask & OMP_CLAUSE_REDUCTION)
&& gfc_match ("reduction ( ") == MATCH_YES)
@@ -1112,20 +1199,20 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, unsigned long long mask,
#define OACC_PARALLEL_CLAUSES \
(OMP_CLAUSE_IF | OMP_CLAUSE_ASYNC | OMP_CLAUSE_NUM_GANGS \
| OMP_CLAUSE_NUM_WORKERS | OMP_CLAUSE_VECTOR_LENGTH | OMP_CLAUSE_REDUCTION \
- | OMP_CLAUSE_COPY | OMP_CLAUSE_OACC_COPYIN | OMP_CLAUSE_COPYOUT \
+ | 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_DEVICEPTR | OMP_CLAUSE_PRIVATE \
| OMP_CLAUSE_FIRSTPRIVATE | OMP_CLAUSE_DEFAULT | OMP_CLAUSE_WAIT)
#define OACC_KERNELS_CLAUSES \
(OMP_CLAUSE_IF | OMP_CLAUSE_ASYNC | OMP_CLAUSE_DEVICEPTR \
- | OMP_CLAUSE_COPY | OMP_CLAUSE_OACC_COPYIN | OMP_CLAUSE_COPYOUT \
+ | 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)
#define OACC_DATA_CLAUSES \
(OMP_CLAUSE_IF | OMP_CLAUSE_DEVICEPTR | OMP_CLAUSE_COPY \
- | OMP_CLAUSE_OACC_COPYIN | OMP_CLAUSE_COPYOUT | OMP_CLAUSE_CREATE \
+ | 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)
@@ -1140,7 +1227,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, unsigned long long mask,
(OACC_LOOP_CLAUSES | OACC_KERNELS_CLAUSES)
#define OACC_HOST_DATA_CLAUSES OMP_CLAUSE_USE_DEVICE
#define OACC_DECLARE_CLAUSES \
- (OMP_CLAUSE_COPY | OMP_CLAUSE_OACC_COPYIN | OMP_CLAUSE_COPYOUT \
+ (OMP_CLAUSE_COPY | OMP_CLAUSE_COPYIN | OMP_CLAUSE_COPYOUT \
| 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 \
@@ -1148,7 +1235,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, unsigned long long mask,
#define OACC_UPDATE_CLAUSES \
(OMP_CLAUSE_IF | OMP_CLAUSE_ASYNC | OMP_CLAUSE_HOST | OMP_CLAUSE_OACC_DEVICE)
#define OACC_ENTER_DATA_CLAUSES \
- (OMP_CLAUSE_IF | OMP_CLAUSE_ASYNC | OMP_CLAUSE_WAIT | OMP_CLAUSE_OACC_COPYIN \
+ (OMP_CLAUSE_IF | OMP_CLAUSE_ASYNC | OMP_CLAUSE_WAIT | OMP_CLAUSE_COPYIN \
| OMP_CLAUSE_CREATE | OMP_CLAUSE_PRESENT_OR_COPYIN \
| OMP_CLAUSE_PRESENT_OR_CREATE)
#define OACC_EXIT_DATA_CLAUSES \
@@ -1160,7 +1247,8 @@ match
gfc_match_oacc_parallel_loop (void)
{
gfc_omp_clauses *c;
- if (gfc_match_omp_clauses (&c, OACC_PARALLEL_LOOP_CLAUSES) != MATCH_YES)
+ if (gfc_match_omp_clauses (&c, OACC_PARALLEL_LOOP_CLAUSES, false, false,
+ true) != MATCH_YES)
return MATCH_ERROR;
new_st.op = EXEC_OACC_PARALLEL_LOOP;
@@ -1173,7 +1261,8 @@ match
gfc_match_oacc_parallel (void)
{
gfc_omp_clauses *c;
- if (gfc_match_omp_clauses (&c, OACC_PARALLEL_CLAUSES) != MATCH_YES)
+ if (gfc_match_omp_clauses (&c, OACC_PARALLEL_CLAUSES, false, false, true)
+ != MATCH_YES)
return MATCH_ERROR;
new_st.op = EXEC_OACC_PARALLEL;
@@ -1186,7 +1275,8 @@ match
gfc_match_oacc_kernels_loop (void)
{
gfc_omp_clauses *c;
- if (gfc_match_omp_clauses (&c, OACC_KERNELS_LOOP_CLAUSES) != MATCH_YES)
+ if (gfc_match_omp_clauses (&c, OACC_KERNELS_LOOP_CLAUSES, false, false,
+ true) != MATCH_YES)
return MATCH_ERROR;
new_st.op = EXEC_OACC_KERNELS_LOOP;
@@ -1199,7 +1289,8 @@ match
gfc_match_oacc_kernels (void)
{
gfc_omp_clauses *c;
- if (gfc_match_omp_clauses (&c, OACC_KERNELS_CLAUSES) != MATCH_YES)
+ if (gfc_match_omp_clauses (&c, OACC_KERNELS_CLAUSES, false, false, true)
+ != MATCH_YES)
return MATCH_ERROR;
new_st.op = EXEC_OACC_KERNELS;
@@ -1212,7 +1303,8 @@ match
gfc_match_oacc_data (void)
{
gfc_omp_clauses *c;
- if (gfc_match_omp_clauses (&c, OACC_DATA_CLAUSES) != MATCH_YES)
+ if (gfc_match_omp_clauses (&c, OACC_DATA_CLAUSES, false, false, true)
+ != MATCH_YES)
return MATCH_ERROR;
new_st.op = EXEC_OACC_DATA;
@@ -1225,7 +1317,8 @@ match
gfc_match_oacc_host_data (void)
{
gfc_omp_clauses *c;
- if (gfc_match_omp_clauses (&c, OACC_HOST_DATA_CLAUSES) != MATCH_YES)
+ if (gfc_match_omp_clauses (&c, OACC_HOST_DATA_CLAUSES, false, false, true)
+ != MATCH_YES)
return MATCH_ERROR;
new_st.op = EXEC_OACC_HOST_DATA;
@@ -1238,7 +1331,8 @@ match
gfc_match_oacc_loop (void)
{
gfc_omp_clauses *c;
- if (gfc_match_omp_clauses (&c, OACC_LOOP_CLAUSES) != MATCH_YES)
+ if (gfc_match_omp_clauses (&c, OACC_LOOP_CLAUSES, false, false, true)
+ != MATCH_YES)
return MATCH_ERROR;
new_st.op = EXEC_OACC_LOOP;
@@ -1251,7 +1345,8 @@ match
gfc_match_oacc_declare (void)
{
gfc_omp_clauses *c;
- if (gfc_match_omp_clauses (&c, OACC_DECLARE_CLAUSES) != MATCH_YES)
+ if (gfc_match_omp_clauses (&c, OACC_DECLARE_CLAUSES, false, false, true)
+ != MATCH_YES)
return MATCH_ERROR;
new_st.ext.omp_clauses = c;
@@ -1264,7 +1359,8 @@ match
gfc_match_oacc_update (void)
{
gfc_omp_clauses *c;
- if (gfc_match_omp_clauses (&c, OACC_UPDATE_CLAUSES) != MATCH_YES)
+ if (gfc_match_omp_clauses (&c, OACC_UPDATE_CLAUSES, false, false, true)
+ != MATCH_YES)
return MATCH_ERROR;
new_st.op = EXEC_OACC_UPDATE;
@@ -1277,7 +1373,8 @@ match
gfc_match_oacc_enter_data (void)
{
gfc_omp_clauses *c;
- if (gfc_match_omp_clauses (&c, OACC_ENTER_DATA_CLAUSES) != MATCH_YES)
+ if (gfc_match_omp_clauses (&c, OACC_ENTER_DATA_CLAUSES, false, false, true)
+ != MATCH_YES)
return MATCH_ERROR;
new_st.op = EXEC_OACC_ENTER_DATA;
@@ -1290,7 +1387,8 @@ match
gfc_match_oacc_exit_data (void)
{
gfc_omp_clauses *c;
- if (gfc_match_omp_clauses (&c, OACC_EXIT_DATA_CLAUSES) != MATCH_YES)
+ if (gfc_match_omp_clauses (&c, OACC_EXIT_DATA_CLAUSES, false, false, true)
+ != MATCH_YES)
return MATCH_ERROR;
new_st.op = EXEC_OACC_EXIT_DATA;
@@ -2692,7 +2790,8 @@ resolve_omp_udr_clause (gfc_omp_namelist *n, gfc_namespace *ns,
static void
resolve_omp_clauses (gfc_code *code, locus *where,
- gfc_omp_clauses *omp_clauses, gfc_namespace *ns)
+ gfc_omp_clauses *omp_clauses, gfc_namespace *ns,
+ bool openacc = false)
{
gfc_omp_namelist *n;
gfc_expr_list *el;
@@ -2794,7 +2893,7 @@ resolve_omp_clauses (gfc_code *code, locus *where,
&& list != OMP_LIST_LASTPRIVATE
&& list != OMP_LIST_ALIGNED
&& list != OMP_LIST_DEPEND
- && list != OMP_LIST_MAP
+ && (list != OMP_LIST_MAP || openacc)
&& list != OMP_LIST_FROM
&& list != OMP_LIST_TO)
for (n = omp_clauses->lists[list]; n; n = n->next)
@@ -2941,53 +3040,59 @@ resolve_omp_clauses (gfc_code *code, locus *where,
case OMP_LIST_TO:
case OMP_LIST_FROM:
for (; n != NULL; n = n->next)
- if (n->expr)
- {
- if (!gfc_resolve_expr (n->expr)
- || n->expr->expr_type != EXPR_VARIABLE
- || n->expr->ref == NULL
- || n->expr->ref->next
- || n->expr->ref->type != REF_ARRAY)
- gfc_error ("'%s' in %s clause at %L is not a proper "
- "array section", n->sym->name, name, where);
- else if (n->expr->ref->u.ar.codimen)
- gfc_error ("Coarrays not supported in %s clause at %L",
- name, where);
- else
- {
- int i;
- gfc_array_ref *ar = &n->expr->ref->u.ar;
- for (i = 0; i < ar->dimen; i++)
- if (ar->stride[i])
- {
- gfc_error ("Stride should not be specified for "
- "array section in %s clause at %L",
- name, where);
- break;
- }
- else if (ar->dimen_type[i] != DIMEN_ELEMENT
- && ar->dimen_type[i] != DIMEN_RANGE)
- {
- gfc_error ("'%s' in %s clause at %L is not a "
- "proper array section",
- n->sym->name, name, where);
- break;
- }
- else if (list == OMP_LIST_DEPEND
- && ar->start[i]
- && ar->start[i]->expr_type == EXPR_CONSTANT
- && ar->end[i]
- && ar->end[i]->expr_type == EXPR_CONSTANT
- && mpz_cmp (ar->start[i]->value.integer,
- ar->end[i]->value.integer) > 0)
- {
- gfc_error ("'%s' in DEPEND clause at %L is a zero "
- "size array section", n->sym->name,
- where);
- break;
- }
- }
- }
+ {
+ if (n->expr)
+ {
+ if (!gfc_resolve_expr (n->expr)
+ || n->expr->expr_type != EXPR_VARIABLE
+ || n->expr->ref == NULL
+ || n->expr->ref->next
+ || n->expr->ref->type != REF_ARRAY)
+ gfc_error ("'%s' in %s clause at %L is not a proper "
+ "array section", n->sym->name, name, where);
+ else if (n->expr->ref->u.ar.codimen)
+ gfc_error ("Coarrays not supported in %s clause at %L",
+ name, where);
+ else
+ {
+ int i;
+ gfc_array_ref *ar = &n->expr->ref->u.ar;
+ for (i = 0; i < ar->dimen; i++)
+ if (ar->stride[i])
+ {
+ gfc_error ("Stride should not be specified for "
+ "array section in %s clause at %L",
+ name, where);
+ break;
+ }
+ else if (ar->dimen_type[i] != DIMEN_ELEMENT
+ && ar->dimen_type[i] != DIMEN_RANGE)
+ {
+ gfc_error ("'%s' in %s clause at %L is not a "
+ "proper array section",
+ n->sym->name, name, where);
+ break;
+ }
+ else if (list == OMP_LIST_DEPEND
+ && ar->start[i]
+ && ar->start[i]->expr_type == EXPR_CONSTANT
+ && ar->end[i]
+ && ar->end[i]->expr_type == EXPR_CONSTANT
+ && mpz_cmp (ar->start[i]->value.integer,
+ ar->end[i]->value.integer) > 0)
+ {
+ gfc_error ("'%s' in DEPEND clause at %L is a "
+ "zero size array section",
+ n->sym->name, where);
+ break;
+ }
+ }
+ }
+ else if (openacc)
+ resolve_oacc_data_clauses (n->sym, *where,
+ clause_names[list]);
+ }
+
if (list != OMP_LIST_DEPEND)
for (n = omp_clauses->lists[list]; n != NULL; n = n->next)
{
@@ -4407,7 +4512,7 @@ resolve_oacc_loop(gfc_code *code)
int collapse;
if (code->ext.omp_clauses)
- resolve_omp_clauses (code, &code->loc, code->ext.omp_clauses, NULL);
+ resolve_omp_clauses (code, &code->loc, code->ext.omp_clauses, NULL, true);
do_code = code->block->next;
collapse = code->ext.omp_clauses->collapse;
@@ -4434,7 +4539,6 @@ resolve_oacc_wait (gfc_code *code)
resolve_oacc_positive_int_expr (el->expr, "WAIT");
}
-
void
gfc_resolve_oacc_declare (gfc_namespace *ns)
{
@@ -4451,6 +4555,7 @@ gfc_resolve_oacc_declare (gfc_namespace *ns)
loc = ns->oacc_declare_clauses->ext.loc;
+ /* FIXME: handle omp_list_map. */
for (list = OMP_LIST_DATA_CLAUSE_FIRST;
list <= OMP_LIST_DEVICE_RESIDENT; list++)
for (n = ns->oacc_declare_clauses->lists[list]; n; n = n->next)
@@ -4507,7 +4612,8 @@ gfc_resolve_oacc_directive (gfc_code *code, gfc_namespace *ns ATTRIBUTE_UNUSED)
case EXEC_OACC_UPDATE:
case EXEC_OACC_ENTER_DATA:
case EXEC_OACC_EXIT_DATA:
- resolve_omp_clauses (code, &code->loc, code->ext.omp_clauses, NULL);
+ resolve_omp_clauses (code, &code->loc, code->ext.omp_clauses, NULL,
+ true);
break;
case EXEC_OACC_PARALLEL_LOOP:
case EXEC_OACC_KERNELS_LOOP:
diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
index aaf50d3..5f61877 100644
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -1743,36 +1743,6 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
enum omp_clause_map_kind kind;
switch (list)
{
- case OMP_LIST_COPY:
- kind = OMP_CLAUSE_MAP_FORCE_TOFROM;
- break;
- case OMP_LIST_OACC_COPYIN:
- kind = OMP_CLAUSE_MAP_FORCE_TO;
- break;
- case OMP_LIST_COPYOUT:
- kind = OMP_CLAUSE_MAP_FORCE_FROM;
- break;
- case OMP_LIST_CREATE:
- kind = OMP_CLAUSE_MAP_FORCE_ALLOC;
- break;
- case OMP_LIST_DELETE:
- kind = OMP_CLAUSE_MAP_FORCE_DEALLOC;
- break;
- case OMP_LIST_PRESENT:
- kind = OMP_CLAUSE_MAP_FORCE_PRESENT;
- break;
- case OMP_LIST_PRESENT_OR_COPY:
- kind = OMP_CLAUSE_MAP_TOFROM;
- break;
- case OMP_LIST_PRESENT_OR_COPYIN:
- kind = OMP_CLAUSE_MAP_TO;
- break;
- case OMP_LIST_PRESENT_OR_COPYOUT:
- kind = OMP_CLAUSE_MAP_FROM;
- break;
- case OMP_LIST_PRESENT_OR_CREATE:
- kind = OMP_CLAUSE_MAP_ALLOC;
- break;
case OMP_LIST_DEVICEPTR:
kind = OMP_CLAUSE_MAP_FORCE_DEVICEPTR;
break;
@@ -2142,6 +2112,24 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
case OMP_MAP_TOFROM:
OMP_CLAUSE_MAP_KIND (node) = OMP_CLAUSE_MAP_TOFROM;
break;
+ case OMP_MAP_FORCE_ALLOC:
+ OMP_CLAUSE_MAP_KIND (node) = OMP_CLAUSE_MAP_FORCE_ALLOC;
+ break;
+ case OMP_MAP_FORCE_DEALLOC:
+ OMP_CLAUSE_MAP_KIND (node) = OMP_CLAUSE_MAP_FORCE_DEALLOC;
+ break;
+ case OMP_MAP_FORCE_TO:
+ OMP_CLAUSE_MAP_KIND (node) = OMP_CLAUSE_MAP_FORCE_TO;
+ break;
+ case OMP_MAP_FORCE_FROM:
+ OMP_CLAUSE_MAP_KIND (node) = OMP_CLAUSE_MAP_FORCE_FROM;
+ break;
+ case OMP_MAP_FORCE_TOFROM:
+ OMP_CLAUSE_MAP_KIND (node) = OMP_CLAUSE_MAP_FORCE_TOFROM;
+ break;
+ case OMP_MAP_FORCE_PRESENT:
+ OMP_CLAUSE_MAP_KIND (node) = OMP_CLAUSE_MAP_FORCE_PRESENT;
+ break;
default:
gcc_unreachable ();
}
diff --git a/gcc/testsuite/gfortran.dg/goacc/subarrays.f95 b/gcc/testsuite/gfortran.dg/goacc/subarrays.f95
new file mode 100644
index 0000000..4b3ef42
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/subarrays.f95
@@ -0,0 +1,41 @@
+! { dg-do compile }
+program test
+ implicit none
+ integer :: a(10), b(10, 10), c(3:7), i
+
+ !$acc parallel copy(a(1:5))
+ !$acc end parallel
+ !$acc parallel copy(a(1 + 0 : 5 + 2))
+ !$acc end parallel
+ !$acc parallel copy(a(:3))
+ !$acc end parallel
+ !$acc parallel copy(a(3:))
+ !$acc end parallel
+ !$acc parallel copy(a(:))
+ !$acc end parallel
+ !$acc parallel copy(a(2:3,2:3))
+ ! { dg-error "Rank mismatch" "" { target *-*-* } 16 }
+ ! { dg-error "'a' in MAP clause" "" { target *-*-* } 16 }
+ !$acc end parallel
+ !$acc parallel copy (a(:11)) ! { dg-warning "Upper array reference" }
+ !$acc end parallel
+ !$acc parallel copy (a(i:))
+ !$acc end parallel
+
+ !$acc parallel copy (a(:b))
+ ! { dg-error "Array index" "" { target *-*-* } 25 }
+ ! { dg-error "'a' in MAP clause" "" { target *-*-* } 25 }
+ !$acc end parallel
+
+ !$acc parallel copy (b(1:3,2:4))
+ !$acc end parallel
+ !$acc parallel copy (b(2:3))
+ ! { dg-error "Rank mismatch" "" { target *-*-* } 32 }
+ ! { dg-error "'b' in MAP clause" "" { target *-*-* } 32 }
+ !$acc end parallel
+ !$acc parallel copy (b(1:, 4:6))
+ !$acc end parallel
+
+ !$acc parallel copy (c(2:)) ! { dg-warning "Lower array reference" }
+ !$acc end parallel
+end program test
diff --git a/gcc/testsuite/gfortran.dg/gomp/map-1.f90 b/gcc/testsuite/gfortran.dg/gomp/map-1.f90
new file mode 100644
index 0000000..de96ed2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/map-1.f90
@@ -0,0 +1,109 @@
+subroutine test(aas)
+ implicit none
+
+ integer :: i, j(10), k(10, 10), aas(*)
+ integer, save :: tp
+ !$omp threadprivate(tp)
+ integer, parameter :: p = 1
+
+ type t
+ integer :: i, j(10)
+ end type t
+
+ type(t) :: tt
+
+ !$omp target map(i)
+ !$omp end target
+
+ !$omp target map(j)
+ !$omp end target
+
+ !$omp target map(p) ! { dg-error "Object 'p' is not a variable" }
+ !$omp end target
+
+ !$omp target map(j(1))
+ !$omp end target
+
+ !$omp target map(j(i))
+ !$omp end target
+
+ !$omp target map(j(i:))
+ !$omp end target
+
+ !$omp target map(j(:i))
+ !$omp end target
+
+ !$omp target map(j(i:i+1))
+ !$omp end target
+
+ !$omp target map(j(11)) ! { dg-warning "out of bounds" }
+ !$omp end target
+
+ !$omp target map(j(:11)) ! { dg-warning "out of bounds" }
+ !$omp end target
+
+ !$omp target map(j(0:)) ! { dg-warning "out of bounds" }
+ !$omp end target
+
+ !$omp target map(j(5:4)) ! { dg-error "Lower bound of OpenMP array section in greater than upper" "" { xfail *-*-* } }
+ !$omp end target
+
+ !$omp target map(j(5:))
+ !$omp end target
+
+ !$omp target map(j(:5))
+ !$omp end target
+
+ !$omp target map(j(:))
+ !$omp end target
+
+ !$omp target map(j(1:9:2)) ! { dg-error "Stride should not be specified for array section in MAP clause" }
+ !$omp end target
+
+ !$omp target map(aas(5:))
+ !$omp end target
+ ! { dg-error "Rightmost upper bound of assumed size array section not specified" "" { target *-*-* } 63 }
+ ! { dg-error "'aas' in MAP clause at \\\(1\\\) is not a proper array section" "" { target *-*-* } 63 }
+
+ !$omp target map(aas(:))
+ !$omp end target
+ ! { dg-error "Rightmost upper bound of assumed size array section not specified" "" { target *-*-* } 68 }
+ ! { dg-error "'aas' in MAP clause at \\\(1\\\) is not a proper array section" "" { target *-*-* } 68 }
+
+ !$omp target map(aas) ! { dg-error "The upper bound in the last dimension must appear" "" { xfail *-*-* } }
+ !$omp end target
+
+ !$omp target map(aas(5:7))
+ !$omp end target
+
+ !$omp target map(aas(:7))
+ !$omp end target
+
+ !$omp target map(k(5:))
+ !$omp end target
+ ! { dg-error "Rank mismatch in array reference" "" { target *-*-* } 82 }
+ ! { dg-error "'k' in MAP clause at \\\(1\\\) is not a proper array section" "" { target *-*-* } 82 }
+
+ !$omp target map(k(5:,:,3))
+ !$omp end target
+ ! { dg-error "Rank mismatch in array reference" "" { target *-*-* } 87 }
+ ! { dg-error "'k' in MAP clause at \\\(1\\\) is not a proper array section" "" { target *-*-* } 87 }
+
+ !$omp target map(tt)
+ !$omp end target
+
+ !$omp target map(tt%i) ! { dg-error "Syntax error in OpenMP variable list" }
+ !$omp end target ! { dg-bogus "Unexpected !\\\$OMP END TARGET statement" "" { xfail *-*-* } }
+
+ !$omp target map(tt%j) ! { dg-error "Syntax error in OpenMP variable list" }
+ !$omp end target ! { dg-bogus "Unexpected !\\\$OMP END TARGET statement" "" { xfail *-*-* } }
+
+ !$omp target map(tt%j(1)) ! { dg-bogus "Syntax error in OpenMP variable list" "" { xfail *-*-* } }
+ !$omp end target ! { dg-bogus "Unexpected !\\\$OMP END TARGET statement" "" { xfail *-*-* } }
+
+ !$omp target map(tt%j(1:)) ! { dg-bogus "Syntax error in OpenMP variable list" "" { xfail *-*-* } }
+ !$omp end target ! { dg-bogus "Unexpected !\\\$OMP END TARGET statement" "" { xfail *-*-* } }
+
+ !$omp target map(tp) ! { dg-error "THREADPRIVATE object 'tp' in MAP clause" }
+ !$omp end target
+end subroutine test
^ permalink raw reply [flat|nested] 12+ messages in thread
* Re: FWD: Re: OpenACC subarray specifications in the GCC Fortran front end
2014-07-24 0:57 ` Cesar Philippidis
@ 2014-07-24 13:16 ` Thomas Schwinge
2014-07-24 23:18 ` Cesar Philippidis
2014-11-11 14:57 ` Thomas Schwinge
2014-08-01 7:48 ` Jakub Jelinek
1 sibling, 2 replies; 12+ messages in thread
From: Thomas Schwinge @ 2014-07-24 13:16 UTC (permalink / raw)
To: Cesar Philippidis
Cc: gcc-patches, fortran, Ilmir Usmanov, Ilmir Usmanov,
Jakub Jelinek, Tobias Burnus
[-- Attachment #1: Type: text/plain, Size: 10089 bytes --]
Hi Cesar!
On Wed, 23 Jul 2014 17:42:32 -0700, Cesar Philippidis <cesar@codesourcery.com> wrote:
> On 07/11/2014 03:29 AM, Jakub Jelinek wrote:
> > On Fri, Jul 11, 2014 at 12:11:10PM +0200, Thomas Schwinge wrote:
> >> To avoid duplication of work: with Jakub's Fortran OpenMP 4 target
> >> changes recently committed to trunk, and now merged into gomp-4_0-branch,
> >> I have trimmed down Ilmir's patch to just the OpenACC bits, OpenMP 4
> >> target changes removed, and TODO markers added to integrate into that.
> >
> > Resolving the TODO markers would be nice, indeed.
>
> This patch has the openacc data clauses use the new openmp maps. In the
> process of doing so, I removed a lot of the old OMP_LIST_ enums and
> added a few OMP_MAP enums to match what the c frontend currently supports.
Thanks!
> Thomas, is this OK for gomp-4_0-branch? There are no new regressions.
A few comments. Also copying Tobias in case he has any additional
comments on the Fortran front end changes.
OMP_LIST_DEVICEPTR remains to be converted, which can be done as a later
follow-up patch.
> 2014-07-23 Cesar Philippidis <cesar@codesourcery.com>
> Thomas Schwinge <thomas@codesourcery.com>
> Ilmir Usmanov <i.usmanov@samsung.com>
>
> gcc/fortran/
> * gfortran.h (gfc_omp_map_op): Add OMP_MAP_TOFROM,
OMP_MAP_TOFROM already has been present:
> --- a/gcc/fortran/gfortran.h
> +++ b/gcc/fortran/gfortran.h
> @@ -1111,7 +1111,13 @@ typedef enum
> OMP_MAP_ALLOC,
> OMP_MAP_TO,
> OMP_MAP_FROM,
> - OMP_MAP_TOFROM
> + OMP_MAP_TOFROM,
> + OMP_MAP_FORCE_ALLOC,
> +[...]
> --- a/gcc/fortran/openmp.c
> +++ b/gcc/fortran/openmp.c
> @@ -448,18 +448,177 @@ match_oacc_clause_gang (gfc_omp_clauses *cp)
> #define OMP_CLAUSE_DEVICE_RESIDENT (1ULL << 51)
> #define OMP_CLAUSE_HOST (1ULL << 52)
> #define OMP_CLAUSE_OACC_DEVICE (1ULL << 53)
> -#define OMP_CLAUSE_OACC_COPYIN (1ULL << 54)
> +/* 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_omp_namelist **head = NULL;
> + if (gfc_match_omp_variable_list ("", list, false, NULL, &head, true)
> + == MATCH_YES)
> + {
> + gfc_omp_namelist *n;
> + for (n = *head; n; n = n->next)
> + n->u.map_op = map_op;
> + return true;
> + }
> +
> + return false;
> +}
> +
> +/* Match OpenACC data clauses. */
> +
> +static bool
> +gfc_match_oacc_data_clauses (unsigned long long mask, gfc_omp_clauses *c)
> +{
> + if ((mask & OMP_CLAUSE_COPYIN)
> +[...]
> +}
> +
> +/* Match OpenMP data clauses. */
> +
> +static bool
> +gfc_match_omp_data_clauses (unsigned long long mask, gfc_omp_clauses *c)
> +{
> + if ((mask & OMP_CLAUSE_COPYIN)
> + && gfc_match_omp_variable_list ("copyin (",
> + &c->lists[OMP_LIST_COPYIN], true)
> + == MATCH_YES)
> + return true;
> + if ((mask & OMP_CLAUSE_COPY)
> + && gfc_match_omp_variable_list ("copy (",
> + &c->lists[OMP_LIST_COPY], true)
> + == MATCH_YES)
> + return true;
It's a bit surprising to see these two (and only these two) handled here
under the moniker OpenMP data clauses.
> + if (mask & OMP_CLAUSE_COPYOUT)
> + gfc_error ("Invalid OpenMP clause COPYOUT");
> + if (mask & OMP_CLAUSE_CREATE)
> + gfc_error ("Invalid OpenMP clause CREATE");
> + if (mask & OMP_CLAUSE_DELETE)
> + gfc_error ("Invalid OpenMP clause DELETE");
> + if (mask & OMP_CLAUSE_PRESENT)
> + gfc_error ("Invalid OpenMP clause PRESENT");
> + if (mask & OMP_CLAUSE_PRESENT_OR_COPY)
> + gfc_error ("Invalid OpenMP clause PRESENT_OR_COPY");
> + if (mask & OMP_CLAUSE_PRESENT_OR_COPY)
> + gfc_error ("Invalid OpenMP clause PRESENT_OR_COPY");
> + if (mask & OMP_CLAUSE_PRESENT_OR_COPYIN)
> + gfc_error ("Invalid OpenMP clause PRESENT_OR_COPYIN");
> + if (mask & OMP_CLAUSE_PRESENT_OR_COPYIN)
> + gfc_error ("Invalid OpenMP clause PRESENT_OR_COPYIN");
> + if (mask & OMP_CLAUSE_PRESENT_OR_COPYOUT)
> + gfc_error ("Invalid OpenMP clause PRESENT_OR_COPYOUT");
> + if (mask & OMP_CLAUSE_PRESENT_OR_COPYOUT)
> + gfc_error ("Invalid OpenMP clause PRESENT_OR_COPYOUT");
> + if (mask & OMP_CLAUSE_PRESENT_OR_CREATE)
> + gfc_error ("Invalid OpenMP clause PRESENT_OR_CREATE");
> + if (mask & OMP_CLAUSE_PRESENT_OR_CREATE)
> + gfc_error ("Invalid OpenMP clause PRESENT_OR_CREATE");
Aren't all these in fact unreachable?
> +
> + return false;
> +}
I'd suggest to continue to handle all the data clauses...
>
> /* Match OpenMP and OpenACC directive clauses. MASK is a bitmask of
> clauses that are allowed for a particular directive. */
>
> static match
> gfc_match_omp_clauses (gfc_omp_clauses **cp, unsigned long long mask,
> - bool first = true, bool needs_space = true)
> + bool first = true, bool needs_space = true,
> + bool openacc = false)
> {
> gfc_omp_clauses *c = gfc_get_omp_clauses ();
> locus old_loc;
> @@ -533,181 +692,109 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, unsigned long long mask,
> if ((mask & OMP_CLAUSE_NUM_THREADS) && c->num_threads == NULL
> && gfc_match ("num_threads ( %e )", &c->num_threads) == MATCH_YES)
> continue;
> + if ((mask & OMP_CLAUSE_NUM_GANGS) && c->num_gangs_expr == NULL
> + && gfc_match ("num_gangs ( %e )", &c->num_gangs_expr) == MATCH_YES)
> + continue;
> + if ((mask & OMP_CLAUSE_NUM_WORKERS) && c->num_workers_expr == NULL
> + && gfc_match ("num_workers ( %e )", &c->num_workers_expr)
> + == MATCH_YES)
> + continue;
> + if ((mask & OMP_CLAUSE_TILE)
> + && match_oacc_expr_list ("tile (", &c->tile_list, true) == MATCH_YES)
> + continue;
> + if ((mask & OMP_CLAUSE_SEQ) && !c->seq
> + && gfc_match ("seq") == MATCH_YES)
> + {
> + c->seq = true;
> + needs_space = true;
> + continue;
> + }
> + if ((mask & OMP_CLAUSE_INDEPENDENT) && !c->independent
> + && gfc_match ("independent") == MATCH_YES)
> + {
> + c->independent = true;
> + needs_space = true;
> + continue;
> + }
> + if ((mask & OMP_CLAUSE_AUTO) && !c->par_auto
> + && gfc_match ("auto") == MATCH_YES)
> + {
> + c->par_auto = true;
> + needs_space = true;
> + continue;
> + }
> + if ((mask & OMP_CLAUSE_WAIT) && !c->wait
> + && gfc_match ("wait") == MATCH_YES)
> + {
> + c->wait = true;
> + match_oacc_expr_list (" (", &c->wait_list, false);
> + continue;
> + }
> + /* Common, in the sense that no special handling is required,
> + OpenACC and OpenMP data clauses. */
> if ((mask & OMP_CLAUSE_PRIVATE)
> && gfc_match_omp_variable_list ("private (",
> &c->lists[OMP_LIST_PRIVATE], true)
> - == MATCH_YES)
> + == MATCH_YES)
> continue;
> if ((mask & OMP_CLAUSE_FIRSTPRIVATE)
> && gfc_match_omp_variable_list ("firstprivate (",
> &c->lists[OMP_LIST_FIRSTPRIVATE],
> true)
> - == MATCH_YES)
> + == MATCH_YES)
> continue;
> if ((mask & OMP_CLAUSE_LASTPRIVATE)
> && gfc_match_omp_variable_list ("lastprivate (",
> &c->lists[OMP_LIST_LASTPRIVATE],
> true)
> - == MATCH_YES)
> + == MATCH_YES)
> continue;
> if ((mask & OMP_CLAUSE_COPYPRIVATE)
> && gfc_match_omp_variable_list ("copyprivate (",
> &c->lists[OMP_LIST_COPYPRIVATE],
> true)
> - == MATCH_YES)
> + == MATCH_YES)
> continue;
> if ((mask & OMP_CLAUSE_SHARED)
> && gfc_match_omp_variable_list ("shared (",
> &c->lists[OMP_LIST_SHARED], true)
> - == MATCH_YES)
> - continue;
> - if ((mask & OMP_CLAUSE_COPYIN)
> - && gfc_match_omp_variable_list ("copyin (",
> - &c->lists[OMP_LIST_COPYIN], true)
> - == MATCH_YES)
> - continue;
> - if ((mask & OMP_CLAUSE_NUM_GANGS) && c->num_gangs_expr == NULL
> - && gfc_match ("num_gangs ( %e )", &c->num_gangs_expr) == MATCH_YES)
> - continue;
> - if ((mask & OMP_CLAUSE_NUM_WORKERS) && c->num_workers_expr == NULL
> - && gfc_match ("num_workers ( %e )", &c->num_workers_expr)
> == MATCH_YES)
> continue;
> - if ((mask & OMP_CLAUSE_COPY)
> - && gfc_match_omp_variable_list ("copy (",
> - &c->lists[OMP_LIST_COPY], true)
> - == MATCH_YES)
> - continue;
> - if ((mask & OMP_CLAUSE_OACC_COPYIN)
> - && gfc_match_omp_variable_list ("copyin (",
> - &c->lists[OMP_LIST_OACC_COPYIN], true)
> - == MATCH_YES)
> - continue;
> - if ((mask & OMP_CLAUSE_COPYOUT)
> - && gfc_match_omp_variable_list ("copyout (",
> - &c->lists[OMP_LIST_COPYOUT], true)
> - == MATCH_YES)
> - continue;
> -[...]
... in here, and either guard them by »if (openacc)« as apppropriate, or
continue using the OMP_CLAUSE_OACC_COPYIN (which you axed). (I
understand that one to be the only conflicting one?)
> static void
> resolve_omp_clauses (gfc_code *code, locus *where,
> - gfc_omp_clauses *omp_clauses, gfc_namespace *ns)
> + gfc_omp_clauses *omp_clauses, gfc_namespace *ns,
> + bool openacc = false)
> {
> gfc_omp_namelist *n;
> gfc_expr_list *el;
> @@ -2794,7 +2893,7 @@ resolve_omp_clauses (gfc_code *code, locus *where,
> && list != OMP_LIST_LASTPRIVATE
> && list != OMP_LIST_ALIGNED
> && list != OMP_LIST_DEPEND
> - && list != OMP_LIST_MAP
> + && (list != OMP_LIST_MAP || openacc)
> && list != OMP_LIST_FROM
> && list != OMP_LIST_TO)
> for (n = omp_clauses->lists[list]; n; n = n->next)
> @@ -2941,53 +3040,59 @@ resolve_omp_clauses (gfc_code *code, locus *where,
> case OMP_LIST_TO:
> case OMP_LIST_FROM:
> for (; n != NULL; n = n->next)
> + {
> [...]
> + else if (openacc)
> + resolve_oacc_data_clauses (n->sym, *where,
> + clause_names[list]);
> + }
Is that special case only for deviceptr?
Grüße,
Thomas
[-- Attachment #2: Type: application/pgp-signature, Size: 472 bytes --]
^ permalink raw reply [flat|nested] 12+ messages in thread
* Re: FWD: Re: OpenACC subarray specifications in the GCC Fortran front end
2014-07-24 13:16 ` Thomas Schwinge
@ 2014-07-24 23:18 ` Cesar Philippidis
2014-07-25 16:12 ` Thomas Schwinge
2014-11-11 14:57 ` Thomas Schwinge
1 sibling, 1 reply; 12+ messages in thread
From: Cesar Philippidis @ 2014-07-24 23:18 UTC (permalink / raw)
To: Thomas Schwinge
Cc: gcc-patches, fortran, Ilmir Usmanov, Ilmir Usmanov,
Jakub Jelinek, Tobias Burnus
[-- Attachment #1: Type: text/plain, Size: 6046 bytes --]
On 07/24/2014 06:11 AM, Thomas Schwinge wrote:
> OMP_LIST_DEVICEPTR remains to be converted, which can be done as a later
> follow-up patch.
Yes, that's the plan.
> I'd suggest to continue to handle all the data clauses...
>
>>
>> /* Match OpenMP and OpenACC directive clauses. MASK is a bitmask of
>> clauses that are allowed for a particular directive. */
>>
>> static match
>> gfc_match_omp_clauses (gfc_omp_clauses **cp, unsigned long long mask,
>> - bool first = true, bool needs_space = true)
>> + bool first = true, bool needs_space = true,
>> + bool openacc = false)
>> {
>> gfc_omp_clauses *c = gfc_get_omp_clauses ();
>> locus old_loc;
>> @@ -533,181 +692,109 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, unsigned long long mask,
>> if ((mask & OMP_CLAUSE_NUM_THREADS) && c->num_threads == NULL
>> && gfc_match ("num_threads ( %e )", &c->num_threads) == MATCH_YES)
>> continue;
>> + if ((mask & OMP_CLAUSE_NUM_GANGS) && c->num_gangs_expr == NULL
>> + && gfc_match ("num_gangs ( %e )", &c->num_gangs_expr) == MATCH_YES)
>> + continue;
>> + if ((mask & OMP_CLAUSE_NUM_WORKERS) && c->num_workers_expr == NULL
>> + && gfc_match ("num_workers ( %e )", &c->num_workers_expr)
>> + == MATCH_YES)
>> + continue;
>> + if ((mask & OMP_CLAUSE_TILE)
>> + && match_oacc_expr_list ("tile (", &c->tile_list, true) == MATCH_YES)
>> + continue;
>> + if ((mask & OMP_CLAUSE_SEQ) && !c->seq
>> + && gfc_match ("seq") == MATCH_YES)
>> + {
>> + c->seq = true;
>> + needs_space = true;
>> + continue;
>> + }
>> + if ((mask & OMP_CLAUSE_INDEPENDENT) && !c->independent
>> + && gfc_match ("independent") == MATCH_YES)
>> + {
>> + c->independent = true;
>> + needs_space = true;
>> + continue;
>> + }
>> + if ((mask & OMP_CLAUSE_AUTO) && !c->par_auto
>> + && gfc_match ("auto") == MATCH_YES)
>> + {
>> + c->par_auto = true;
>> + needs_space = true;
>> + continue;
>> + }
>> + if ((mask & OMP_CLAUSE_WAIT) && !c->wait
>> + && gfc_match ("wait") == MATCH_YES)
>> + {
>> + c->wait = true;
>> + match_oacc_expr_list (" (", &c->wait_list, false);
>> + continue;
>> + }
>> + /* Common, in the sense that no special handling is required,
>> + OpenACC and OpenMP data clauses. */
>> if ((mask & OMP_CLAUSE_PRIVATE)
>> && gfc_match_omp_variable_list ("private (",
>> &c->lists[OMP_LIST_PRIVATE], true)
>> - == MATCH_YES)
>> + == MATCH_YES)
>> continue;
>> if ((mask & OMP_CLAUSE_FIRSTPRIVATE)
>> && gfc_match_omp_variable_list ("firstprivate (",
>> &c->lists[OMP_LIST_FIRSTPRIVATE],
>> true)
>> - == MATCH_YES)
>> + == MATCH_YES)
>> continue;
>> if ((mask & OMP_CLAUSE_LASTPRIVATE)
>> && gfc_match_omp_variable_list ("lastprivate (",
>> &c->lists[OMP_LIST_LASTPRIVATE],
>> true)
>> - == MATCH_YES)
>> + == MATCH_YES)
>> continue;
>> if ((mask & OMP_CLAUSE_COPYPRIVATE)
>> && gfc_match_omp_variable_list ("copyprivate (",
>> &c->lists[OMP_LIST_COPYPRIVATE],
>> true)
>> - == MATCH_YES)
>> + == MATCH_YES)
>> continue;
>> if ((mask & OMP_CLAUSE_SHARED)
>> && gfc_match_omp_variable_list ("shared (",
>> &c->lists[OMP_LIST_SHARED], true)
>> - == MATCH_YES)
>> - continue;
>> - if ((mask & OMP_CLAUSE_COPYIN)
>> - && gfc_match_omp_variable_list ("copyin (",
>> - &c->lists[OMP_LIST_COPYIN], true)
>> - == MATCH_YES)
>> - continue;
>> - if ((mask & OMP_CLAUSE_NUM_GANGS) && c->num_gangs_expr == NULL
>> - && gfc_match ("num_gangs ( %e )", &c->num_gangs_expr) == MATCH_YES)
>> - continue;
>> - if ((mask & OMP_CLAUSE_NUM_WORKERS) && c->num_workers_expr == NULL
>> - && gfc_match ("num_workers ( %e )", &c->num_workers_expr)
>> == MATCH_YES)
>> continue;
>> - if ((mask & OMP_CLAUSE_COPY)
>> - && gfc_match_omp_variable_list ("copy (",
>> - &c->lists[OMP_LIST_COPY], true)
>> - == MATCH_YES)
>> - continue;
>> - if ((mask & OMP_CLAUSE_OACC_COPYIN)
>> - && gfc_match_omp_variable_list ("copyin (",
>> - &c->lists[OMP_LIST_OACC_COPYIN], true)
>> - == MATCH_YES)
>> - continue;
>> - if ((mask & OMP_CLAUSE_COPYOUT)
>> - && gfc_match_omp_variable_list ("copyout (",
>> - &c->lists[OMP_LIST_COPYOUT], true)
>> - == MATCH_YES)
>> - continue;
>> -[...]
>
> ... in here, and either guard them by »if (openacc)« as apppropriate, or
> continue using the OMP_CLAUSE_OACC_COPYIN (which you axed). (I
> understand that one to be the only conflicting one?)
I moved all of the data clause matching back to gfc_match_omp_clauses,
and I guarded the copyin clause with the openacc flag. It looks like the
private clause may also require a special memory mapping, so I left the
openacc flag in place.
>> static void
>> resolve_omp_clauses (gfc_code *code, locus *where,
>> - gfc_omp_clauses *omp_clauses, gfc_namespace *ns)
>> + gfc_omp_clauses *omp_clauses, gfc_namespace *ns,
>> + bool openacc = false)
>> {
>> gfc_omp_namelist *n;
>> gfc_expr_list *el;
>> @@ -2794,7 +2893,7 @@ resolve_omp_clauses (gfc_code *code, locus *where,
>> && list != OMP_LIST_LASTPRIVATE
>> && list != OMP_LIST_ALIGNED
>> && list != OMP_LIST_DEPEND
>> - && list != OMP_LIST_MAP
>> + && (list != OMP_LIST_MAP || openacc)
>> && list != OMP_LIST_FROM
>> && list != OMP_LIST_TO)
>> for (n = omp_clauses->lists[list]; n; n = n->next)
>> @@ -2941,53 +3040,59 @@ resolve_omp_clauses (gfc_code *code, locus *where,
>> case OMP_LIST_TO:
>> case OMP_LIST_FROM:
>> for (; n != NULL; n = n->next)
>> + {
>> [...]
>> + else if (openacc)
>> + resolve_oacc_data_clauses (n->sym, *where,
>> + clause_names[list]);
>> + }
>
> Is that special case only for deviceptr?
I haven't looked at it in detail yet, but I plan to do so when I tackle
the device related clauses.
Is this patch OK to commit to gomp-4_0-branch?
Thanks,
Cesar
[-- Attachment #2: subarrays-mappings-gcc-b.diff --]
[-- Type: text/x-patch, Size: 30518 bytes --]
2014-07-24 Cesar Philippidis <cesar@codesourcery.com>
gcc/fortran/
* gfortran.h (gfc_omp_map_op): Add OMP_MAP_FORCE_ALLOC,
OMP_MAP_FORCE_DEALLOC, OMP_MAP_FORCE_TO, OMP_MAP_FORCE_FROM,
OMP_MAP_FORCE_TOFROM, OMP_MAP_FORCE_PRESENT.
(enum) Remove OMP_LIST_OACC_COPYIN, OMP_LIST_COPYOUT,
OMP_LIST_CREATE, OMP_LIST_DELETE, OMP_LIST_PRESENT,
OMP_LIST_PRESENT_OR_COPY, OMP_LIST_PRESENT_OR_COPYIN,
OMP_LIST_PRESENT_OR_COPYOUT, OMP_LIST_PRESENT_OR_CREATE.
* dump-parse-tree.c (show_omp_clauses): Remove handling of
OMP_LIST_OACC_COPYIN, OMP_LIST_COPYOUT, OMP_LIST_CREATE,
OMP_LIST_DELETE, OMP_LIST_PRESENT, OMP_LIST_PRESENT_OR_COPY,
OMP_LIST_PRESENT_OR_COPYIN, OMP_LIST_PRESENT_OR_COPYOUT,
OMP_LIST_PRESENT_OR_CREATE.
* openmp.c (OMP_CLAUSE_OACC_COPYIN): Remove define.
(gfc_match_omp_map_clause): New function.
(gfc_match_omp_clauses): New openacc argument. Treat
OMP_CLAUSE_COPY, OMP_CLAUSE_COPYOUT, OMP_CLAUSE_CREATE,
OMP_CLAUSE_DELETE, OMP_CLAUSE_PRESENT, OMP_CLAUSE_PRESENT_OR_COPY,
OMP_CLAUSE_PRESENT_OR_COPYIN, OMP_CLAUSE_PRESENT_OR_COPYOUT, and
OMP_CLAUSE_PRESENT_OR_CREATE as OpenMP memory maps. Also, remove
support for OMP_CLAUSE_OACC_COPYIN. Make OMP_CLAUSE_COPYIN
represent the COPYIN clause for both OpenACC and OpenMP.
(OACC_PARALLEL_CLAUSES): Replace OMP_CLAUSE_OACC_COPYIN with
OMC_CLAUSE_COPYIN.
(OACC_KERNEL_CLAUSES): Likewise.
(OACC_DATA_CLAUSES): Likewise.
(OACC_DECLARE_CLAUSES): Likewise.
(OACC_ENTER_DATA_CLAUSES): Likewise.
(gfc_match_oacc_parallel_loop): Call gfc_match_omp_clauses with
the openacc parameter as true.
(gfc_match_oacc_parallel): Likewise.
(gfc_match_oacc_kernels_loop): Likewise.
(gfc_match_oacc_kernels): Likewise.
(gfc_match_oacc_data): Likewise.
(gfc_match_oacc_host_data): Likewise.
(gfc_match_oacc_loop): Likewise.
(gfc_match_oacc_declare): Likewise.
(gfc_match_oacc_update): Likewise.
(gfc_match_oacc_enter_data): Likewise.
(gfc_match_oacc_exit_data): Likewise.
(resolve_omp_clauses): New openacc argument. Call
resolve_oacc_data_clauses to check additional errors.
(resolve_oacc_loop): Update call to resolve_omp_clauses.
(resolve_oacc_wait): Likewise.
(gfc_resolve_oacc_declare): Likewise.
(gfc_resolve_oacc_directive): Likewise.
* trans-openmp.c (gfc_trans_omp_clauses): Remove
OMP_LIST_OACC_COPYIN, OMP_LIST_COPYOUT, OMP_LIST_CREATE,
OMP_LIST_DELETE, OMP_LIST_PRESENT, OMP_LIST_PRESENT_OR_COPY,
OMP_LIST_PRESENT_OR_COPYIN, OMP_LIST_PRESENT_OR_COPYOUT,
OMP_LIST_PRESENT_OR_CREATE switch items. Handle
OMP_MAP_FORCE_ALLOC, OMP_MAP_FORCE_DEALLOC, OMP_MAP_FORCE_TO,
OMP_MAP_FORCE_FROM, OMP_MAP_FORCE_TOFROM, OMP_MAP_FORCE_PRESENT
clause memory mappings.
gcc/testsuite/
* gfortran.dg/goacc/subarrays.f95: New test.
* gfortran.dg/gomp/map-1.f90: New test.
diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c
index c367139..d7f2182 100644
--- a/gcc/fortran/dump-parse-tree.c
+++ b/gcc/fortran/dump-parse-tree.c
@@ -1258,15 +1258,6 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses)
switch (list_type)
{
case OMP_LIST_COPY: type = "COPY"; break;
- case OMP_LIST_OACC_COPYIN: type = "COPYIN"; break;
- case OMP_LIST_COPYOUT: type = "COPYOUT"; break;
- case OMP_LIST_CREATE: type = "CREATE"; break;
- case OMP_LIST_DELETE: type = "DELETE"; break;
- case OMP_LIST_PRESENT: type = "PRESENT"; break;
- case OMP_LIST_PRESENT_OR_COPY: type = "PRESENT_OR_COPY"; break;
- case OMP_LIST_PRESENT_OR_COPYIN: type = "PRESENT_OR_COPYIN"; break;
- case OMP_LIST_PRESENT_OR_COPYOUT: type = "PRESENT_OR_COPYOUT"; break;
- case OMP_LIST_PRESENT_OR_CREATE: type = "PRESENT_OR_CREATE"; break;
case OMP_LIST_DEVICEPTR: type = "DEVICEPTR"; break;
case OMP_LIST_USE_DEVICE: type = "USE_DEVICE"; break;
case OMP_LIST_DEVICE_RESIDENT: type = "USE_DEVICE"; break;
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index cc445e6..0cde668 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -1111,7 +1111,13 @@ typedef enum
OMP_MAP_ALLOC,
OMP_MAP_TO,
OMP_MAP_FROM,
- OMP_MAP_TOFROM
+ OMP_MAP_TOFROM,
+ OMP_MAP_FORCE_ALLOC,
+ OMP_MAP_FORCE_DEALLOC,
+ OMP_MAP_FORCE_TO,
+ OMP_MAP_FORCE_FROM,
+ OMP_MAP_FORCE_TOFROM,
+ OMP_MAP_FORCE_PRESENT
}
gfc_omp_map_op;
@@ -1153,15 +1159,6 @@ enum
OMP_LIST_REDUCTION,
OMP_LIST_COPY,
OMP_LIST_DATA_CLAUSE_FIRST = OMP_LIST_COPY,
- OMP_LIST_OACC_COPYIN,
- OMP_LIST_COPYOUT,
- OMP_LIST_CREATE,
- OMP_LIST_DELETE,
- OMP_LIST_PRESENT,
- OMP_LIST_PRESENT_OR_COPY,
- OMP_LIST_PRESENT_OR_COPYIN,
- OMP_LIST_PRESENT_OR_COPYOUT,
- OMP_LIST_PRESENT_OR_CREATE,
OMP_LIST_DEVICEPTR,
OMP_LIST_DATA_CLAUSE_LAST = OMP_LIST_DEVICEPTR,
OMP_LIST_DEVICE_RESIDENT,
diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index 7b87e78..91e00c4 100644
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -448,18 +448,37 @@ match_oacc_clause_gang (gfc_omp_clauses *cp)
#define OMP_CLAUSE_DEVICE_RESIDENT (1ULL << 51)
#define OMP_CLAUSE_HOST (1ULL << 52)
#define OMP_CLAUSE_OACC_DEVICE (1ULL << 53)
-#define OMP_CLAUSE_OACC_COPYIN (1ULL << 54)
-#define OMP_CLAUSE_WAIT (1ULL << 55)
-#define OMP_CLAUSE_DELETE (1ULL << 56)
-#define OMP_CLAUSE_AUTO (1ULL << 57)
-#define OMP_CLAUSE_TILE (1ULL << 58)
+#define OMP_CLAUSE_WAIT (1ULL << 54)
+#define OMP_CLAUSE_DELETE (1ULL << 55)
+#define OMP_CLAUSE_AUTO (1ULL << 56)
+#define OMP_CLAUSE_TILE (1ULL << 57)
+
+/* 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_omp_namelist **head = NULL;
+ if (gfc_match_omp_variable_list ("", list, false, NULL, &head, true)
+ == MATCH_YES)
+ {
+ gfc_omp_namelist *n;
+ for (n = *head; n; n = n->next)
+ n->u.map_op = map_op;
+ return true;
+ }
+
+ return false;
+}
/* Match OpenMP and OpenACC directive clauses. MASK is a bitmask of
clauses that are allowed for a particular directive. */
static match
gfc_match_omp_clauses (gfc_omp_clauses **cp, unsigned long long mask,
- bool first = true, bool needs_space = true)
+ bool first = true, bool needs_space = true,
+ bool openacc = false)
{
gfc_omp_clauses *c = gfc_get_omp_clauses ();
locus old_loc;
@@ -561,11 +580,20 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, unsigned long long mask,
&c->lists[OMP_LIST_SHARED], true)
== MATCH_YES)
continue;
- if ((mask & OMP_CLAUSE_COPYIN)
- && gfc_match_omp_variable_list ("copyin (",
- &c->lists[OMP_LIST_COPYIN], true)
- == MATCH_YES)
- continue;
+ if (mask & OMP_CLAUSE_COPYIN)
+ {
+ if (openacc)
+ {
+ if (gfc_match ("copyin ( ") == MATCH_YES
+ && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
+ OMP_MAP_FORCE_TO))
+ continue;
+ }
+ else if (gfc_match_omp_variable_list ("copyin (",
+ &c->lists[OMP_LIST_COPYIN],
+ true) == MATCH_YES)
+ continue;
+ }
if ((mask & OMP_CLAUSE_NUM_GANGS) && c->num_gangs_expr == NULL
&& gfc_match ("num_gangs ( %e )", &c->num_gangs_expr) == MATCH_YES)
continue;
@@ -574,82 +602,69 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, unsigned long long mask,
== MATCH_YES)
continue;
if ((mask & OMP_CLAUSE_COPY)
- && gfc_match_omp_variable_list ("copy (",
- &c->lists[OMP_LIST_COPY], true)
- == MATCH_YES)
- continue;
- if ((mask & OMP_CLAUSE_OACC_COPYIN)
- && gfc_match_omp_variable_list ("copyin (",
- &c->lists[OMP_LIST_OACC_COPYIN], true)
- == MATCH_YES)
+ && gfc_match ("copy ( ") == MATCH_YES
+ && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
+ OMP_MAP_FORCE_TOFROM))
continue;
if ((mask & OMP_CLAUSE_COPYOUT)
- && gfc_match_omp_variable_list ("copyout (",
- &c->lists[OMP_LIST_COPYOUT], true)
- == MATCH_YES)
+ && gfc_match ("copyout ( ") == MATCH_YES
+ && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
+ OMP_MAP_FORCE_FROM))
continue;
if ((mask & OMP_CLAUSE_CREATE)
- && gfc_match_omp_variable_list ("create (",
- &c->lists[OMP_LIST_CREATE], true)
- == MATCH_YES)
+ && gfc_match ("create ( ") == MATCH_YES
+ && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
+ OMP_MAP_FORCE_ALLOC))
continue;
if ((mask & OMP_CLAUSE_DELETE)
- && gfc_match_omp_variable_list ("delete (",
- &c->lists[OMP_LIST_DELETE], true)
- == MATCH_YES)
+ && gfc_match ("delete ( ") == MATCH_YES
+ && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
+ OMP_MAP_FORCE_DEALLOC))
continue;
if ((mask & OMP_CLAUSE_PRESENT)
- && gfc_match_omp_variable_list ("present (",
- &c->lists[OMP_LIST_PRESENT], true)
- == MATCH_YES)
+ && gfc_match ("present ( ") == MATCH_YES
+ && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
+ OMP_MAP_FORCE_PRESENT))
continue;
if ((mask & OMP_CLAUSE_PRESENT_OR_COPY)
- && gfc_match_omp_variable_list ("present_or_copy (",
- &c->lists[OMP_LIST_PRESENT_OR_COPY],
- true)
- == MATCH_YES)
+ && gfc_match ("present_or_copy ( ") == MATCH_YES
+ && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
+ OMP_MAP_TOFROM))
continue;
if ((mask & OMP_CLAUSE_PRESENT_OR_COPY)
- && gfc_match_omp_variable_list ("pcopy (",
- &c->lists[OMP_LIST_PRESENT_OR_COPY],
- true)
- == MATCH_YES)
+ && gfc_match ("pcopy ( ") == MATCH_YES
+ && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
+ OMP_MAP_TOFROM))
continue;
if ((mask & OMP_CLAUSE_PRESENT_OR_COPYIN)
- && gfc_match_omp_variable_list ("present_or_copyin (",
- &c->lists[OMP_LIST_PRESENT_OR_COPYIN],
- true)
- == MATCH_YES)
+ && gfc_match ("present_or_copyin ( ") == MATCH_YES
+ && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
+ OMP_MAP_TO))
continue;
if ((mask & OMP_CLAUSE_PRESENT_OR_COPYIN)
- && gfc_match_omp_variable_list ("pcopyin (",
- &c->lists[OMP_LIST_PRESENT_OR_COPYIN],
- true)
- == MATCH_YES)
+ && gfc_match ("pcopyin ( ") == MATCH_YES
+ && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
+ OMP_MAP_TO))
continue;
if ((mask & OMP_CLAUSE_PRESENT_OR_COPYOUT)
- && gfc_match_omp_variable_list ("present_or_copyout (",
- &c->lists[OMP_LIST_PRESENT_OR_COPYOUT],
- true)
- == MATCH_YES)
+ && gfc_match ("present_or_copyout ( ") == MATCH_YES
+ && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
+ OMP_MAP_FROM))
continue;
if ((mask & OMP_CLAUSE_PRESENT_OR_COPYOUT)
- && gfc_match_omp_variable_list ("pcopyout (",
- &c->lists[OMP_LIST_PRESENT_OR_COPYOUT],
- true)
- == MATCH_YES)
+ && gfc_match ("pcopyout ( ") == MATCH_YES
+ && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
+ OMP_MAP_FROM))
continue;
if ((mask & OMP_CLAUSE_PRESENT_OR_CREATE)
- && gfc_match_omp_variable_list ("present_or_create (",
- &c->lists[OMP_LIST_PRESENT_OR_CREATE],
- true)
- == MATCH_YES)
+ && gfc_match ("present_or_create ( ") == MATCH_YES
+ && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
+ OMP_MAP_ALLOC))
continue;
if ((mask & OMP_CLAUSE_PRESENT_OR_CREATE)
- && gfc_match_omp_variable_list ("pcreate (",
- &c->lists[OMP_LIST_PRESENT_OR_CREATE],
- true)
- == MATCH_YES)
+ && gfc_match ("pcreate ( ") == MATCH_YES
+ && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
+ OMP_MAP_ALLOC))
continue;
if ((mask & OMP_CLAUSE_DEVICEPTR)
&& gfc_match_omp_variable_list ("deviceptr (",
@@ -1112,20 +1127,20 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, unsigned long long mask,
#define OACC_PARALLEL_CLAUSES \
(OMP_CLAUSE_IF | OMP_CLAUSE_ASYNC | OMP_CLAUSE_NUM_GANGS \
| OMP_CLAUSE_NUM_WORKERS | OMP_CLAUSE_VECTOR_LENGTH | OMP_CLAUSE_REDUCTION \
- | OMP_CLAUSE_COPY | OMP_CLAUSE_OACC_COPYIN | OMP_CLAUSE_COPYOUT \
+ | 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_DEVICEPTR | OMP_CLAUSE_PRIVATE \
| OMP_CLAUSE_FIRSTPRIVATE | OMP_CLAUSE_DEFAULT | OMP_CLAUSE_WAIT)
#define OACC_KERNELS_CLAUSES \
(OMP_CLAUSE_IF | OMP_CLAUSE_ASYNC | OMP_CLAUSE_DEVICEPTR \
- | OMP_CLAUSE_COPY | OMP_CLAUSE_OACC_COPYIN | OMP_CLAUSE_COPYOUT \
+ | 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)
#define OACC_DATA_CLAUSES \
(OMP_CLAUSE_IF | OMP_CLAUSE_DEVICEPTR | OMP_CLAUSE_COPY \
- | OMP_CLAUSE_OACC_COPYIN | OMP_CLAUSE_COPYOUT | OMP_CLAUSE_CREATE \
+ | 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)
@@ -1140,7 +1155,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, unsigned long long mask,
(OACC_LOOP_CLAUSES | OACC_KERNELS_CLAUSES)
#define OACC_HOST_DATA_CLAUSES OMP_CLAUSE_USE_DEVICE
#define OACC_DECLARE_CLAUSES \
- (OMP_CLAUSE_COPY | OMP_CLAUSE_OACC_COPYIN | OMP_CLAUSE_COPYOUT \
+ (OMP_CLAUSE_COPY | OMP_CLAUSE_COPYIN | OMP_CLAUSE_COPYOUT \
| 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 \
@@ -1148,7 +1163,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, unsigned long long mask,
#define OACC_UPDATE_CLAUSES \
(OMP_CLAUSE_IF | OMP_CLAUSE_ASYNC | OMP_CLAUSE_HOST | OMP_CLAUSE_OACC_DEVICE)
#define OACC_ENTER_DATA_CLAUSES \
- (OMP_CLAUSE_IF | OMP_CLAUSE_ASYNC | OMP_CLAUSE_WAIT | OMP_CLAUSE_OACC_COPYIN \
+ (OMP_CLAUSE_IF | OMP_CLAUSE_ASYNC | OMP_CLAUSE_WAIT | OMP_CLAUSE_COPYIN \
| OMP_CLAUSE_CREATE | OMP_CLAUSE_PRESENT_OR_COPYIN \
| OMP_CLAUSE_PRESENT_OR_CREATE)
#define OACC_EXIT_DATA_CLAUSES \
@@ -1160,7 +1175,8 @@ match
gfc_match_oacc_parallel_loop (void)
{
gfc_omp_clauses *c;
- if (gfc_match_omp_clauses (&c, OACC_PARALLEL_LOOP_CLAUSES) != MATCH_YES)
+ if (gfc_match_omp_clauses (&c, OACC_PARALLEL_LOOP_CLAUSES, false, false,
+ true) != MATCH_YES)
return MATCH_ERROR;
new_st.op = EXEC_OACC_PARALLEL_LOOP;
@@ -1173,7 +1189,8 @@ match
gfc_match_oacc_parallel (void)
{
gfc_omp_clauses *c;
- if (gfc_match_omp_clauses (&c, OACC_PARALLEL_CLAUSES) != MATCH_YES)
+ if (gfc_match_omp_clauses (&c, OACC_PARALLEL_CLAUSES, false, false, true)
+ != MATCH_YES)
return MATCH_ERROR;
new_st.op = EXEC_OACC_PARALLEL;
@@ -1186,7 +1203,8 @@ match
gfc_match_oacc_kernels_loop (void)
{
gfc_omp_clauses *c;
- if (gfc_match_omp_clauses (&c, OACC_KERNELS_LOOP_CLAUSES) != MATCH_YES)
+ if (gfc_match_omp_clauses (&c, OACC_KERNELS_LOOP_CLAUSES, false, false,
+ true) != MATCH_YES)
return MATCH_ERROR;
new_st.op = EXEC_OACC_KERNELS_LOOP;
@@ -1199,7 +1217,8 @@ match
gfc_match_oacc_kernels (void)
{
gfc_omp_clauses *c;
- if (gfc_match_omp_clauses (&c, OACC_KERNELS_CLAUSES) != MATCH_YES)
+ if (gfc_match_omp_clauses (&c, OACC_KERNELS_CLAUSES, false, false, true)
+ != MATCH_YES)
return MATCH_ERROR;
new_st.op = EXEC_OACC_KERNELS;
@@ -1212,7 +1231,8 @@ match
gfc_match_oacc_data (void)
{
gfc_omp_clauses *c;
- if (gfc_match_omp_clauses (&c, OACC_DATA_CLAUSES) != MATCH_YES)
+ if (gfc_match_omp_clauses (&c, OACC_DATA_CLAUSES, false, false, true)
+ != MATCH_YES)
return MATCH_ERROR;
new_st.op = EXEC_OACC_DATA;
@@ -1225,7 +1245,8 @@ match
gfc_match_oacc_host_data (void)
{
gfc_omp_clauses *c;
- if (gfc_match_omp_clauses (&c, OACC_HOST_DATA_CLAUSES) != MATCH_YES)
+ if (gfc_match_omp_clauses (&c, OACC_HOST_DATA_CLAUSES, false, false, true)
+ != MATCH_YES)
return MATCH_ERROR;
new_st.op = EXEC_OACC_HOST_DATA;
@@ -1238,7 +1259,8 @@ match
gfc_match_oacc_loop (void)
{
gfc_omp_clauses *c;
- if (gfc_match_omp_clauses (&c, OACC_LOOP_CLAUSES) != MATCH_YES)
+ if (gfc_match_omp_clauses (&c, OACC_LOOP_CLAUSES, false, false, true)
+ != MATCH_YES)
return MATCH_ERROR;
new_st.op = EXEC_OACC_LOOP;
@@ -1251,7 +1273,8 @@ match
gfc_match_oacc_declare (void)
{
gfc_omp_clauses *c;
- if (gfc_match_omp_clauses (&c, OACC_DECLARE_CLAUSES) != MATCH_YES)
+ if (gfc_match_omp_clauses (&c, OACC_DECLARE_CLAUSES, false, false, true)
+ != MATCH_YES)
return MATCH_ERROR;
new_st.ext.omp_clauses = c;
@@ -1264,7 +1287,8 @@ match
gfc_match_oacc_update (void)
{
gfc_omp_clauses *c;
- if (gfc_match_omp_clauses (&c, OACC_UPDATE_CLAUSES) != MATCH_YES)
+ if (gfc_match_omp_clauses (&c, OACC_UPDATE_CLAUSES, false, false, true)
+ != MATCH_YES)
return MATCH_ERROR;
new_st.op = EXEC_OACC_UPDATE;
@@ -1277,7 +1301,8 @@ match
gfc_match_oacc_enter_data (void)
{
gfc_omp_clauses *c;
- if (gfc_match_omp_clauses (&c, OACC_ENTER_DATA_CLAUSES) != MATCH_YES)
+ if (gfc_match_omp_clauses (&c, OACC_ENTER_DATA_CLAUSES, false, false, true)
+ != MATCH_YES)
return MATCH_ERROR;
new_st.op = EXEC_OACC_ENTER_DATA;
@@ -1290,7 +1315,8 @@ match
gfc_match_oacc_exit_data (void)
{
gfc_omp_clauses *c;
- if (gfc_match_omp_clauses (&c, OACC_EXIT_DATA_CLAUSES) != MATCH_YES)
+ if (gfc_match_omp_clauses (&c, OACC_EXIT_DATA_CLAUSES, false, false, true)
+ != MATCH_YES)
return MATCH_ERROR;
new_st.op = EXEC_OACC_EXIT_DATA;
@@ -2692,7 +2718,8 @@ resolve_omp_udr_clause (gfc_omp_namelist *n, gfc_namespace *ns,
static void
resolve_omp_clauses (gfc_code *code, locus *where,
- gfc_omp_clauses *omp_clauses, gfc_namespace *ns)
+ gfc_omp_clauses *omp_clauses, gfc_namespace *ns,
+ bool openacc = false)
{
gfc_omp_namelist *n;
gfc_expr_list *el;
@@ -2794,7 +2821,7 @@ resolve_omp_clauses (gfc_code *code, locus *where,
&& list != OMP_LIST_LASTPRIVATE
&& list != OMP_LIST_ALIGNED
&& list != OMP_LIST_DEPEND
- && list != OMP_LIST_MAP
+ && (list != OMP_LIST_MAP || openacc)
&& list != OMP_LIST_FROM
&& list != OMP_LIST_TO)
for (n = omp_clauses->lists[list]; n; n = n->next)
@@ -2941,53 +2968,59 @@ resolve_omp_clauses (gfc_code *code, locus *where,
case OMP_LIST_TO:
case OMP_LIST_FROM:
for (; n != NULL; n = n->next)
- if (n->expr)
- {
- if (!gfc_resolve_expr (n->expr)
- || n->expr->expr_type != EXPR_VARIABLE
- || n->expr->ref == NULL
- || n->expr->ref->next
- || n->expr->ref->type != REF_ARRAY)
- gfc_error ("'%s' in %s clause at %L is not a proper "
- "array section", n->sym->name, name, where);
- else if (n->expr->ref->u.ar.codimen)
- gfc_error ("Coarrays not supported in %s clause at %L",
- name, where);
- else
- {
- int i;
- gfc_array_ref *ar = &n->expr->ref->u.ar;
- for (i = 0; i < ar->dimen; i++)
- if (ar->stride[i])
- {
- gfc_error ("Stride should not be specified for "
- "array section in %s clause at %L",
- name, where);
- break;
- }
- else if (ar->dimen_type[i] != DIMEN_ELEMENT
- && ar->dimen_type[i] != DIMEN_RANGE)
- {
- gfc_error ("'%s' in %s clause at %L is not a "
- "proper array section",
- n->sym->name, name, where);
- break;
- }
- else if (list == OMP_LIST_DEPEND
- && ar->start[i]
- && ar->start[i]->expr_type == EXPR_CONSTANT
- && ar->end[i]
- && ar->end[i]->expr_type == EXPR_CONSTANT
- && mpz_cmp (ar->start[i]->value.integer,
- ar->end[i]->value.integer) > 0)
- {
- gfc_error ("'%s' in DEPEND clause at %L is a zero "
- "size array section", n->sym->name,
- where);
- break;
- }
- }
- }
+ {
+ if (n->expr)
+ {
+ if (!gfc_resolve_expr (n->expr)
+ || n->expr->expr_type != EXPR_VARIABLE
+ || n->expr->ref == NULL
+ || n->expr->ref->next
+ || n->expr->ref->type != REF_ARRAY)
+ gfc_error ("'%s' in %s clause at %L is not a proper "
+ "array section", n->sym->name, name, where);
+ else if (n->expr->ref->u.ar.codimen)
+ gfc_error ("Coarrays not supported in %s clause at %L",
+ name, where);
+ else
+ {
+ int i;
+ gfc_array_ref *ar = &n->expr->ref->u.ar;
+ for (i = 0; i < ar->dimen; i++)
+ if (ar->stride[i])
+ {
+ gfc_error ("Stride should not be specified for "
+ "array section in %s clause at %L",
+ name, where);
+ break;
+ }
+ else if (ar->dimen_type[i] != DIMEN_ELEMENT
+ && ar->dimen_type[i] != DIMEN_RANGE)
+ {
+ gfc_error ("'%s' in %s clause at %L is not a "
+ "proper array section",
+ n->sym->name, name, where);
+ break;
+ }
+ else if (list == OMP_LIST_DEPEND
+ && ar->start[i]
+ && ar->start[i]->expr_type == EXPR_CONSTANT
+ && ar->end[i]
+ && ar->end[i]->expr_type == EXPR_CONSTANT
+ && mpz_cmp (ar->start[i]->value.integer,
+ ar->end[i]->value.integer) > 0)
+ {
+ gfc_error ("'%s' in DEPEND clause at %L is a "
+ "zero size array section",
+ n->sym->name, where);
+ break;
+ }
+ }
+ }
+ else if (openacc)
+ resolve_oacc_data_clauses (n->sym, *where,
+ clause_names[list]);
+ }
+
if (list != OMP_LIST_DEPEND)
for (n = omp_clauses->lists[list]; n != NULL; n = n->next)
{
@@ -4407,7 +4440,7 @@ resolve_oacc_loop(gfc_code *code)
int collapse;
if (code->ext.omp_clauses)
- resolve_omp_clauses (code, &code->loc, code->ext.omp_clauses, NULL);
+ resolve_omp_clauses (code, &code->loc, code->ext.omp_clauses, NULL, true);
do_code = code->block->next;
collapse = code->ext.omp_clauses->collapse;
@@ -4451,6 +4484,7 @@ gfc_resolve_oacc_declare (gfc_namespace *ns)
loc = ns->oacc_declare_clauses->ext.loc;
+ /* FIXME: handle omp_list_map. */
for (list = OMP_LIST_DATA_CLAUSE_FIRST;
list <= OMP_LIST_DEVICE_RESIDENT; list++)
for (n = ns->oacc_declare_clauses->lists[list]; n; n = n->next)
@@ -4507,7 +4541,8 @@ gfc_resolve_oacc_directive (gfc_code *code, gfc_namespace *ns ATTRIBUTE_UNUSED)
case EXEC_OACC_UPDATE:
case EXEC_OACC_ENTER_DATA:
case EXEC_OACC_EXIT_DATA:
- resolve_omp_clauses (code, &code->loc, code->ext.omp_clauses, NULL);
+ resolve_omp_clauses (code, &code->loc, code->ext.omp_clauses, NULL,
+ true);
break;
case EXEC_OACC_PARALLEL_LOOP:
case EXEC_OACC_KERNELS_LOOP:
diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
index aaf50d3..5f61877 100644
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -1743,36 +1743,6 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
enum omp_clause_map_kind kind;
switch (list)
{
- case OMP_LIST_COPY:
- kind = OMP_CLAUSE_MAP_FORCE_TOFROM;
- break;
- case OMP_LIST_OACC_COPYIN:
- kind = OMP_CLAUSE_MAP_FORCE_TO;
- break;
- case OMP_LIST_COPYOUT:
- kind = OMP_CLAUSE_MAP_FORCE_FROM;
- break;
- case OMP_LIST_CREATE:
- kind = OMP_CLAUSE_MAP_FORCE_ALLOC;
- break;
- case OMP_LIST_DELETE:
- kind = OMP_CLAUSE_MAP_FORCE_DEALLOC;
- break;
- case OMP_LIST_PRESENT:
- kind = OMP_CLAUSE_MAP_FORCE_PRESENT;
- break;
- case OMP_LIST_PRESENT_OR_COPY:
- kind = OMP_CLAUSE_MAP_TOFROM;
- break;
- case OMP_LIST_PRESENT_OR_COPYIN:
- kind = OMP_CLAUSE_MAP_TO;
- break;
- case OMP_LIST_PRESENT_OR_COPYOUT:
- kind = OMP_CLAUSE_MAP_FROM;
- break;
- case OMP_LIST_PRESENT_OR_CREATE:
- kind = OMP_CLAUSE_MAP_ALLOC;
- break;
case OMP_LIST_DEVICEPTR:
kind = OMP_CLAUSE_MAP_FORCE_DEVICEPTR;
break;
@@ -2142,6 +2112,24 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
case OMP_MAP_TOFROM:
OMP_CLAUSE_MAP_KIND (node) = OMP_CLAUSE_MAP_TOFROM;
break;
+ case OMP_MAP_FORCE_ALLOC:
+ OMP_CLAUSE_MAP_KIND (node) = OMP_CLAUSE_MAP_FORCE_ALLOC;
+ break;
+ case OMP_MAP_FORCE_DEALLOC:
+ OMP_CLAUSE_MAP_KIND (node) = OMP_CLAUSE_MAP_FORCE_DEALLOC;
+ break;
+ case OMP_MAP_FORCE_TO:
+ OMP_CLAUSE_MAP_KIND (node) = OMP_CLAUSE_MAP_FORCE_TO;
+ break;
+ case OMP_MAP_FORCE_FROM:
+ OMP_CLAUSE_MAP_KIND (node) = OMP_CLAUSE_MAP_FORCE_FROM;
+ break;
+ case OMP_MAP_FORCE_TOFROM:
+ OMP_CLAUSE_MAP_KIND (node) = OMP_CLAUSE_MAP_FORCE_TOFROM;
+ break;
+ case OMP_MAP_FORCE_PRESENT:
+ OMP_CLAUSE_MAP_KIND (node) = OMP_CLAUSE_MAP_FORCE_PRESENT;
+ break;
default:
gcc_unreachable ();
}
diff --git a/gcc/testsuite/gfortran.dg/goacc/subarrays.f95 b/gcc/testsuite/gfortran.dg/goacc/subarrays.f95
new file mode 100644
index 0000000..4b3ef42
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/subarrays.f95
@@ -0,0 +1,41 @@
+! { dg-do compile }
+program test
+ implicit none
+ integer :: a(10), b(10, 10), c(3:7), i
+
+ !$acc parallel copy(a(1:5))
+ !$acc end parallel
+ !$acc parallel copy(a(1 + 0 : 5 + 2))
+ !$acc end parallel
+ !$acc parallel copy(a(:3))
+ !$acc end parallel
+ !$acc parallel copy(a(3:))
+ !$acc end parallel
+ !$acc parallel copy(a(:))
+ !$acc end parallel
+ !$acc parallel copy(a(2:3,2:3))
+ ! { dg-error "Rank mismatch" "" { target *-*-* } 16 }
+ ! { dg-error "'a' in MAP clause" "" { target *-*-* } 16 }
+ !$acc end parallel
+ !$acc parallel copy (a(:11)) ! { dg-warning "Upper array reference" }
+ !$acc end parallel
+ !$acc parallel copy (a(i:))
+ !$acc end parallel
+
+ !$acc parallel copy (a(:b))
+ ! { dg-error "Array index" "" { target *-*-* } 25 }
+ ! { dg-error "'a' in MAP clause" "" { target *-*-* } 25 }
+ !$acc end parallel
+
+ !$acc parallel copy (b(1:3,2:4))
+ !$acc end parallel
+ !$acc parallel copy (b(2:3))
+ ! { dg-error "Rank mismatch" "" { target *-*-* } 32 }
+ ! { dg-error "'b' in MAP clause" "" { target *-*-* } 32 }
+ !$acc end parallel
+ !$acc parallel copy (b(1:, 4:6))
+ !$acc end parallel
+
+ !$acc parallel copy (c(2:)) ! { dg-warning "Lower array reference" }
+ !$acc end parallel
+end program test
diff --git a/gcc/testsuite/gfortran.dg/gomp/map-1.f90 b/gcc/testsuite/gfortran.dg/gomp/map-1.f90
new file mode 100644
index 0000000..de96ed2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/map-1.f90
@@ -0,0 +1,109 @@
+subroutine test(aas)
+ implicit none
+
+ integer :: i, j(10), k(10, 10), aas(*)
+ integer, save :: tp
+ !$omp threadprivate(tp)
+ integer, parameter :: p = 1
+
+ type t
+ integer :: i, j(10)
+ end type t
+
+ type(t) :: tt
+
+ !$omp target map(i)
+ !$omp end target
+
+ !$omp target map(j)
+ !$omp end target
+
+ !$omp target map(p) ! { dg-error "Object 'p' is not a variable" }
+ !$omp end target
+
+ !$omp target map(j(1))
+ !$omp end target
+
+ !$omp target map(j(i))
+ !$omp end target
+
+ !$omp target map(j(i:))
+ !$omp end target
+
+ !$omp target map(j(:i))
+ !$omp end target
+
+ !$omp target map(j(i:i+1))
+ !$omp end target
+
+ !$omp target map(j(11)) ! { dg-warning "out of bounds" }
+ !$omp end target
+
+ !$omp target map(j(:11)) ! { dg-warning "out of bounds" }
+ !$omp end target
+
+ !$omp target map(j(0:)) ! { dg-warning "out of bounds" }
+ !$omp end target
+
+ !$omp target map(j(5:4)) ! { dg-error "Lower bound of OpenMP array section in greater than upper" "" { xfail *-*-* } }
+ !$omp end target
+
+ !$omp target map(j(5:))
+ !$omp end target
+
+ !$omp target map(j(:5))
+ !$omp end target
+
+ !$omp target map(j(:))
+ !$omp end target
+
+ !$omp target map(j(1:9:2)) ! { dg-error "Stride should not be specified for array section in MAP clause" }
+ !$omp end target
+
+ !$omp target map(aas(5:))
+ !$omp end target
+ ! { dg-error "Rightmost upper bound of assumed size array section not specified" "" { target *-*-* } 63 }
+ ! { dg-error "'aas' in MAP clause at \\\(1\\\) is not a proper array section" "" { target *-*-* } 63 }
+
+ !$omp target map(aas(:))
+ !$omp end target
+ ! { dg-error "Rightmost upper bound of assumed size array section not specified" "" { target *-*-* } 68 }
+ ! { dg-error "'aas' in MAP clause at \\\(1\\\) is not a proper array section" "" { target *-*-* } 68 }
+
+ !$omp target map(aas) ! { dg-error "The upper bound in the last dimension must appear" "" { xfail *-*-* } }
+ !$omp end target
+
+ !$omp target map(aas(5:7))
+ !$omp end target
+
+ !$omp target map(aas(:7))
+ !$omp end target
+
+ !$omp target map(k(5:))
+ !$omp end target
+ ! { dg-error "Rank mismatch in array reference" "" { target *-*-* } 82 }
+ ! { dg-error "'k' in MAP clause at \\\(1\\\) is not a proper array section" "" { target *-*-* } 82 }
+
+ !$omp target map(k(5:,:,3))
+ !$omp end target
+ ! { dg-error "Rank mismatch in array reference" "" { target *-*-* } 87 }
+ ! { dg-error "'k' in MAP clause at \\\(1\\\) is not a proper array section" "" { target *-*-* } 87 }
+
+ !$omp target map(tt)
+ !$omp end target
+
+ !$omp target map(tt%i) ! { dg-error "Syntax error in OpenMP variable list" }
+ !$omp end target ! { dg-bogus "Unexpected !\\\$OMP END TARGET statement" "" { xfail *-*-* } }
+
+ !$omp target map(tt%j) ! { dg-error "Syntax error in OpenMP variable list" }
+ !$omp end target ! { dg-bogus "Unexpected !\\\$OMP END TARGET statement" "" { xfail *-*-* } }
+
+ !$omp target map(tt%j(1)) ! { dg-bogus "Syntax error in OpenMP variable list" "" { xfail *-*-* } }
+ !$omp end target ! { dg-bogus "Unexpected !\\\$OMP END TARGET statement" "" { xfail *-*-* } }
+
+ !$omp target map(tt%j(1:)) ! { dg-bogus "Syntax error in OpenMP variable list" "" { xfail *-*-* } }
+ !$omp end target ! { dg-bogus "Unexpected !\\\$OMP END TARGET statement" "" { xfail *-*-* } }
+
+ !$omp target map(tp) ! { dg-error "THREADPRIVATE object 'tp' in MAP clause" }
+ !$omp end target
+end subroutine test
^ permalink raw reply [flat|nested] 12+ messages in thread
* Re: FWD: Re: OpenACC subarray specifications in the GCC Fortran front end
2014-07-24 23:18 ` Cesar Philippidis
@ 2014-07-25 16:12 ` Thomas Schwinge
2014-07-28 17:02 ` Cesar Philippidis
0 siblings, 1 reply; 12+ messages in thread
From: Thomas Schwinge @ 2014-07-25 16:12 UTC (permalink / raw)
To: Cesar Philippidis
Cc: gcc-patches, fortran, Ilmir Usmanov, Ilmir Usmanov,
Jakub Jelinek, Tobias Burnus
[-- Attachment #1: Type: text/plain, Size: 1535 bytes --]
Hi Cesar!
On Thu, 24 Jul 2014 15:44:13 -0700, Cesar Philippidis <cesar@codesourcery.com> wrote:
> On 07/24/2014 06:11 AM, Thomas Schwinge wrote:
> > I'd suggest to continue to handle all the data clauses [...]
>
> I moved all of the data clause matching back to gfc_match_omp_clauses,
> and I guarded the copyin clause with the openacc flag.
Thanks!
> It looks like the
> private clause may also require a special memory mapping, so I left the
> openacc flag in place.
Where is that? (I don't see it.)
> Is this patch OK to commit to gomp-4_0-branch?
Yes, though you may directly fold in the following patch to nuke the
unused OMP_LIST_COPY (or do that later).
--- gcc/fortran/dump-parse-tree.c
+++ gcc/fortran/dump-parse-tree.c
@@ -1257,7 +1257,6 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses)
const char *type = NULL;
switch (list_type)
{
- case OMP_LIST_COPY: type = "COPY"; break;
case OMP_LIST_DEVICEPTR: type = "DEVICEPTR"; break;
case OMP_LIST_USE_DEVICE: type = "USE_DEVICE"; break;
case OMP_LIST_DEVICE_RESIDENT: type = "USE_DEVICE"; break;
--- gcc/fortran/gfortran.h
+++ gcc/fortran/gfortran.h
@@ -1157,9 +1157,8 @@ enum
OMP_LIST_TO,
OMP_LIST_FROM,
OMP_LIST_REDUCTION,
- OMP_LIST_COPY,
- OMP_LIST_DATA_CLAUSE_FIRST = OMP_LIST_COPY,
OMP_LIST_DEVICEPTR,
+ OMP_LIST_DATA_CLAUSE_FIRST = OMP_LIST_DEVICEPTR,
OMP_LIST_DATA_CLAUSE_LAST = OMP_LIST_DEVICEPTR,
OMP_LIST_DEVICE_RESIDENT,
OMP_LIST_USE_DEVICE,
Grüße,
Thomas
[-- Attachment #2: Type: application/pgp-signature, Size: 472 bytes --]
^ permalink raw reply [flat|nested] 12+ messages in thread
* Re: FWD: Re: OpenACC subarray specifications in the GCC Fortran front end
2014-07-25 16:12 ` Thomas Schwinge
@ 2014-07-28 17:02 ` Cesar Philippidis
2014-11-11 15:02 ` [gomp4] " Thomas Schwinge
0 siblings, 1 reply; 12+ messages in thread
From: Cesar Philippidis @ 2014-07-28 17:02 UTC (permalink / raw)
To: Thomas Schwinge
Cc: gcc-patches, fortran, Ilmir Usmanov, Ilmir Usmanov,
Jakub Jelinek, Tobias Burnus
On 07/25/2014 09:01 AM, Thomas Schwinge wrote:
> On Thu, 24 Jul 2014 15:44:13 -0700, Cesar Philippidis <cesar@codesourcery.com> wrote:
>> On 07/24/2014 06:11 AM, Thomas Schwinge wrote:
>>> I'd suggest to continue to handle all the data clauses [...]
>>
>> I moved all of the data clause matching back to gfc_match_omp_clauses,
>> and I guarded the copyin clause with the openacc flag.
>
> Thanks!
>
>> It looks like the
>> private clause may also require a special memory mapping, so I left the
>> openacc flag in place.
>
> Where is that? (I don't see it.)
The loop construct has a private clause.
>> Is this patch OK to commit to gomp-4_0-branch?
>
> Yes, though you may directly fold in the following patch to nuke the
> unused OMP_LIST_COPY (or do that later).
Thanks, committed in r213131.
> --- gcc/fortran/dump-parse-tree.c
> +++ gcc/fortran/dump-parse-tree.c
> @@ -1257,7 +1257,6 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses)
> const char *type = NULL;
> switch (list_type)
> {
> - case OMP_LIST_COPY: type = "COPY"; break;
> case OMP_LIST_DEVICEPTR: type = "DEVICEPTR"; break;
> case OMP_LIST_USE_DEVICE: type = "USE_DEVICE"; break;
> case OMP_LIST_DEVICE_RESIDENT: type = "USE_DEVICE"; break;
> --- gcc/fortran/gfortran.h
> +++ gcc/fortran/gfortran.h
> @@ -1157,9 +1157,8 @@ enum
> OMP_LIST_TO,
> OMP_LIST_FROM,
> OMP_LIST_REDUCTION,
> - OMP_LIST_COPY,
> - OMP_LIST_DATA_CLAUSE_FIRST = OMP_LIST_COPY,
> OMP_LIST_DEVICEPTR,
> + OMP_LIST_DATA_CLAUSE_FIRST = OMP_LIST_DEVICEPTR,
> OMP_LIST_DATA_CLAUSE_LAST = OMP_LIST_DEVICEPTR,
> OMP_LIST_DEVICE_RESIDENT,
> OMP_LIST_USE_DEVICE,
I'll take care of this separately.
Cesar
^ permalink raw reply [flat|nested] 12+ messages in thread
* Re: FWD: Re: OpenACC subarray specifications in the GCC Fortran front end
2014-07-24 0:57 ` Cesar Philippidis
2014-07-24 13:16 ` Thomas Schwinge
@ 2014-08-01 7:48 ` Jakub Jelinek
2014-08-01 22:13 ` Cesar Philippidis
1 sibling, 1 reply; 12+ messages in thread
From: Jakub Jelinek @ 2014-08-01 7:48 UTC (permalink / raw)
To: Cesar Philippidis
Cc: Thomas Schwinge, gcc-patches, fortran, Ilmir Usmanov, Ilmir Usmanov
On Wed, Jul 23, 2014 at 05:42:32PM -0700, Cesar Philippidis wrote:
> >> Jakub, before your Fortran OpenMP 4 target changes, Ilmir had written the
> >> test case gcc/testsuite/gfortran.dg/gomp/map-1.f90 (based on his
> >> interpretation and implementation of OpenMP 4 target), which I have now
> >> amended with XFAILs and changed error messages -- anything in there that
> >> you'd like to see addressed for Fortran OpenMP 4 target?
> >
> >> + !$omp target map(j(5:4)) ! { dg-error "Lower bound of OpenMP array section in greater than upper" "" { xfail *-*-* } }
> >> + !$omp end target
> >
> > I think this isn't an error in Fortran, if low bound is above upper bound,
> > then it is considered a zero size array section. Though supposedly for
> > depend clause we might want to diagnose that.
> >
> >> + !$omp target map(aas) ! { dg-error "The upper bound in the last dimension must appear" "" { xfail *-*-* } }
> >> + !$omp end target
> >
> > Assumed-size in map without array section would be indeed nice thing to
> > diagnose.
> >
> >> + !$omp target map(tt%i) ! { dg-error "Syntax error in OpenMP variable list" }
> >> + !$omp end target ! { dg-bogus "Unexpected !\\\$OMP END TARGET statement" "" { xfail *-*-* } }
> >
> > Right now the parsing of !$omp directives in case of parsing error rejects
> > the whole directive, perhaps it should be reconsidered unless it is a fatal
> > error from which there is no easy way out.
> >
> >> + !$omp target map(tt%j(1)) ! { dg-bogus "Syntax error in OpenMP variable list" "" { xfail *-*-* } }
> >> + !$omp end target ! { dg-bogus "Unexpected !\\\$OMP END TARGET statement" "" { xfail *-*-* } }
> >> +
> >> + !$omp target map(tt%j(1:)) ! { dg-bogus "Syntax error in OpenMP variable list" "" { xfail *-*-* } }
> >> + !$omp end target ! { dg-bogus "Unexpected !\\\$OMP END TARGET statement" "" { xfail *-*-* } }
> >
> > These two are pending resolution on omp-lang, I had exchanged a few mails
> > about it, I think we shouldn't support those for consistency with the C/C++
> > support, where tt.j[1] or tt.j[1:] and similar is explicitly invalid.
>
> Jakub, should I drop the map-1.f90 test?
Not the whole testcase, just the problematic parts (or, just remove the
dg-error/xfail or replace dg-bogus xfail with dg-error), for the j(5:4)
and tt%j(1)/tt%j(1:) cases?
Jakub
^ permalink raw reply [flat|nested] 12+ messages in thread
* Re: FWD: Re: OpenACC subarray specifications in the GCC Fortran front end
2014-08-01 7:48 ` Jakub Jelinek
@ 2014-08-01 22:13 ` Cesar Philippidis
0 siblings, 0 replies; 12+ messages in thread
From: Cesar Philippidis @ 2014-08-01 22:13 UTC (permalink / raw)
To: Jakub Jelinek
Cc: Thomas Schwinge, gcc-patches, fortran, Ilmir Usmanov, Ilmir Usmanov
[-- Attachment #1: Type: text/plain, Size: 2465 bytes --]
On 08/01/2014 12:48 AM, Jakub Jelinek wrote:
> On Wed, Jul 23, 2014 at 05:42:32PM -0700, Cesar Philippidis wrote:
>>>> Jakub, before your Fortran OpenMP 4 target changes, Ilmir had written the
>>>> test case gcc/testsuite/gfortran.dg/gomp/map-1.f90 (based on his
>>>> interpretation and implementation of OpenMP 4 target), which I have now
>>>> amended with XFAILs and changed error messages -- anything in there that
>>>> you'd like to see addressed for Fortran OpenMP 4 target?
>>>
>>>> + !$omp target map(j(5:4)) ! { dg-error "Lower bound of OpenMP array section in greater than upper" "" { xfail *-*-* } }
>>>> + !$omp end target
>>>
>>> I think this isn't an error in Fortran, if low bound is above upper bound,
>>> then it is considered a zero size array section. Though supposedly for
>>> depend clause we might want to diagnose that.
>>>
>>>> + !$omp target map(aas) ! { dg-error "The upper bound in the last dimension must appear" "" { xfail *-*-* } }
>>>> + !$omp end target
>>>
>>> Assumed-size in map without array section would be indeed nice thing to
>>> diagnose.
>>>
>>>> + !$omp target map(tt%i) ! { dg-error "Syntax error in OpenMP variable list" }
>>>> + !$omp end target ! { dg-bogus "Unexpected !\\\$OMP END TARGET statement" "" { xfail *-*-* } }
>>>
>>> Right now the parsing of !$omp directives in case of parsing error rejects
>>> the whole directive, perhaps it should be reconsidered unless it is a fatal
>>> error from which there is no easy way out.
>>>
>>>> + !$omp target map(tt%j(1)) ! { dg-bogus "Syntax error in OpenMP variable list" "" { xfail *-*-* } }
>>>> + !$omp end target ! { dg-bogus "Unexpected !\\\$OMP END TARGET statement" "" { xfail *-*-* } }
>>>> +
>>>> + !$omp target map(tt%j(1:)) ! { dg-bogus "Syntax error in OpenMP variable list" "" { xfail *-*-* } }
>>>> + !$omp end target ! { dg-bogus "Unexpected !\\\$OMP END TARGET statement" "" { xfail *-*-* } }
>>>
>>> These two are pending resolution on omp-lang, I had exchanged a few mails
>>> about it, I think we shouldn't support those for consistency with the C/C++
>>> support, where tt.j[1] or tt.j[1:] and similar is explicitly invalid.
>>
>> Jakub, should I drop the map-1.f90 test?
>
> Not the whole testcase, just the problematic parts (or, just remove the
> dg-error/xfail or replace dg-bogus xfail with dg-error), for the j(5:4)
> and tt%j(1)/tt%j(1:) cases?
Thank you for the feedback. I've committed those changes to gomp-4_0-branch.
Cesar
[-- Attachment #2: gomp-map-test.diff --]
[-- Type: text/x-patch, Size: 2099 bytes --]
2014-08-01 Cesar Philippidis <cesar@codesourcery.com>
gcc/testsuite/
* gfortran.dg/gomp/map-1.f90 (test): Update error reporting.
diff --git a/gcc/testsuite/gfortran.dg/gomp/map-1.f90 b/gcc/testsuite/gfortran.dg/gomp/map-1.f90
index de96ed2..e4b8b86 100644
--- a/gcc/testsuite/gfortran.dg/gomp/map-1.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/map-1.f90
@@ -45,7 +45,7 @@ subroutine test(aas)
!$omp target map(j(0:)) ! { dg-warning "out of bounds" }
!$omp end target
- !$omp target map(j(5:4)) ! { dg-error "Lower bound of OpenMP array section in greater than upper" "" { xfail *-*-* } }
+ !$omp target map(j(5:4))
!$omp end target
!$omp target map(j(5:))
@@ -93,16 +93,17 @@ subroutine test(aas)
!$omp end target
!$omp target map(tt%i) ! { dg-error "Syntax error in OpenMP variable list" }
- !$omp end target ! { dg-bogus "Unexpected !\\\$OMP END TARGET statement" "" { xfail *-*-* } }
+ !$omp end target ! { dg-error "Unexpected !\\\$OMP END TARGET statement" }
!$omp target map(tt%j) ! { dg-error "Syntax error in OpenMP variable list" }
- !$omp end target ! { dg-bogus "Unexpected !\\\$OMP END TARGET statement" "" { xfail *-*-* } }
+ !$omp end target ! { dg-error "Unexpected !\\\$OMP END TARGET statement" }
- !$omp target map(tt%j(1)) ! { dg-bogus "Syntax error in OpenMP variable list" "" { xfail *-*-* } }
- !$omp end target ! { dg-bogus "Unexpected !\\\$OMP END TARGET statement" "" { xfail *-*-* } }
+ ! broken test
+ !$omp target map(tt%j(1)) ! { dg-error "Syntax error in OpenMP variable list" }
+ !$omp end target ! { dg-error "Unexpected !\\\$OMP END TARGET statement" }
- !$omp target map(tt%j(1:)) ! { dg-bogus "Syntax error in OpenMP variable list" "" { xfail *-*-* } }
- !$omp end target ! { dg-bogus "Unexpected !\\\$OMP END TARGET statement" "" { xfail *-*-* } }
+ !$omp target map(tt%j(1:)) ! { dg-error "Syntax error in OpenMP variable list" }
+ !$omp end target ! { dg-error "Unexpected !\\\$OMP END TARGET statement" }
!$omp target map(tp) ! { dg-error "THREADPRIVATE object 'tp' in MAP clause" }
!$omp end target
^ permalink raw reply [flat|nested] 12+ messages in thread
* [gomp4] Re: FWD: Re: OpenACC subarray specifications in the GCC Fortran front end
2014-07-24 13:16 ` Thomas Schwinge
2014-07-24 23:18 ` Cesar Philippidis
@ 2014-11-11 14:57 ` Thomas Schwinge
1 sibling, 0 replies; 12+ messages in thread
From: Thomas Schwinge @ 2014-11-11 14:57 UTC (permalink / raw)
To: gcc-patches, fortran
Cc: Cesar Philippidis, Ilmir Usmanov, Ilmir Usmanov, Jakub Jelinek,
Tobias Burnus
[-- Attachment #1: Type: text/plain, Size: 9867 bytes --]
Hi!
On Thu, 24 Jul 2014 15:11:08 +0200, I wrote:
> On Wed, 23 Jul 2014 17:42:32 -0700, Cesar Philippidis <cesar@codesourcery.com> wrote:
> > On 07/11/2014 03:29 AM, Jakub Jelinek wrote:
> > > On Fri, Jul 11, 2014 at 12:11:10PM +0200, Thomas Schwinge wrote:
> > >> To avoid duplication of work: with Jakub's Fortran OpenMP 4 target
> > >> changes recently committed to trunk, and now merged into gomp-4_0-branch,
> > >> I have trimmed down Ilmir's patch to just the OpenACC bits, OpenMP 4
> > >> target changes removed, and TODO markers added to integrate into that.
> > >
> > > Resolving the TODO markers would be nice, indeed.
> >
> > This patch has the openacc data clauses use the new openmp maps. In the
> > process of doing so, I removed a lot of the old OMP_LIST_ enums and
> > added a few OMP_MAP enums to match what the c frontend currently supports.
>
> Thanks!
> OMP_LIST_DEVICEPTR remains to be converted, which can be done as a later
> follow-up patch.
I have now committed the following to gomp-4_0-branch in r217352:
commit 779291a1fe21b3c0b0c0c615a0557f070f495d14
Author: tschwinge <tschwinge@138bc75d-0d04-0410-961f-82ee72b054a4>
Date: Tue Nov 11 14:52:04 2014 +0000
OpenACC deviceptr clause: Fix handling in Fortran.
With two gcc_asserts restored, and not handling OpenACC deviceptr clauses in
the same data paths as other OpenACC data clauses, we'd run into an internal
compiler error, when the deviceptr clause is used with (non-offloaded) OpenACC
data regions:
FAIL: gfortran.dg/goacc/data-tree.f95 -O (internal compiler error)
FAIL: gfortran.dg/goacc/data-tree.f95 -O (test for excess errors)
gcc/fortran/
* gfortran.h (OMP_LIST_DEVICEPTR): Remove, and instead...
(enum gfc_omp_map_op): ... add OMP_MAP_FORCE_DEVICEPTR here.
* dump-parse-tree.c (show_omp_clauses): Update.
* openmp.c (gfc_match_omp_clauses, resolve_omp_clauses)
(gfc_resolve_oacc_declare): Likewise.
* trans-openmp.c (gfc_trans_omp_clauses): Likewise.
gcc/
* omp-low.c (lower_omp_target): Restore two gcc_asserts.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/branches/gomp-4_0-branch@217352 138bc75d-0d04-0410-961f-82ee72b054a4
---
gcc/ChangeLog.gomp | 4 ++++
gcc/fortran/ChangeLog.gomp | 9 +++++++++
gcc/fortran/dump-parse-tree.c | 1 -
gcc/fortran/gfortran.h | 6 +++---
gcc/fortran/openmp.c | 38 ++++++++++++++++++++++----------------
gcc/fortran/trans-openmp.c | 6 +++---
gcc/omp-low.c | 2 ++
7 files changed, 43 insertions(+), 23 deletions(-)
diff --git gcc/ChangeLog.gomp gcc/ChangeLog.gomp
index 9c997ce..dacfad8 100644
--- gcc/ChangeLog.gomp
+++ gcc/ChangeLog.gomp
@@ -1,3 +1,7 @@
+2014-11-11 Thomas Schwinge <thomas@codesourcery.com>
+
+ * omp-low.c (lower_omp_target): Restore two gcc_asserts.
+
2014-11-06 Thomas Schwinge <thomas@codesourcery.com>
* gimple.h (is_gimple_omp_oacc_specifically): Return true for
diff --git gcc/fortran/ChangeLog.gomp gcc/fortran/ChangeLog.gomp
index d10560e..1ae1d31 100644
--- gcc/fortran/ChangeLog.gomp
+++ gcc/fortran/ChangeLog.gomp
@@ -1,3 +1,12 @@
+2014-11-11 Thomas Schwinge <thomas@codesourcery.com>
+
+ * gfortran.h (OMP_LIST_DEVICEPTR): Remove, and instead...
+ (enum gfc_omp_map_op): ... add OMP_MAP_FORCE_DEVICEPTR here.
+ * dump-parse-tree.c (show_omp_clauses): Update.
+ * openmp.c (gfc_match_omp_clauses, resolve_omp_clauses)
+ (gfc_resolve_oacc_declare): Likewise.
+ * trans-openmp.c (gfc_trans_omp_clauses): Likewise.
+
2014-11-05 Thomas Schwinge <thomas@codesourcery.com>
* openmp.c (OMP_CLAUSE_HOST, OMP_CLAUSE_SELF): Merge into the new
diff --git gcc/fortran/dump-parse-tree.c gcc/fortran/dump-parse-tree.c
index 57af730..e7aff22 100644
--- gcc/fortran/dump-parse-tree.c
+++ gcc/fortran/dump-parse-tree.c
@@ -1252,7 +1252,6 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses)
switch (list_type)
{
case OMP_LIST_COPY: type = "COPY"; break;
- case OMP_LIST_DEVICEPTR: type = "DEVICEPTR"; break;
case OMP_LIST_USE_DEVICE: type = "USE_DEVICE"; break;
case OMP_LIST_DEVICE_RESIDENT: type = "USE_DEVICE"; break;
case OMP_LIST_CACHE: type = ""; break;
diff --git gcc/fortran/gfortran.h gcc/fortran/gfortran.h
index 6bd131c..18adbee 100644
--- gcc/fortran/gfortran.h
+++ gcc/fortran/gfortran.h
@@ -1141,7 +1141,8 @@ typedef enum
OMP_MAP_FORCE_TO,
OMP_MAP_FORCE_FROM,
OMP_MAP_FORCE_TOFROM,
- OMP_MAP_FORCE_PRESENT
+ OMP_MAP_FORCE_PRESENT,
+ OMP_MAP_FORCE_DEVICEPTR
}
gfc_omp_map_op;
@@ -1184,8 +1185,7 @@ enum
OMP_LIST_REDUCTION,
OMP_LIST_COPY,
OMP_LIST_DATA_CLAUSE_FIRST = OMP_LIST_COPY,
- OMP_LIST_DEVICEPTR,
- OMP_LIST_DATA_CLAUSE_LAST = OMP_LIST_DEVICEPTR,
+ OMP_LIST_DATA_CLAUSE_LAST = OMP_LIST_DATA_CLAUSE_FIRST,
OMP_LIST_DEVICE_RESIDENT,
OMP_LIST_USE_DEVICE,
OMP_LIST_CACHE,
diff --git gcc/fortran/openmp.c gcc/fortran/openmp.c
index 959798a..82726b8 100644
--- gcc/fortran/openmp.c
+++ gcc/fortran/openmp.c
@@ -666,10 +666,19 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, unsigned long long mask,
OMP_MAP_ALLOC))
continue;
if ((mask & OMP_CLAUSE_DEVICEPTR)
- && gfc_match_omp_variable_list ("deviceptr (",
- &c->lists[OMP_LIST_DEVICEPTR], true)
- == MATCH_YES)
- continue;
+ && gfc_match ("deviceptr ( ") == MATCH_YES)
+ {
+ gfc_omp_namelist **list = &c->lists[OMP_LIST_MAP];
+ gfc_omp_namelist **head = NULL;
+ if (gfc_match_omp_variable_list ("", list, true, NULL, &head, false)
+ == MATCH_YES)
+ {
+ gfc_omp_namelist *n;
+ for (n = *head; n; n = n->next)
+ n->u.map_op = OMP_MAP_FORCE_DEVICEPTR;
+ continue;
+ }
+ }
if ((mask & OMP_CLAUSE_USE_DEVICE)
&& gfc_match_omp_variable_list ("use_device (",
&c->lists[OMP_LIST_USE_DEVICE], true)
@@ -2864,7 +2873,7 @@ resolve_omp_clauses (gfc_code *code, locus *where,
"TO", "FROM", "REDUCTION",
"COPY", "COPYIN", "COPYOUT", "CREATE", "DELETE", "PRESENT",
"PRESENT_OR_COPY", "PRESENT_OR_COPYIN", "PRESENT_OR_COPYOUT",
- "PRESENT_OR_CREATE", "DEVICEPTR", "DEVICE_RESIDENT", "USE_DEVICE",
+ "PRESENT_OR_CREATE", "DEVICE_RESIDENT", "USE_DEVICE",
"HOST", "DEVICE", "CACHE" };
if (omp_clauses == NULL)
@@ -3152,8 +3161,13 @@ resolve_omp_clauses (gfc_code *code, locus *where,
}
}
else if (openacc)
- resolve_oacc_data_clauses (n->sym, *where,
- clause_names[list]);
+ {
+ if (list == OMP_LIST_MAP
+ && n->u.map_op == OMP_MAP_FORCE_DEVICEPTR)
+ resolve_oacc_deviceptr_clause (n->sym, *where, name);
+ else
+ resolve_oacc_data_clauses (n->sym, *where, name);
+ }
}
if (list != OMP_LIST_DEPEND)
@@ -3360,9 +3374,6 @@ resolve_omp_clauses (gfc_code *code, locus *where,
case OMP_LIST_PRIVATE:
gcc_assert (code && code->op != EXEC_NOP);
break;
- case OMP_LIST_DEVICEPTR:
- resolve_oacc_deviceptr_clause (n->sym, *where, name);
- break;
case OMP_LIST_USE_DEVICE:
if (n->sym->attr.allocatable
|| (n->sym->ts.type == BT_CLASS && CLASS_DATA (n->sym)
@@ -4609,7 +4620,7 @@ gfc_resolve_oacc_declare (gfc_namespace *ns)
locus loc;
static const char *clause_names[] = {"COPY", "COPYIN", "COPYOUT", "CREATE",
"DELETE", "PRESENT", "PRESENT_OR_COPY", "PRESENT_OR_COPYIN",
- "PRESENT_OR_COPYOUT", "PRESENT_OR_CREATE", "DEVICEPTR",
+ "PRESENT_OR_COPYOUT", "PRESENT_OR_CREATE",
"DEVICE_RESIDENT"};
if (ns->oacc_declare_clauses == NULL)
@@ -4647,11 +4658,6 @@ gfc_resolve_oacc_declare (gfc_namespace *ns)
resolve_oacc_data_clauses (n->sym, loc, name);
}
- for (n = ns->oacc_declare_clauses->lists[OMP_LIST_DEVICEPTR]; n; n = n->next)
- resolve_oacc_deviceptr_clause (n->sym, loc,
- clause_names[OMP_LIST_DEVICEPTR -
- OMP_LIST_DATA_CLAUSE_FIRST]);
-
for (n = ns->oacc_declare_clauses->lists[OMP_LIST_DEVICE_RESIDENT]; n;
n = n->next)
check_array_not_assumed (n->sym, loc,
diff --git gcc/fortran/trans-openmp.c gcc/fortran/trans-openmp.c
index 7dd4498..c1cf5a9 100644
--- gcc/fortran/trans-openmp.c
+++ gcc/fortran/trans-openmp.c
@@ -1765,9 +1765,6 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
enum omp_clause_map_kind kind;
switch (list)
{
- case OMP_LIST_DEVICEPTR:
- kind = OMP_CLAUSE_MAP_FORCE_DEVICEPTR;
- break;
default:
gcc_unreachable ();
}
@@ -2164,6 +2161,9 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
case OMP_MAP_FORCE_PRESENT:
OMP_CLAUSE_MAP_KIND (node) = OMP_CLAUSE_MAP_FORCE_PRESENT;
break;
+ case OMP_MAP_FORCE_DEVICEPTR:
+ OMP_CLAUSE_MAP_KIND (node) = OMP_CLAUSE_MAP_FORCE_DEVICEPTR;
+ break;
default:
gcc_unreachable ();
}
diff --git gcc/omp-low.c gcc/omp-low.c
index 23d9f5a8..c63ec4e 100644
--- gcc/omp-low.c
+++ gcc/omp-low.c
@@ -12044,6 +12044,7 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx)
&& !OMP_CLAUSE_MAP_ZERO_BIAS_ARRAY_SECTION (c)
&& TREE_CODE (TREE_TYPE (ovar)) == ARRAY_TYPE)
{
+ gcc_assert (kind == GF_OMP_TARGET_KIND_REGION);
tree avar
= create_tmp_var (TREE_TYPE (TREE_TYPE (x)), NULL);
mark_addressable (avar);
@@ -12054,6 +12055,7 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx)
}
else if (is_gimple_reg (var))
{
+ gcc_assert (kind == GF_OMP_TARGET_KIND_REGION);
tree avar = create_tmp_var (TREE_TYPE (var), NULL);
mark_addressable (avar);
enum omp_clause_map_kind map_kind
Grüße,
Thomas
[-- Attachment #2: Type: application/pgp-signature, Size: 472 bytes --]
^ permalink raw reply [flat|nested] 12+ messages in thread
* [gomp4] Re: FWD: Re: OpenACC subarray specifications in the GCC Fortran front end
2014-07-28 17:02 ` Cesar Philippidis
@ 2014-11-11 15:02 ` Thomas Schwinge
0 siblings, 0 replies; 12+ messages in thread
From: Thomas Schwinge @ 2014-11-11 15:02 UTC (permalink / raw)
To: gcc-patches, fortran
Cc: Cesar Philippidis, Ilmir Usmanov, Ilmir Usmanov, Jakub Jelinek,
Tobias Burnus
[-- Attachment #1: Type: text/plain, Size: 9274 bytes --]
Hi!
On Mon, 28 Jul 2014 10:00:46 -0700, Cesar Philippidis <cesar@codesourcery.com> wrote:
> On 07/25/2014 09:01 AM, Thomas Schwinge wrote:
> > [...] you may directly fold in the following patch to nuke the
> > unused OMP_LIST_COPY (or do that later).
> > --- gcc/fortran/dump-parse-tree.c
> > +++ gcc/fortran/dump-parse-tree.c
> > @@ -1257,7 +1257,6 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses)
> > const char *type = NULL;
> > switch (list_type)
> > {
> > - case OMP_LIST_COPY: type = "COPY"; break;
> > case OMP_LIST_DEVICEPTR: type = "DEVICEPTR"; break;
> > case OMP_LIST_USE_DEVICE: type = "USE_DEVICE"; break;
> > case OMP_LIST_DEVICE_RESIDENT: type = "USE_DEVICE"; break;
> > --- gcc/fortran/gfortran.h
> > +++ gcc/fortran/gfortran.h
> > @@ -1157,9 +1157,8 @@ enum
> > OMP_LIST_TO,
> > OMP_LIST_FROM,
> > OMP_LIST_REDUCTION,
> > - OMP_LIST_COPY,
> > - OMP_LIST_DATA_CLAUSE_FIRST = OMP_LIST_COPY,
> > OMP_LIST_DEVICEPTR,
> > + OMP_LIST_DATA_CLAUSE_FIRST = OMP_LIST_DEVICEPTR,
> > OMP_LIST_DATA_CLAUSE_LAST = OMP_LIST_DEVICEPTR,
> > OMP_LIST_DEVICE_RESIDENT,
> > OMP_LIST_USE_DEVICE,
>
> I'll take care of this separately.
I have now committed the following to gomp-4_0-branch in r217353:
commit 782a3dab5694d561f80bda7a29000250a681781a
Author: tschwinge <tschwinge@138bc75d-0d04-0410-961f-82ee72b054a4>
Date: Tue Nov 11 14:52:16 2014 +0000
Fortran OMP_LIST_* maintenance.
gcc/fortran/
* gfortran.h (OMP_LIST_COPY, OMP_LIST_DATA_CLAUSE_FIRST)
(OMP_LIST_DATA_CLAUSE_LAST, OMP_LIST_LAST): Remove.
* dump-parse-tree.c (show_omp_clauses): Update.
* openmp.c (resolve_omp_clauses, gfc_resolve_oacc_declare):
Likewise.
* trans-openmp.c (gfc_trans_omp_clauses): Likewise.
(gfc_trans_omp_map_clause_list): Remove.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/branches/gomp-4_0-branch@217353 138bc75d-0d04-0410-961f-82ee72b054a4
---
gcc/fortran/ChangeLog.gomp | 8 ++++++++
gcc/fortran/dump-parse-tree.c | 1 -
gcc/fortran/gfortran.h | 6 +-----
gcc/fortran/openmp.c | 42 ++++++++++--------------------------------
gcc/fortran/trans-openmp.c | 31 -------------------------------
5 files changed, 19 insertions(+), 69 deletions(-)
diff --git gcc/fortran/ChangeLog.gomp gcc/fortran/ChangeLog.gomp
index 1ae1d31..f846890 100644
--- gcc/fortran/ChangeLog.gomp
+++ gcc/fortran/ChangeLog.gomp
@@ -1,5 +1,13 @@
2014-11-11 Thomas Schwinge <thomas@codesourcery.com>
+ * gfortran.h (OMP_LIST_COPY, OMP_LIST_DATA_CLAUSE_FIRST)
+ (OMP_LIST_DATA_CLAUSE_LAST, OMP_LIST_LAST): Remove.
+ * dump-parse-tree.c (show_omp_clauses): Update.
+ * openmp.c (resolve_omp_clauses, gfc_resolve_oacc_declare):
+ Likewise.
+ * trans-openmp.c (gfc_trans_omp_clauses): Likewise.
+ (gfc_trans_omp_map_clause_list): Remove.
+
* gfortran.h (OMP_LIST_DEVICEPTR): Remove, and instead...
(enum gfc_omp_map_op): ... add OMP_MAP_FORCE_DEVICEPTR here.
* dump-parse-tree.c (show_omp_clauses): Update.
diff --git gcc/fortran/dump-parse-tree.c gcc/fortran/dump-parse-tree.c
index e7aff22..e9d04e7 100644
--- gcc/fortran/dump-parse-tree.c
+++ gcc/fortran/dump-parse-tree.c
@@ -1251,7 +1251,6 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses)
const char *type = NULL;
switch (list_type)
{
- case OMP_LIST_COPY: type = "COPY"; break;
case OMP_LIST_USE_DEVICE: type = "USE_DEVICE"; break;
case OMP_LIST_DEVICE_RESIDENT: type = "USE_DEVICE"; break;
case OMP_LIST_CACHE: type = ""; break;
diff --git gcc/fortran/gfortran.h gcc/fortran/gfortran.h
index 18adbee..aed37d3 100644
--- gcc/fortran/gfortran.h
+++ gcc/fortran/gfortran.h
@@ -1183,14 +1183,10 @@ enum
OMP_LIST_TO,
OMP_LIST_FROM,
OMP_LIST_REDUCTION,
- OMP_LIST_COPY,
- OMP_LIST_DATA_CLAUSE_FIRST = OMP_LIST_COPY,
- OMP_LIST_DATA_CLAUSE_LAST = OMP_LIST_DATA_CLAUSE_FIRST,
OMP_LIST_DEVICE_RESIDENT,
OMP_LIST_USE_DEVICE,
OMP_LIST_CACHE,
- OMP_LIST_NUM,
- OMP_LIST_LAST = OMP_LIST_NUM
+ OMP_LIST_NUM
};
/* Because a symbol can belong to multiple namelists, they must be
diff --git gcc/fortran/openmp.c gcc/fortran/openmp.c
index 82726b8..47c146e 100644
--- gcc/fortran/openmp.c
+++ gcc/fortran/openmp.c
@@ -2870,11 +2870,8 @@ resolve_omp_clauses (gfc_code *code, locus *where,
static const char *clause_names[]
= { "PRIVATE", "FIRSTPRIVATE", "LASTPRIVATE", "COPYPRIVATE", "SHARED",
"COPYIN", "UNIFORM", "ALIGNED", "LINEAR", "DEPEND", "MAP",
- "TO", "FROM", "REDUCTION",
- "COPY", "COPYIN", "COPYOUT", "CREATE", "DELETE", "PRESENT",
- "PRESENT_OR_COPY", "PRESENT_OR_COPYIN", "PRESENT_OR_COPYOUT",
- "PRESENT_OR_CREATE", "DEVICE_RESIDENT", "USE_DEVICE",
- "HOST", "DEVICE", "CACHE" };
+ "TO", "FROM", "REDUCTION", "DEVICE_RESIDENT", "USE_DEVICE",
+ "CACHE" };
if (omp_clauses == NULL)
return;
@@ -3231,15 +3228,6 @@ resolve_omp_clauses (gfc_code *code, locus *where,
break;
}
- if (list >= OMP_LIST_DATA_CLAUSE_FIRST
- && list < OMP_LIST_DATA_CLAUSE_LAST)
- resolve_oacc_data_clauses (n->sym, *where, name);
-
- if (list > OMP_LIST_DATA_CLAUSE_LAST)
- {
- check_symbol_not_pointer (n->sym, *where, name);
- check_array_not_assumed (n->sym, *where, name);
- }
switch (list)
{
case OMP_LIST_REDUCTION:
@@ -3391,6 +3379,11 @@ resolve_omp_clauses (gfc_code *code, locus *where,
if (n->sym->attr.cray_pointee)
gfc_error ("Cray pointee object '%s' in %s clause at %L",
n->sym->name, name, where);
+ /* FALLTHRU */
+ case OMP_LIST_DEVICE_RESIDENT:
+ case OMP_LIST_CACHE:
+ check_symbol_not_pointer (n->sym, *where, name);
+ check_array_not_assumed (n->sym, *where, name);
break;
default:
break;
@@ -4618,10 +4611,6 @@ gfc_resolve_oacc_declare (gfc_namespace *ns)
int list;
gfc_omp_namelist *n;
locus loc;
- static const char *clause_names[] = {"COPY", "COPYIN", "COPYOUT", "CREATE",
- "DELETE", "PRESENT", "PRESENT_OR_COPY", "PRESENT_OR_COPYIN",
- "PRESENT_OR_COPYOUT", "PRESENT_OR_CREATE",
- "DEVICE_RESIDENT"};
if (ns->oacc_declare_clauses == NULL)
return;
@@ -4629,7 +4618,7 @@ gfc_resolve_oacc_declare (gfc_namespace *ns)
loc = ns->oacc_declare_clauses->ext.loc;
/* FIXME: handle omp_list_map. */
- for (list = OMP_LIST_DATA_CLAUSE_FIRST;
+ for (/* TODO */ list = OMP_LIST_DEVICE_RESIDENT;
list <= OMP_LIST_DEVICE_RESIDENT; list++)
for (n = ns->oacc_declare_clauses->lists[list]; n; n = n->next)
{
@@ -4638,7 +4627,7 @@ gfc_resolve_oacc_declare (gfc_namespace *ns)
gfc_error ("PARAMETER object '%s' is not allowed at %L", n->sym->name, &loc);
}
- for (list = OMP_LIST_DATA_CLAUSE_FIRST;
+ for (/* TODO */ list = OMP_LIST_DEVICE_RESIDENT;
list <= OMP_LIST_DEVICE_RESIDENT; list++)
for (n = ns->oacc_declare_clauses->lists[list]; n; n = n->next)
{
@@ -4649,20 +4638,9 @@ gfc_resolve_oacc_declare (gfc_namespace *ns)
n->sym->mark = 1;
}
- for (list = OMP_LIST_DATA_CLAUSE_FIRST;
- list < OMP_LIST_DATA_CLAUSE_LAST; /* Skip deviceptr clause. */
- list++)
- {
- const char *name = clause_names[list - OMP_LIST_DATA_CLAUSE_FIRST];
- for (n = ns->oacc_declare_clauses->lists[list]; n; n = n->next)
- resolve_oacc_data_clauses (n->sym, loc, name);
- }
-
for (n = ns->oacc_declare_clauses->lists[OMP_LIST_DEVICE_RESIDENT]; n;
n = n->next)
- check_array_not_assumed (n->sym, loc,
- clause_names[OMP_LIST_DEVICE_RESIDENT -
- OMP_LIST_DATA_CLAUSE_FIRST]);
+ check_array_not_assumed (n->sym, loc, "DEVICE_RESIDENT");
}
diff --git gcc/fortran/trans-openmp.c gcc/fortran/trans-openmp.c
index c1cf5a9..6967c4f 100644
--- gcc/fortran/trans-openmp.c
+++ gcc/fortran/trans-openmp.c
@@ -1707,25 +1707,6 @@ gfc_trans_omp_reduction_list (gfc_omp_namelist *namelist, tree list,
return list;
}
-static tree
-gfc_trans_omp_map_clause_list (enum omp_clause_map_kind kind,
- gfc_omp_namelist *namelist, tree list)
-{
- for (; namelist != NULL; namelist = namelist->next)
- if (namelist->sym->attr.referenced)
- {
- tree t = gfc_trans_omp_variable (namelist->sym, false);
- if (t != error_mark_node)
- {
- tree node = build_omp_clause (input_location, OMP_CLAUSE_MAP);
- OMP_CLAUSE_DECL (node) = t;
- OMP_CLAUSE_MAP_KIND (node) = kind;
- list = gfc_trans_add_clause (node, list);
- }
- }
- return list;
-}
-
static inline tree
gfc_convert_expr_to_tree (stmtblock_t *block, gfc_expr *expr)
{
@@ -1759,18 +1740,6 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
if (n == NULL)
continue;
- if (list >= OMP_LIST_DATA_CLAUSE_FIRST
- && list <= OMP_LIST_DATA_CLAUSE_LAST)
- {
- enum omp_clause_map_kind kind;
- switch (list)
- {
- default:
- gcc_unreachable ();
- }
- omp_clauses = gfc_trans_omp_map_clause_list (kind, n, omp_clauses);
- continue;
- }
switch (list)
{
case OMP_LIST_REDUCTION:
Grüße,
Thomas
[-- Attachment #2: Type: application/pgp-signature, Size: 472 bytes --]
^ permalink raw reply [flat|nested] 12+ messages in thread
end of thread, other threads:[~2014-11-11 15:01 UTC | newest]
Thread overview: 12+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
[not found] <87ha4p92qj.fsf@schwinge.name>
[not found] ` <53763254.1000402@samsung.com>
2014-05-22 7:32 ` FWD: Re: OpenACC subarray specifications in the GCC Fortran front end Ilmir Usmanov
2014-07-11 10:11 ` Thomas Schwinge
2014-07-11 10:29 ` Jakub Jelinek
2014-07-24 0:57 ` Cesar Philippidis
2014-07-24 13:16 ` Thomas Schwinge
2014-07-24 23:18 ` Cesar Philippidis
2014-07-25 16:12 ` Thomas Schwinge
2014-07-28 17:02 ` Cesar Philippidis
2014-11-11 15:02 ` [gomp4] " Thomas Schwinge
2014-11-11 14:57 ` Thomas Schwinge
2014-08-01 7:48 ` Jakub Jelinek
2014-08-01 22:13 ` Cesar Philippidis
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).