Fortran: cleanup OpenMP's OMP_LIST_* handling
gcc/fortran/ChangeLog:
* dump-parse-tree.c (show_omp_namelist, show_omp_node): Update for
new internal representation of gfc_omp_namelist.
(show_omp_clauses): Likewise; replace own list by call to
gfc_omp_get_clause_name.
* frontend-passes.c (gfc_code_walker): Update gfc_omp_namelist handling.
* gfortran.h (gfc_omp_namelist_item): Renamed from gfc_omp_namelist.
(gfc_get_omp_namelist_item): Renamed from gfc_get_omp_namelist.
(enum omp_list_clauses): Add name to enum, remove OMP_LIST_FIRST and
OMP_LIST_NUM, add OMP_LIST_UNSET.
(gfc_get_omp_namelist, gfc_omp_namelist): New.
(gfc_omp_clauses): Use new gfc_get_omp_namelist.
(gfc_code): Update for renaming.
(gfc_free_omp_namelist_item): Renamed from gfc_free_omp_namelist and
updated.
(gfc_omp_get_clause_name, gfc_omp_get_nm_ref, gfc_omp_get_nm_list): New.
* match.c (gfc_free_omp_namelist_item): Renamed from
gfc_free_omp_namelist.
* module.c (mio_omp_declare_simd): Update for gfc_omp_namelist changes.
* openmp.c (gfc_free_omp_clauses, gfc_match_omp_variable_list,
gfc_match_omp_to_link, gfc_match_omp_depend_sink,
gfc_match_oacc_clause_link, gfc_match_omp_map_clause): Likewise.
(gfc_omp_get_clause_name, gfc_omp_get_nm_ref, gfc_omp_get_nm_list): New.
(gfc_match_omp_clause_reduction, gfc_match_omp_clauses,
gfc_match_oacc_declare, gfc_match_oacc_update, gfc_match_oacc_cache,
gfc_match_omp_flush, gfc_match_omp_declare_target,
resolve_omp_udr_clause, resolve_omp_clauses,
gfc_resolve_omp_parallel_blocks, gfc_resolve_do_iterator,
resolve_omp_do, gfc_resolve_oacc_blocks, gfc_resolve_oacc_declare,
gfc_resolve_omp_directive): Use new functions; update for
gfc_omp_namelist changes.
* parse.c (parse_omp_structured_block): Likewise
* st.c (gfc_free_statement): Likewise
* trans-decl.c (add_clause, finish_oacc_declare): Likewise.
* trans-openmp.c (gfc_copy_list_clauses,
gfc_trans_omp_free_clausea): New.
(gfc_trans_omp_variable_list, gfc_trans_omp_array_reduction_or_udr,
gfc_trans_omp_reduction_list, gfc_trans_omp_array_section,
gfc_trans_omp_clauses, gfc_trans_omp_do,
gfc_trans_oacc_combined_directive, gfc_split_omp_clauses,
gfc_trans_omp_do_simd, gfc_trans_omp_parallel_do,
gfc_trans_omp_parallel_do_simd, gfc_trans_omp_sections,
gfc_trans_omp_distribute, gfc_trans_omp_teams, gfc_trans_omp_target,
gfc_trans_omp_taskloop): Use them; update for gfc_omp_namelist changes.
gcc/testsuite/ChangeLog:
* gfortran.dg/goacc/combined-directives.f90: Update scan-tree pattern.
* gfortran.dg/goacc/reduction-2.f95: Likewise.
* gfortran.dg/gomp/openmp-simd-6.f90: Likewise.
* gfortran.dg/gomp/reduction4.f90: Likewise.
gcc/fortran/dump-parse-tree.c | 57 +-
gcc/fortran/frontend-passes.c | 14 +-
gcc/fortran/gfortran.h | 40 +-
gcc/fortran/match.c | 4 +-
gcc/fortran/module.c | 31 +-
gcc/fortran/openmp.c | 723 ++++++++++++---------
gcc/fortran/parse.c | 10 +-
gcc/fortran/st.c | 2 +-
gcc/fortran/trans-decl.c | 35 +-
gcc/fortran/trans-openmp.c | 237 ++++---
.../gfortran.dg/goacc/combined-directives.f90 | 5 +-
gcc/testsuite/gfortran.dg/goacc/reduction-2.f95 | 4 +-
gcc/testsuite/gfortran.dg/gomp/openmp-simd-6.f90 | 4 +-
gcc/testsuite/gfortran.dg/gomp/reduction4.f90 | 6 +-
14 files changed, 666 insertions(+), 506 deletions(-)
@@ -1273,7 +1273,7 @@ show_code (int level, gfc_code *c)
}
static void
-show_omp_namelist (int list_type, gfc_omp_namelist *n)
+show_omp_namelist (enum omp_list_clauses list_type, gfc_omp_namelist_item *n)
{
for (; n; n = n->next)
{
@@ -1366,7 +1366,7 @@ show_omp_namelist (int list_type, gfc_omp_namelist *n)
static void
show_omp_clauses (gfc_omp_clauses *omp_clauses)
{
- int list_type, i;
+ int i;
switch (omp_clauses->cancel)
{
@@ -1567,48 +1567,16 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses)
fputs (" MERGEABLE", dumpfile);
if (omp_clauses->collapse)
fprintf (dumpfile, " COLLAPSE(%d)", omp_clauses->collapse);
- for (list_type = 0; list_type < OMP_LIST_NUM; list_type++)
- if (omp_clauses->lists[list_type] != NULL
- && list_type != OMP_LIST_COPYPRIVATE)
+ for (gfc_omp_namelist *list = omp_clauses->lists; list; list = list->next)
+ if (list->clause != OMP_LIST_COPYPRIVATE)
{
- const char *type = NULL;
- switch (list_type)
- {
- case OMP_LIST_PRIVATE: type = "PRIVATE"; break;
- case OMP_LIST_FIRSTPRIVATE: type = "FIRSTPRIVATE"; break;
- case OMP_LIST_LASTPRIVATE: type = "LASTPRIVATE"; break;
- case OMP_LIST_COPYPRIVATE: type = "COPYPRIVATE"; break;
- case OMP_LIST_SHARED: type = "SHARED"; break;
- case OMP_LIST_COPYIN: type = "COPYIN"; break;
- case OMP_LIST_UNIFORM: type = "UNIFORM"; break;
- case OMP_LIST_ALIGNED: type = "ALIGNED"; break;
- case OMP_LIST_LINEAR: type = "LINEAR"; break;
- case OMP_LIST_DEPEND: type = "DEPEND"; break;
- case OMP_LIST_MAP: type = "MAP"; break;
- case OMP_LIST_TO: type = "TO"; break;
- case OMP_LIST_FROM: type = "FROM"; break;
- case OMP_LIST_REDUCTION:
- case OMP_LIST_REDUCTION_INSCAN:
- case OMP_LIST_REDUCTION_TASK: type = "REDUCTION"; break;
- case OMP_LIST_IN_REDUCTION: type = "IN_REDUCTION"; break;
- case OMP_LIST_TASK_REDUCTION: type = "TASK_REDUCTION"; break;
- case OMP_LIST_DEVICE_RESIDENT: type = "DEVICE_RESIDENT"; break;
- case OMP_LIST_LINK: type = "LINK"; break;
- case OMP_LIST_USE_DEVICE: type = "USE_DEVICE"; break;
- case OMP_LIST_CACHE: type = "CACHE"; break;
- case OMP_LIST_IS_DEVICE_PTR: type = "IS_DEVICE_PTR"; break;
- case OMP_LIST_USE_DEVICE_PTR: type = "USE_DEVICE_PTR"; break;
- case OMP_LIST_USE_DEVICE_ADDR: type = "USE_DEVICE_ADDR"; break;
- case OMP_LIST_NONTEMPORAL: type = "NONTEMPORAL"; break;
- default:
- gcc_unreachable ();
- }
+ const char *type = gfc_omp_get_clause_name (list->clause);
fprintf (dumpfile, " %s(", type);
- if (list_type == OMP_LIST_REDUCTION_INSCAN)
+ if (list->clause == OMP_LIST_REDUCTION_INSCAN)
fputs ("inscan, ", dumpfile);
- if (list_type == OMP_LIST_REDUCTION_TASK)
+ if (list->clause == OMP_LIST_REDUCTION_TASK)
fputs ("task, ", dumpfile);
- show_omp_namelist (list_type, omp_clauses->lists[list_type]);
+ show_omp_namelist (list->clause, list->item);
fputc (')', dumpfile);
}
if (omp_clauses->safelen_expr)
@@ -1910,7 +1878,7 @@ show_omp_node (int level, gfc_code *c)
if (c->ext.omp_namelist)
{
fputs (" (", dumpfile);
- show_omp_namelist (OMP_LIST_NUM, c->ext.omp_namelist);
+ show_omp_namelist (OMP_LIST_UNSET, c->ext.omp_namelist);
fputc (')', dumpfile);
}
return;
@@ -1958,11 +1926,12 @@ show_omp_node (int level, gfc_code *c)
fprintf (dumpfile, "!$%s END %s", is_oacc ? "ACC" : "OMP", name);
if (omp_clauses != NULL)
{
- if (omp_clauses->lists[OMP_LIST_COPYPRIVATE])
+ gfc_omp_namelist_item *list = gfc_omp_get_nm_list (omp_clauses,
+ OMP_LIST_COPYPRIVATE);
+ if (list)
{
fputs (" COPYPRIVATE(", dumpfile);
- show_omp_namelist (OMP_LIST_COPYPRIVATE,
- omp_clauses->lists[OMP_LIST_COPYPRIVATE]);
+ show_omp_namelist (OMP_LIST_COPYPRIVATE, list);
fputc (')', dumpfile);
}
else if (omp_clauses->nowait)
@@ -5578,10 +5578,8 @@ gfc_code_walker (gfc_code **c, walk_code_fn_t codefn, walk_expr_fn_t exprfn,
if (co->ext.omp_clauses)
{
- gfc_omp_namelist *n;
- static int list_types[]
- = { OMP_LIST_ALIGNED, OMP_LIST_LINEAR, OMP_LIST_DEPEND,
- OMP_LIST_MAP, OMP_LIST_TO, OMP_LIST_FROM };
+ gfc_omp_namelist *list;
+ gfc_omp_namelist_item *n;
size_t idx;
WALK_SUBEXPR (co->ext.omp_clauses->if_expr);
WALK_SUBEXPR (co->ext.omp_clauses->final_expr);
@@ -5599,11 +5597,9 @@ gfc_code_walker (gfc_code **c, walk_code_fn_t codefn, walk_expr_fn_t exprfn,
WALK_SUBEXPR (co->ext.omp_clauses->priority);
for (idx = 0; idx < OMP_IF_LAST; idx++)
WALK_SUBEXPR (co->ext.omp_clauses->if_exprs[idx]);
- for (idx = 0;
- idx < sizeof (list_types) / sizeof (list_types[0]);
- idx++)
- for (n = co->ext.omp_clauses->lists[list_types[idx]];
- n; n = n->next)
+ for (list = co->ext.omp_clauses->lists;
+ list; list = list->next)
+ for (n = list->item; n; n = n->next)
WALK_SUBEXPR (n->expr);
}
break;
@@ -1240,7 +1240,7 @@ enum gfc_omp_linear_op
/* For use in OpenMP clauses in case we need extra information
(aligned clause alignment, linear clause step, etc.). */
-typedef struct gfc_omp_namelist
+typedef struct gfc_omp_namelist_item
{
struct gfc_symbol *sym;
struct gfc_expr *expr;
@@ -1254,17 +1254,16 @@ typedef struct gfc_omp_namelist
bool lastprivate_conditional;
} u;
struct gfc_omp_namelist_udr *udr;
- struct gfc_omp_namelist *next;
+ struct gfc_omp_namelist_item *next;
locus where;
}
-gfc_omp_namelist;
+gfc_omp_namelist_item;
+#define gfc_get_omp_namelist_item() XCNEW (gfc_omp_namelist_item)
-#define gfc_get_omp_namelist() XCNEW (gfc_omp_namelist)
-
-enum
+enum omp_list_clauses
{
- OMP_LIST_FIRST,
- OMP_LIST_PRIVATE = OMP_LIST_FIRST,
+ OMP_LIST_UNSET,
+ OMP_LIST_PRIVATE,
OMP_LIST_FIRSTPRIVATE,
OMP_LIST_LASTPRIVATE,
OMP_LIST_COPYPRIVATE,
@@ -1289,8 +1288,7 @@ enum
OMP_LIST_IS_DEVICE_PTR,
OMP_LIST_USE_DEVICE_PTR,
OMP_LIST_USE_DEVICE_ADDR,
- OMP_LIST_NONTEMPORAL,
- OMP_LIST_NUM
+ OMP_LIST_NONTEMPORAL
};
/* Because a symbol can belong to multiple namelists, they must be
@@ -1386,12 +1384,22 @@ enum gfc_omp_memorder
OMP_MEMORDER_RELAXED
};
+typedef struct gfc_omp_namelist
+{
+ enum omp_list_clauses clause;
+ gfc_omp_namelist_item *item;
+ struct gfc_omp_namelist *next;
+}
+gfc_omp_namelist;
+
+#define gfc_get_omp_namelist() XCNEW (gfc_omp_namelist)
+
typedef struct gfc_omp_clauses
{
struct gfc_expr *if_expr;
struct gfc_expr *final_expr;
struct gfc_expr *num_threads;
- gfc_omp_namelist *lists[OMP_LIST_NUM];
+ gfc_omp_namelist *lists;
enum gfc_omp_sched_kind sched_kind;
enum gfc_omp_device_type device_type;
struct gfc_expr *chunk_size;
@@ -1434,7 +1442,6 @@ typedef struct gfc_omp_clauses
unsigned par_auto:1, gang_static:1;
unsigned if_present:1, finalize:1;
locus loc;
-
}
gfc_omp_clauses;
@@ -2752,7 +2759,7 @@ typedef struct gfc_code
gfc_oacc_declare *oacc_declare;
gfc_omp_clauses *omp_clauses;
const char *omp_name;
- gfc_omp_namelist *omp_namelist;
+ gfc_omp_namelist_item *omp_namelist;
bool omp_bool;
}
ext; /* Points to additional structures required by statement */
@@ -3311,7 +3318,7 @@ void gfc_free_iterator (gfc_iterator *, int);
void gfc_free_forall_iterator (gfc_forall_iterator *);
void gfc_free_alloc_list (gfc_alloc *);
void gfc_free_namelist (gfc_namelist *);
-void gfc_free_omp_namelist (gfc_omp_namelist *);
+void gfc_free_omp_namelist_item (gfc_omp_namelist_item *);
void gfc_free_equiv (gfc_equiv *);
void gfc_free_equiv_until (gfc_equiv *, gfc_equiv *);
void gfc_free_data (gfc_data *);
@@ -3325,6 +3332,7 @@ gfc_expr *gfc_get_parentheses (gfc_expr *);
struct gfc_omp_saved_state { void *ptrs[2]; int ints[1]; };
bool gfc_omp_requires_add_clause (gfc_omp_requires_kind, const char *,
locus *, const char *);
+const char* gfc_omp_get_clause_name (enum omp_list_clauses clause);
void gfc_check_omp_requires (gfc_namespace *, int);
void gfc_free_omp_clauses (gfc_omp_clauses *);
void gfc_free_oacc_declare_clauses (struct gfc_oacc_declare *);
@@ -3332,6 +3340,10 @@ void gfc_free_omp_declare_simd (gfc_omp_declare_simd *);
void gfc_free_omp_declare_simd_list (gfc_omp_declare_simd *);
void gfc_free_omp_udr (gfc_omp_udr *);
gfc_omp_udr *gfc_omp_udr_find (gfc_symtree *, gfc_typespec *);
+gfc_omp_namelist_item** gfc_omp_get_nm_ref (gfc_omp_clauses *,
+ enum omp_list_clauses);
+gfc_omp_namelist_item* gfc_omp_get_nm_list (gfc_omp_clauses *,
+ enum omp_list_clauses);
void gfc_resolve_omp_directive (gfc_code *, gfc_namespace *);
void gfc_resolve_do_iterator (gfc_code *, gfc_symbol *, bool);
void gfc_resolve_omp_local_vars (gfc_namespace *);
@@ -5467,9 +5467,9 @@ gfc_free_namelist (gfc_namelist *name)
/* Free an OpenMP namelist structure. */
void
-gfc_free_omp_namelist (gfc_omp_namelist *name)
+gfc_free_omp_namelist_item (gfc_omp_namelist_item *name)
{
- gfc_omp_namelist *n;
+ gfc_omp_namelist_item *n;
for (; name; name = n)
{
@@ -4357,7 +4357,7 @@ mio_omp_declare_simd (gfc_namespace *ns, gfc_omp_declare_simd **odsp)
write_atom (ATOM_NAME, "OMP_DECLARE_SIMD");
if (ods->clauses)
{
- gfc_omp_namelist *n;
+ gfc_omp_namelist_item *n;
if (ods->clauses->inbranch)
mio_name (0, omp_declare_simd_clauses);
@@ -4368,12 +4368,14 @@ mio_omp_declare_simd (gfc_namespace *ns, gfc_omp_declare_simd **odsp)
mio_name (2, omp_declare_simd_clauses);
mio_expr (&ods->clauses->simdlen_expr);
}
- for (n = ods->clauses->lists[OMP_LIST_UNIFORM]; n; n = n->next)
+ n = gfc_omp_get_nm_list (ods->clauses, OMP_LIST_UNIFORM);
+ for (; n; n = n->next)
{
mio_name (3, omp_declare_simd_clauses);
mio_symbol_ref (&n->sym);
}
- for (n = ods->clauses->lists[OMP_LIST_LINEAR]; n; n = n->next)
+ n = gfc_omp_get_nm_list (ods->clauses, OMP_LIST_LINEAR);
+ for (; n; n = n->next)
{
if (n->u.linear_op == OMP_LINEAR_DEFAULT)
mio_name (4, omp_declare_simd_clauses);
@@ -4382,7 +4384,8 @@ mio_omp_declare_simd (gfc_namespace *ns, gfc_omp_declare_simd **odsp)
mio_symbol_ref (&n->sym);
mio_expr (&n->expr);
}
- for (n = ods->clauses->lists[OMP_LIST_ALIGNED]; n; n = n->next)
+ n = gfc_omp_get_nm_list (ods->clauses, OMP_LIST_ALIGNED);
+ for (; n; n = n->next)
{
mio_name (5, omp_declare_simd_clauses);
mio_symbol_ref (&n->sym);
@@ -4392,7 +4395,7 @@ mio_omp_declare_simd (gfc_namespace *ns, gfc_omp_declare_simd **odsp)
}
else
{
- gfc_omp_namelist **ptrs[3] = { NULL, NULL, NULL };
+ gfc_omp_namelist_item **ptrs[3] = { NULL, NULL, NULL };
require_atom (ATOM_NAME);
*odsp = ods = gfc_get_omp_declare_simd ();
@@ -4401,13 +4404,19 @@ mio_omp_declare_simd (gfc_namespace *ns, gfc_omp_declare_simd **odsp)
if (peek_atom () == ATOM_NAME)
{
ods->clauses = gfc_get_omp_clauses ();
- ptrs[0] = &ods->clauses->lists[OMP_LIST_UNIFORM];
- ptrs[1] = &ods->clauses->lists[OMP_LIST_LINEAR];
- ptrs[2] = &ods->clauses->lists[OMP_LIST_ALIGNED];
+ ods->clauses->lists = gfc_get_omp_namelist ();
+ ods->clauses->lists->next = gfc_get_omp_namelist ();
+ ods->clauses->lists->next->next = gfc_get_omp_namelist ();
+ ods->clauses->lists->clause = OMP_LIST_UNIFORM;
+ ods->clauses->lists->next->clause = OMP_LIST_UNIFORM;
+ ods->clauses->lists->next->next->clause = OMP_LIST_UNIFORM;
+ ptrs[0] = &ods->clauses->lists->item;
+ ptrs[1] = &ods->clauses->lists->next->item;
+ ptrs[2] = &ods->clauses->lists->next->next->item;
}
while (peek_atom () == ATOM_NAME)
{
- gfc_omp_namelist *n;
+ gfc_omp_namelist_item *n;
int t = mio_name (0, omp_declare_simd_clauses);
switch (t)
@@ -4418,7 +4427,7 @@ mio_omp_declare_simd (gfc_namespace *ns, gfc_omp_declare_simd **odsp)
case 3:
case 4:
case 5:
- *ptrs[t - 3] = n = gfc_get_omp_namelist ();
+ *ptrs[t - 3] = n = gfc_get_omp_namelist_item ();
finish_namelist:
n->where = gfc_current_locus;
ptrs[t - 3] = &n->next;
@@ -4429,7 +4438,7 @@ mio_omp_declare_simd (gfc_namespace *ns, gfc_omp_declare_simd **odsp)
case 33:
case 34:
case 35:
- *ptrs[1] = n = gfc_get_omp_namelist ();
+ *ptrs[1] = n = gfc_get_omp_namelist_item ();
n->u.linear_op = (enum gfc_omp_linear_op) (t - 32);
t = 4;
goto finish_namelist;
@@ -101,8 +101,13 @@ gfc_free_omp_clauses (gfc_omp_clauses *c)
gfc_free_expr (c->num_gangs_expr);
gfc_free_expr (c->num_workers_expr);
gfc_free_expr (c->vector_length_expr);
- for (i = 0; i < OMP_LIST_NUM; i++)
- gfc_free_omp_namelist (c->lists[i]);
+ for (gfc_omp_namelist *list = c->lists; list; )
+ {
+ gfc_omp_namelist *next = list->next;
+ gfc_free_omp_namelist_item (list->item);
+ free (list);
+ list = next;
+ }
gfc_free_expr_list (c->wait_list);
gfc_free_expr_list (c->tile_list);
free (CONST_CAST (char *, c->critical_name));
@@ -230,13 +235,13 @@ gfc_find_omp_udr (gfc_namespace *ns, const char *name, gfc_typespec *ts)
/* Match a variable/common block list and construct a namelist from it. */
static match
-gfc_match_omp_variable_list (const char *str, gfc_omp_namelist **list,
+gfc_match_omp_variable_list (const char *str, gfc_omp_namelist_item **list,
bool allow_common, bool *end_colon = NULL,
- gfc_omp_namelist ***headp = NULL,
+ gfc_omp_namelist_item ***headp = NULL,
bool allow_sections = false,
bool allow_derived = false)
{
- gfc_omp_namelist *head, *tail, *p;
+ gfc_omp_namelist_item *head, *tail, *p;
locus old_loc, cur_loc;
char n[GFC_MAX_SYMBOL_LEN+1];
gfc_symbol *sym;
@@ -281,7 +286,7 @@ gfc_match_omp_variable_list (const char *str, gfc_omp_namelist **list,
}
}
gfc_set_sym_referenced (sym);
- p = gfc_get_omp_namelist ();
+ p = gfc_get_omp_namelist_item ();
if (head == NULL)
head = tail = p;
else
@@ -317,7 +322,7 @@ gfc_match_omp_variable_list (const char *str, gfc_omp_namelist **list,
for (sym = st->n.common->head; sym; sym = sym->common_next)
{
gfc_set_sym_referenced (sym);
- p = gfc_get_omp_namelist ();
+ p = gfc_get_omp_namelist_item ();
if (head == NULL)
head = tail = p;
else
@@ -353,7 +358,7 @@ syntax:
gfc_error ("Syntax error in OpenMP variable list at %C");
cleanup:
- gfc_free_omp_namelist (head);
+ gfc_free_omp_namelist_item (head);
gfc_current_locus = old_loc;
return MATCH_ERROR;
}
@@ -362,9 +367,9 @@ cleanup:
from it. */
static match
-gfc_match_omp_to_link (const char *str, gfc_omp_namelist **list)
+gfc_match_omp_to_link (const char *str, gfc_omp_namelist_item **list)
{
- gfc_omp_namelist *head, *tail, *p;
+ gfc_omp_namelist_item *head, *tail, *p;
locus old_loc, cur_loc;
char n[GFC_MAX_SYMBOL_LEN+1];
gfc_symbol *sym;
@@ -386,7 +391,7 @@ gfc_match_omp_to_link (const char *str, gfc_omp_namelist **list)
switch (m)
{
case MATCH_YES:
- p = gfc_get_omp_namelist ();
+ p = gfc_get_omp_namelist_item ();
if (head == NULL)
head = tail = p;
else
@@ -415,7 +420,7 @@ gfc_match_omp_to_link (const char *str, gfc_omp_namelist **list)
gfc_error ("COMMON block /%s/ not found at %C", n);
goto cleanup;
}
- p = gfc_get_omp_namelist ();
+ p = gfc_get_omp_namelist_item ();
if (head == NULL)
head = tail = p;
else
@@ -443,7 +448,7 @@ syntax:
gfc_error ("Syntax error in OpenMP variable list at %C");
cleanup:
- gfc_free_omp_namelist (head);
+ gfc_free_omp_namelist_item (head);
gfc_current_locus = old_loc;
return MATCH_ERROR;
}
@@ -451,9 +456,9 @@ cleanup:
/* Match depend(sink : ...) construct a namelist from it. */
static match
-gfc_match_omp_depend_sink (gfc_omp_namelist **list)
+gfc_match_omp_depend_sink (gfc_omp_namelist_item **list)
{
- gfc_omp_namelist *head, *tail, *p;
+ gfc_omp_namelist_item *head, *tail, *p;
locus old_loc, cur_loc;
gfc_symbol *sym;
@@ -468,7 +473,7 @@ gfc_match_omp_depend_sink (gfc_omp_namelist **list)
{
case MATCH_YES:
gfc_set_sym_referenced (sym);
- p = gfc_get_omp_namelist ();
+ p = gfc_get_omp_namelist_item ();
if (head == NULL)
{
head = tail = p;
@@ -517,7 +522,7 @@ syntax:
gfc_error ("Syntax error in OpenMP DEPEND SINK list at %C");
cleanup:
- gfc_free_omp_namelist (head);
+ gfc_free_omp_namelist_item (head);
gfc_current_locus = old_loc;
return MATCH_ERROR;
}
@@ -649,10 +654,10 @@ match_oacc_clause_gwv (gfc_omp_clauses *cp, unsigned gwv)
}
static match
-gfc_match_oacc_clause_link (const char *str, gfc_omp_namelist **list)
+gfc_match_oacc_clause_link (const char *str, gfc_omp_namelist_item **list)
{
- gfc_omp_namelist *head = NULL;
- gfc_omp_namelist *tail, *p;
+ gfc_omp_namelist_item *head = NULL;
+ gfc_omp_namelist_item *tail, *p;
locus old_loc;
char n[GFC_MAX_SYMBOL_LEN+1];
gfc_symbol *sym;
@@ -679,7 +684,7 @@ gfc_match_oacc_clause_link (const char *str, gfc_omp_namelist **list)
goto cleanup;
}
gfc_set_sym_referenced (sym);
- p = gfc_get_omp_namelist ();
+ p = gfc_get_omp_namelist_item ();
if (head == NULL)
head = tail = p;
else
@@ -714,7 +719,7 @@ gfc_match_oacc_clause_link (const char *str, gfc_omp_namelist **list)
for (sym = st->n.common->head; sym; sym = sym->common_next)
{
gfc_set_sym_referenced (sym);
- p = gfc_get_omp_namelist ();
+ p = gfc_get_omp_namelist_item ();
if (head == NULL)
head = tail = p;
else
@@ -944,15 +949,15 @@ omp_inv_mask::omp_inv_mask (const omp_mask &m) : omp_mask (m)
mapping. */
static bool
-gfc_match_omp_map_clause (gfc_omp_namelist **list, gfc_omp_map_op map_op,
+gfc_match_omp_map_clause (gfc_omp_namelist_item **list, gfc_omp_map_op map_op,
bool allow_common, bool allow_derived)
{
- gfc_omp_namelist **head = NULL;
+ gfc_omp_namelist_item **head = NULL;
if (gfc_match_omp_variable_list ("", list, allow_common, NULL, &head, true,
allow_derived)
== MATCH_YES)
{
- gfc_omp_namelist *n;
+ gfc_omp_namelist_item *n;
for (n = *head; n; n = n->next)
n->u.map_op = map_op;
return true;
@@ -961,6 +966,79 @@ gfc_match_omp_map_clause (gfc_omp_namelist **list, gfc_omp_map_op map_op,
return false;
}
+
+const char*
+gfc_omp_get_clause_name (enum omp_list_clauses clause)
+{
+ switch (clause)
+ {
+ case OMP_LIST_PRIVATE: return "PRIVATE";
+ case OMP_LIST_FIRSTPRIVATE: return "FIRSTPRIVATE";
+ case OMP_LIST_LASTPRIVATE: return "LASTPRIVATE";
+ case OMP_LIST_COPYPRIVATE: return "COPYPRIVATE";
+ case OMP_LIST_SHARED: return "SHARED";
+ case OMP_LIST_COPYIN: return "COPYIN";
+ case OMP_LIST_UNIFORM: return "UNIFORM";
+ case OMP_LIST_ALIGNED: return "ALIGNED";
+ case OMP_LIST_LINEAR: return "LINEAR";
+ case OMP_LIST_DEPEND: return "DEPEND";
+ case OMP_LIST_MAP: return "MAP";
+ case OMP_LIST_TO: return "TO";
+ case OMP_LIST_FROM: return "FROM";
+ case OMP_LIST_REDUCTION:
+ case OMP_LIST_REDUCTION_INSCAN:
+ case OMP_LIST_REDUCTION_TASK: return "REDUCTION";
+ case OMP_LIST_IN_REDUCTION: return "IN_REDUCTION";
+ case OMP_LIST_TASK_REDUCTION: return "TASK_REDUCTION";
+ case OMP_LIST_DEVICE_RESIDENT: return "DEVICE_RESIDENT";
+ case OMP_LIST_LINK: return "LINK";
+ case OMP_LIST_USE_DEVICE: return "USE_DEVICE";
+ case OMP_LIST_CACHE: return "CACHE";
+ case OMP_LIST_IS_DEVICE_PTR: return "IS_DEVICE_PTR";
+ case OMP_LIST_USE_DEVICE_PTR: return "USE_DEVICE_PTR";
+ case OMP_LIST_USE_DEVICE_ADDR: return "USE_DEVICE_ADDR";
+ case OMP_LIST_NONTEMPORAL: return "NONTEMPORAL";
+ case OMP_LIST_UNSET: break;
+ }
+ gcc_unreachable ();
+ return "";
+}
+
+
+gfc_omp_namelist_item **
+gfc_omp_get_nm_ref (gfc_omp_clauses *clauses, enum omp_list_clauses clause)
+{
+ gfc_omp_namelist *found, *last = NULL;
+ for (found = clauses->lists; found; found = found->next)
+ {
+ if (found->clause == clause)
+ break;
+ last = found;
+ }
+ if (!found)
+ {
+ found = gfc_get_omp_namelist ();
+ found->clause = clause;
+ if (last)
+ last->next = found;
+ else
+ clauses->lists = found;
+ }
+ return &found->item;
+}
+
+
+gfc_omp_namelist_item *
+gfc_omp_get_nm_list (gfc_omp_clauses *clauses, enum omp_list_clauses clause)
+{
+ gfc_omp_namelist *found;
+ for (found = clauses->lists; found; found = found->next)
+ if (found->clause == clause)
+ break;
+ return found ? found->item : NULL;
+}
+
+
/* reduction ( reduction-modifier, reduction-operator : variable-list )
in_reduction ( reduction-operator : variable-list )
task_reduction ( reduction-operator : variable-list ) */
@@ -977,31 +1055,31 @@ gfc_match_omp_clause_reduction (char pc, gfc_omp_clauses *c, bool openacc,
return MATCH_NO;
locus old_loc = gfc_current_locus;
- int list_idx = 0;
+ enum omp_list_clauses subclause = OMP_LIST_UNSET;
if (pc == 'r' && !openacc)
{
if (gfc_match ("inscan") == MATCH_YES)
- list_idx = OMP_LIST_REDUCTION_INSCAN;
+ subclause = OMP_LIST_REDUCTION_INSCAN;
else if (gfc_match ("task") == MATCH_YES)
- list_idx = OMP_LIST_REDUCTION_TASK;
+ subclause = OMP_LIST_REDUCTION_TASK;
else if (gfc_match ("default") == MATCH_YES)
- list_idx = OMP_LIST_REDUCTION;
- if (list_idx != 0 && gfc_match (", ") != MATCH_YES)
+ subclause = OMP_LIST_REDUCTION;
+ if (subclause != OMP_LIST_UNSET && gfc_match (", ") != MATCH_YES)
{
gfc_error ("Comma expected at %C");
gfc_current_locus = old_loc;
return MATCH_NO;
}
- if (list_idx == 0)
- list_idx = OMP_LIST_REDUCTION;
+ if (subclause == OMP_LIST_UNSET)
+ subclause = OMP_LIST_REDUCTION;
}
else if (pc == 'i')
- list_idx = OMP_LIST_IN_REDUCTION;
+ subclause = OMP_LIST_IN_REDUCTION;
else if (pc == 't')
- list_idx = OMP_LIST_TASK_REDUCTION;
+ subclause = OMP_LIST_TASK_REDUCTION;
else
- list_idx = OMP_LIST_REDUCTION;
+ subclause = OMP_LIST_REDUCTION;
gfc_omp_reduction_op rop = OMP_REDUCTION_NONE;
char buffer[GFC_MAX_SYMBOL_LEN + 3];
@@ -1086,24 +1164,25 @@ gfc_match_omp_clause_reduction (char pc, gfc_omp_clauses *c, bool openacc,
buffer[0] = '\0';
gfc_omp_udr *udr = (buffer[0] ? gfc_find_omp_udr (gfc_current_ns, buffer, NULL)
: NULL);
- gfc_omp_namelist **head = NULL;
+ gfc_omp_namelist_item **head = NULL;
if (rop == OMP_REDUCTION_NONE && udr)
rop = OMP_REDUCTION_USER;
- if (gfc_match_omp_variable_list (" :", &c->lists[list_idx], false, NULL,
- &head, openacc, allow_derived) != MATCH_YES)
+ gfc_omp_namelist_item **list = gfc_omp_get_nm_ref (c, subclause);
+ if (gfc_match_omp_variable_list (" :", list, false, NULL, &head, openacc,
+ allow_derived) != MATCH_YES)
{
gfc_current_locus = old_loc;
return MATCH_NO;
}
- gfc_omp_namelist *n;
+ gfc_omp_namelist_item *n;
if (rop == OMP_REDUCTION_NONE)
{
n = *head;
*head = NULL;
gfc_error_now ("!$OMP DECLARE REDUCTION %s not found at %L",
buffer, &old_loc);
- gfc_free_omp_namelist (n);
+ gfc_free_omp_namelist_item (n);
}
else
for (n = *head; n; n = n->next)
@@ -1148,7 +1227,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
first = false;
gfc_gobble_whitespace ();
bool end_colon;
- gfc_omp_namelist **head;
+ gfc_omp_namelist_item **head;
old_loc = gfc_current_locus;
char pc = gfc_peek_ascii_char ();
switch (pc)
@@ -1157,17 +1236,16 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
end_colon = false;
head = NULL;
if ((mask & OMP_CLAUSE_ALIGNED)
- && gfc_match_omp_variable_list ("aligned (",
- &c->lists[OMP_LIST_ALIGNED],
- false, &end_colon,
- &head) == MATCH_YES)
+ && gfc_match_omp_variable_list (
+ "aligned (", gfc_omp_get_nm_ref (c, OMP_LIST_ALIGNED),
+ false, &end_colon, &head) == MATCH_YES)
{
gfc_expr *alignment = NULL;
- gfc_omp_namelist *n;
+ gfc_omp_namelist_item *n;
if (end_colon && gfc_match (" %e )", &alignment) != MATCH_YES)
{
- gfc_free_omp_namelist (*head);
+ gfc_free_omp_namelist_item (*head);
gfc_current_locus = old_loc;
*head = NULL;
break;
@@ -1227,9 +1305,9 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
}
if ((mask & OMP_CLAUSE_ATTACH)
&& gfc_match ("attach ( ") == MATCH_YES
- && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
- OMP_MAP_ATTACH, false,
- allow_derived))
+ && gfc_match_omp_map_clause (
+ gfc_omp_get_nm_ref (c, OMP_LIST_MAP),
+ OMP_MAP_ATTACH, false, allow_derived))
continue;
break;
case 'c':
@@ -1265,39 +1343,43 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
}
if ((mask & OMP_CLAUSE_COPY)
&& gfc_match ("copy ( ") == MATCH_YES
- && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
- OMP_MAP_TOFROM, true,
- allow_derived))
+ && gfc_match_omp_map_clause (
+ gfc_omp_get_nm_ref (c, OMP_LIST_MAP),
+ OMP_MAP_TOFROM, true, allow_derived))
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_TO, true,
- allow_derived))
+ && gfc_match_omp_map_clause (
+ gfc_omp_get_nm_ref (c, OMP_LIST_MAP),
+ OMP_MAP_TO, true, allow_derived))
continue;
}
- else if (gfc_match_omp_variable_list ("copyin (",
- &c->lists[OMP_LIST_COPYIN],
- true) == MATCH_YES)
+ else if (gfc_match_omp_variable_list (
+ "copyin (",
+ gfc_omp_get_nm_ref (c, OMP_LIST_COPYIN), true)
+ == MATCH_YES)
continue;
}
if ((mask & OMP_CLAUSE_COPYOUT)
&& gfc_match ("copyout ( ") == MATCH_YES
- && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
- OMP_MAP_FROM, true, allow_derived))
+ && gfc_match_omp_map_clause (
+ gfc_omp_get_nm_ref (c, OMP_LIST_MAP),
+ OMP_MAP_FROM, true, allow_derived))
continue;
if ((mask & OMP_CLAUSE_COPYPRIVATE)
- && gfc_match_omp_variable_list ("copyprivate (",
- &c->lists[OMP_LIST_COPYPRIVATE],
- true) == MATCH_YES)
+ && gfc_match_omp_variable_list (
+ "copyprivate (",
+ gfc_omp_get_nm_ref (c, OMP_LIST_COPYPRIVATE), true)
+ == MATCH_YES)
continue;
if ((mask & OMP_CLAUSE_CREATE)
&& gfc_match ("create ( ") == MATCH_YES
- && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
- OMP_MAP_ALLOC, true, allow_derived))
+ && gfc_match_omp_map_clause (
+ gfc_omp_get_nm_ref (c, OMP_LIST_MAP),
+ OMP_MAP_ALLOC, true, allow_derived))
continue;
break;
case 'd':
@@ -1332,9 +1414,9 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
}
if ((mask & OMP_CLAUSE_DELETE)
&& gfc_match ("delete ( ") == MATCH_YES
- && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
- OMP_MAP_RELEASE, true,
- allow_derived))
+ && gfc_match_omp_map_clause (
+ gfc_omp_get_nm_ref (c, OMP_LIST_MAP),
+ OMP_MAP_RELEASE, true, allow_derived))
continue;
if ((mask & OMP_CLAUSE_DEPEND)
&& gfc_match ("depend ( ") == MATCH_YES)
@@ -1355,8 +1437,8 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
}
else if (gfc_match ("sink : ") == MATCH_YES)
{
- if (gfc_match_omp_depend_sink (&c->lists[OMP_LIST_DEPEND])
- == MATCH_YES)
+ if (gfc_match_omp_depend_sink (
+ gfc_omp_get_nm_ref (c, OMP_LIST_DEPEND)) == MATCH_YES)
continue;
m = MATCH_NO;
}
@@ -1364,12 +1446,11 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
m = MATCH_NO;
head = NULL;
if (m == MATCH_YES
- && gfc_match_omp_variable_list (" : ",
- &c->lists[OMP_LIST_DEPEND],
- false, NULL, &head,
- true) == MATCH_YES)
+ && gfc_match_omp_variable_list (
+ " : ", gfc_omp_get_nm_ref (c, OMP_LIST_DEPEND),
+ false, NULL, &head, true) == MATCH_YES)
{
- gfc_omp_namelist *n;
+ gfc_omp_namelist_item *n;
for (n = *head; n; n = n->next)
n->u.depend_op = depend_op;
continue;
@@ -1379,9 +1460,9 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
}
if ((mask & OMP_CLAUSE_DETACH)
&& gfc_match ("detach ( ") == MATCH_YES
- && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
- OMP_MAP_DETACH, false,
- allow_derived))
+ && gfc_match_omp_map_clause (
+ gfc_omp_get_nm_ref (c, OMP_LIST_MAP),
+ OMP_MAP_DETACH, false, allow_derived))
continue;
if ((mask & OMP_CLAUSE_DEVICE)
&& !openacc
@@ -1391,15 +1472,15 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
if ((mask & OMP_CLAUSE_DEVICE)
&& openacc
&& gfc_match ("device ( ") == MATCH_YES
- && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
- OMP_MAP_FORCE_TO, true,
- allow_derived))
+ && gfc_match_omp_map_clause (
+ gfc_omp_get_nm_ref (c, OMP_LIST_MAP),
+ OMP_MAP_FORCE_TO, true, allow_derived))
continue;
if ((mask & OMP_CLAUSE_DEVICEPTR)
&& gfc_match ("deviceptr ( ") == MATCH_YES
- && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
- OMP_MAP_FORCE_DEVICEPTR, false,
- allow_derived))
+ && gfc_match_omp_map_clause (
+ gfc_omp_get_nm_ref (c, OMP_LIST_MAP),
+ OMP_MAP_FORCE_DEVICEPTR, false, allow_derived))
continue;
if ((mask & OMP_CLAUSE_DEVICE_TYPE)
&& gfc_match ("device_type ( ") == MATCH_YES)
@@ -1422,7 +1503,8 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
if ((mask & OMP_CLAUSE_DEVICE_RESIDENT)
&& gfc_match_omp_variable_list
("device_resident (",
- &c->lists[OMP_LIST_DEVICE_RESIDENT], true) == MATCH_YES)
+ gfc_omp_get_nm_ref (c, OMP_LIST_DEVICE_RESIDENT), true)
+ == MATCH_YES)
continue;
if ((mask & OMP_CLAUSE_DIST_SCHEDULE)
&& c->dist_sched_kind == OMP_SCHED_NONE
@@ -1456,14 +1538,15 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
continue;
}
if ((mask & OMP_CLAUSE_FIRSTPRIVATE)
- && gfc_match_omp_variable_list ("firstprivate (",
- &c->lists[OMP_LIST_FIRSTPRIVATE],
- true) == MATCH_YES)
+ && gfc_match_omp_variable_list (
+ "firstprivate (",
+ gfc_omp_get_nm_ref (c, OMP_LIST_FIRSTPRIVATE), true)
+ == MATCH_YES)
continue;
if ((mask & OMP_CLAUSE_FROM)
- && gfc_match_omp_variable_list ("from (",
- &c->lists[OMP_LIST_FROM], false,
- NULL, &head, true) == MATCH_YES)
+ && gfc_match_omp_variable_list (
+ "from (", gfc_omp_get_nm_ref (c, OMP_LIST_FROM),
+ false, NULL, &head, true) == MATCH_YES)
continue;
break;
case 'g':
@@ -1494,9 +1577,9 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
continue;
if ((mask & OMP_CLAUSE_HOST_SELF)
&& gfc_match ("host ( ") == MATCH_YES
- && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
- OMP_MAP_FORCE_FROM, true,
- allow_derived))
+ && gfc_match_omp_map_clause (
+ gfc_omp_get_nm_ref (c, OMP_LIST_MAP),
+ OMP_MAP_FORCE_FROM, true, allow_derived))
continue;
break;
case 'i':
@@ -1561,7 +1644,8 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
if ((mask & OMP_CLAUSE_IS_DEVICE_PTR)
&& gfc_match_omp_variable_list
("is_device_ptr (",
- &c->lists[OMP_LIST_IS_DEVICE_PTR], false) == MATCH_YES)
+ gfc_omp_get_nm_ref (c, OMP_LIST_IS_DEVICE_PTR), false)
+ == MATCH_YES)
continue;
break;
case 'l':
@@ -1570,11 +1654,11 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
{
bool conditional = gfc_match ("conditional : ") == MATCH_YES;
head = NULL;
- if (gfc_match_omp_variable_list ("",
- &c->lists[OMP_LIST_LASTPRIVATE],
- false, NULL, &head) == MATCH_YES)
+ if (gfc_match_omp_variable_list (
+ "", gfc_omp_get_nm_ref (c, OMP_LIST_LASTPRIVATE),
+ false, NULL, &head) == MATCH_YES)
{
- gfc_omp_namelist *n;
+ gfc_omp_namelist_item *n;
for (n = *head; n; n = n->next)
n->u.lastprivate_conditional = conditional;
continue;
@@ -1590,25 +1674,21 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
gfc_omp_linear_op linear_op = OMP_LINEAR_DEFAULT;
gfc_expr *step = NULL;
- if (gfc_match_omp_variable_list (" ref (",
- &c->lists[OMP_LIST_LINEAR],
- false, NULL, &head)
- == MATCH_YES)
+ if (gfc_match_omp_variable_list (
+ " ref (", gfc_omp_get_nm_ref (c, OMP_LIST_LINEAR),
+ false, NULL, &head) == MATCH_YES)
linear_op = OMP_LINEAR_REF;
- else if (gfc_match_omp_variable_list (" val (",
- &c->lists[OMP_LIST_LINEAR],
- false, NULL, &head)
- == MATCH_YES)
+ else if (gfc_match_omp_variable_list (
+ " val (", gfc_omp_get_nm_ref (c, OMP_LIST_LINEAR),
+ false, NULL, &head) == MATCH_YES)
linear_op = OMP_LINEAR_VAL;
- else if (gfc_match_omp_variable_list (" uval (",
- &c->lists[OMP_LIST_LINEAR],
- false, NULL, &head)
- == MATCH_YES)
+ else if (gfc_match_omp_variable_list (
+ " uval (", gfc_omp_get_nm_ref (c, OMP_LIST_LINEAR),
+ false, NULL, &head) == MATCH_YES)
linear_op = OMP_LINEAR_UVAL;
- else if (gfc_match_omp_variable_list ("",
- &c->lists[OMP_LIST_LINEAR],
- false, &end_colon, &head)
- == MATCH_YES)
+ else if (gfc_match_omp_variable_list (
+ "", gfc_omp_get_nm_ref (c, OMP_LIST_LINEAR),
+ false, &end_colon, &head) == MATCH_YES)
linear_op = OMP_LINEAR_DEFAULT;
else
{
@@ -1621,7 +1701,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
end_colon = true;
else if (gfc_match (" )") != MATCH_YES)
{
- gfc_free_omp_namelist (*head);
+ gfc_free_omp_namelist_item (*head);
gfc_current_locus = old_loc;
*head = NULL;
break;
@@ -1629,7 +1709,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
}
if (end_colon && gfc_match (" %e )", &step) != MATCH_YES)
{
- gfc_free_omp_namelist (*head);
+ gfc_free_omp_namelist_item (*head);
gfc_current_locus = old_loc;
*head = NULL;
break;
@@ -1643,20 +1723,20 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
}
(*head)->expr = step;
if (linear_op != OMP_LINEAR_DEFAULT)
- for (gfc_omp_namelist *n = *head; n; n = n->next)
+ for (gfc_omp_namelist_item *n = *head; n; n = n->next)
n->u.linear_op = linear_op;
continue;
}
if ((mask & OMP_CLAUSE_LINK)
&& openacc
- && (gfc_match_oacc_clause_link ("link (",
- &c->lists[OMP_LIST_LINK])
+ && (gfc_match_oacc_clause_link (
+ "link (", gfc_omp_get_nm_ref (c, OMP_LIST_LINK))
== MATCH_YES))
continue;
else if ((mask & OMP_CLAUSE_LINK)
&& !openacc
- && (gfc_match_omp_to_link ("link (",
- &c->lists[OMP_LIST_LINK])
+ && (gfc_match_omp_to_link (
+ "link (", gfc_omp_get_nm_ref (c, OMP_LIST_LINK))
== MATCH_YES))
continue;
break;
@@ -1687,11 +1767,11 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
always = false;
}
head = NULL;
- if (gfc_match_omp_variable_list ("", &c->lists[OMP_LIST_MAP],
- false, NULL, &head,
- true, true) == MATCH_YES)
+ if (gfc_match_omp_variable_list (
+ "", gfc_omp_get_nm_ref (c, OMP_LIST_MAP),
+ false, NULL, &head, true, true) == MATCH_YES)
{
- gfc_omp_namelist *n;
+ gfc_omp_namelist_item *n;
for (n = *head; n; n = n->next)
n->u.map_op = map_op;
continue;
@@ -1709,9 +1789,9 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
case 'n':
if ((mask & OMP_CLAUSE_NO_CREATE)
&& gfc_match ("no_create ( ") == MATCH_YES
- && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
- OMP_MAP_IF_PRESENT, true,
- allow_derived))
+ && gfc_match_omp_map_clause (
+ gfc_omp_get_nm_ref (c, OMP_LIST_MAP),
+ OMP_MAP_IF_PRESENT, true, allow_derived))
continue;
if ((mask & OMP_CLAUSE_NOGROUP)
&& !c->nogroup
@@ -1721,9 +1801,10 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
continue;
}
if ((mask & OMP_CLAUSE_NOTEMPORAL)
- && gfc_match_omp_variable_list ("nontemporal (",
- &c->lists[OMP_LIST_NONTEMPORAL],
- true) == MATCH_YES)
+ && gfc_match_omp_variable_list (
+ "nontemporal (",
+ gfc_omp_get_nm_ref (c, OMP_LIST_NONTEMPORAL), true)
+ == MATCH_YES)
continue;
if ((mask & OMP_CLAUSE_NOTINBRANCH)
&& !c->notinbranch
@@ -1803,59 +1884,66 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
case 'p':
if ((mask & OMP_CLAUSE_COPY)
&& gfc_match ("pcopy ( ") == MATCH_YES
- && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
- OMP_MAP_TOFROM, true, allow_derived))
+ && gfc_match_omp_map_clause (
+ gfc_omp_get_nm_ref (c, OMP_LIST_MAP),
+ OMP_MAP_TOFROM, true, allow_derived))
continue;
if ((mask & OMP_CLAUSE_COPYIN)
&& gfc_match ("pcopyin ( ") == MATCH_YES
- && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
- OMP_MAP_TO, true, allow_derived))
+ && gfc_match_omp_map_clause (
+ gfc_omp_get_nm_ref (c, OMP_LIST_MAP),
+ OMP_MAP_TO, true, allow_derived))
continue;
if ((mask & OMP_CLAUSE_COPYOUT)
&& gfc_match ("pcopyout ( ") == MATCH_YES
- && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
- OMP_MAP_FROM, true, allow_derived))
+ && gfc_match_omp_map_clause (
+ gfc_omp_get_nm_ref (c, OMP_LIST_MAP),
+ OMP_MAP_FROM, true, allow_derived))
continue;
if ((mask & OMP_CLAUSE_CREATE)
&& gfc_match ("pcreate ( ") == MATCH_YES
- && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
- OMP_MAP_ALLOC, true, allow_derived))
+ && gfc_match_omp_map_clause (
+ gfc_omp_get_nm_ref (c, OMP_LIST_MAP),
+ OMP_MAP_ALLOC, true, allow_derived))
continue;
if ((mask & OMP_CLAUSE_PRESENT)
&& gfc_match ("present ( ") == MATCH_YES
- && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
- OMP_MAP_FORCE_PRESENT, false,
- allow_derived))
+ && gfc_match_omp_map_clause (
+ gfc_omp_get_nm_ref (c, OMP_LIST_MAP),
+ OMP_MAP_FORCE_PRESENT, false, allow_derived))
continue;
if ((mask & OMP_CLAUSE_COPY)
&& gfc_match ("present_or_copy ( ") == MATCH_YES
- && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
- OMP_MAP_TOFROM, true,
- allow_derived))
+ && gfc_match_omp_map_clause (
+ gfc_omp_get_nm_ref (c, OMP_LIST_MAP),
+ OMP_MAP_TOFROM, true, allow_derived))
continue;
if ((mask & OMP_CLAUSE_COPYIN)
&& gfc_match ("present_or_copyin ( ") == MATCH_YES
- && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
- OMP_MAP_TO, true, allow_derived))
+ && gfc_match_omp_map_clause (
+ gfc_omp_get_nm_ref (c, OMP_LIST_MAP),
+ OMP_MAP_TO, true, allow_derived))
continue;
if ((mask & OMP_CLAUSE_COPYOUT)
&& gfc_match ("present_or_copyout ( ") == MATCH_YES
- && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
- OMP_MAP_FROM, true, allow_derived))
+ && gfc_match_omp_map_clause (
+ gfc_omp_get_nm_ref (c, OMP_LIST_MAP),
+ OMP_MAP_FROM, true, allow_derived))
continue;
if ((mask & OMP_CLAUSE_CREATE)
&& gfc_match ("present_or_create ( ") == MATCH_YES
- && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
- OMP_MAP_ALLOC, true, allow_derived))
+ && gfc_match_omp_map_clause (
+ gfc_omp_get_nm_ref (c, OMP_LIST_MAP),
+ OMP_MAP_ALLOC, true, allow_derived))
continue;
if ((mask & OMP_CLAUSE_PRIORITY)
&& c->priority == NULL
&& gfc_match ("priority ( %e )", &c->priority) == MATCH_YES)
continue;
if ((mask & OMP_CLAUSE_PRIVATE)
- && gfc_match_omp_variable_list ("private (",
- &c->lists[OMP_LIST_PRIVATE],
- true) == MATCH_YES)
+ && gfc_match_omp_variable_list (
+ "private (", gfc_omp_get_nm_ref (c, OMP_LIST_PRIVATE),
+ true) == MATCH_YES)
continue;
if ((mask & OMP_CLAUSE_PROC_BIND)
&& c->proc_bind == OMP_PROC_BIND_UNKNOWN)
@@ -1987,9 +2075,9 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
}
if ((mask & OMP_CLAUSE_HOST_SELF)
&& gfc_match ("self ( ") == MATCH_YES
- && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
- OMP_MAP_FORCE_FROM, true,
- allow_derived))
+ && gfc_match_omp_map_clause (
+ gfc_omp_get_nm_ref (c, OMP_LIST_MAP),
+ OMP_MAP_FORCE_FROM, true, allow_derived))
continue;
if ((mask & OMP_CLAUSE_SEQ)
&& !c->seq
@@ -2008,9 +2096,9 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
continue;
}
if ((mask & OMP_CLAUSE_SHARED)
- && gfc_match_omp_variable_list ("shared (",
- &c->lists[OMP_LIST_SHARED],
- true) == MATCH_YES)
+ && gfc_match_omp_variable_list (
+ "shared (", gfc_omp_get_nm_ref (c, OMP_LIST_SHARED), true)
+ == MATCH_YES)
continue;
if ((mask & OMP_CLAUSE_SIMDLEN)
&& c->simdlen_expr == NULL
@@ -2048,21 +2136,22 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
continue;
if ((mask & OMP_CLAUSE_TO) && (mask & OMP_CLAUSE_LINK))
{
- if (gfc_match_omp_to_link ("to (", &c->lists[OMP_LIST_TO])
+ if (gfc_match_omp_to_link (
+ "to (", gfc_omp_get_nm_ref (c, OMP_LIST_TO))
== MATCH_YES)
continue;
}
else if ((mask & OMP_CLAUSE_TO)
- && gfc_match_omp_variable_list ("to (",
- &c->lists[OMP_LIST_TO], false,
- NULL, &head, true) == MATCH_YES)
+ && gfc_match_omp_variable_list (
+ "to (", gfc_omp_get_nm_ref (c, OMP_LIST_TO),
+ false, NULL, &head, true) == MATCH_YES)
continue;
break;
case 'u':
if ((mask & OMP_CLAUSE_UNIFORM)
- && gfc_match_omp_variable_list ("uniform (",
- &c->lists[OMP_LIST_UNIFORM],
- false) == MATCH_YES)
+ && gfc_match_omp_variable_list (
+ "uniform (", gfc_omp_get_nm_ref (c, OMP_LIST_UNIFORM), false)
+ == MATCH_YES)
continue;
if ((mask & OMP_CLAUSE_UNTIED)
&& !c->untied
@@ -2080,19 +2169,22 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
continue;
}
if ((mask & OMP_CLAUSE_USE_DEVICE)
- && gfc_match_omp_variable_list ("use_device (",
- &c->lists[OMP_LIST_USE_DEVICE],
- true) == MATCH_YES)
+ && gfc_match_omp_variable_list (
+ "use_device (",
+ gfc_omp_get_nm_ref (c, OMP_LIST_USE_DEVICE), true)
+ == MATCH_YES)
continue;
if ((mask & OMP_CLAUSE_USE_DEVICE_PTR)
&& gfc_match_omp_variable_list
("use_device_ptr (",
- &c->lists[OMP_LIST_USE_DEVICE_PTR], false) == MATCH_YES)
+ gfc_omp_get_nm_ref (c, OMP_LIST_USE_DEVICE_PTR),
+ false) == MATCH_YES)
continue;
if ((mask & OMP_CLAUSE_USE_DEVICE_ADDR)
&& gfc_match_omp_variable_list
("use_device_addr (",
- &c->lists[OMP_LIST_USE_DEVICE_ADDR], false) == MATCH_YES)
+ gfc_omp_get_nm_ref (c, OMP_LIST_USE_DEVICE_ADDR),
+ false) == MATCH_YES)
continue;
break;
case 'v':
@@ -2324,7 +2416,7 @@ match
gfc_match_oacc_declare (void)
{
gfc_omp_clauses *c;
- gfc_omp_namelist *n;
+ gfc_omp_namelist_item *n;
gfc_namespace *ns = gfc_current_ns;
gfc_oacc_declare *new_oc;
bool module_var = false;
@@ -2334,13 +2426,16 @@ gfc_match_oacc_declare (void)
!= MATCH_YES)
return MATCH_ERROR;
- for (n = c->lists[OMP_LIST_DEVICE_RESIDENT]; n != NULL; n = n->next)
+ n = gfc_omp_get_nm_list (c, OMP_LIST_DEVICE_RESIDENT);
+ for (; n != NULL; n = n->next)
n->sym->attr.oacc_declare_device_resident = 1;
- for (n = c->lists[OMP_LIST_LINK]; n != NULL; n = n->next)
+ n = gfc_omp_get_nm_list (c, OMP_LIST_LINK);
+ for (; n != NULL; n = n->next)
n->sym->attr.oacc_declare_link = 1;
- for (n = c->lists[OMP_LIST_MAP]; n != NULL; n = n->next)
+ n = gfc_omp_get_nm_list (c, OMP_LIST_MAP);
+ for (; n != NULL; n = n->next)
{
gfc_symbol *s = n->sym;
@@ -2423,7 +2518,7 @@ gfc_match_oacc_update (void)
!= MATCH_YES)
return MATCH_ERROR;
- if (!c->lists[OMP_LIST_MAP])
+ if (!gfc_omp_get_nm_list (c, OMP_LIST_MAP))
{
gfc_error ("%<acc update%> must contain at least one "
"%<device%> or %<host%> or %<self%> clause at %L", &here);
@@ -2501,9 +2596,9 @@ gfc_match_oacc_cache (void)
subarrays", which we're currently not checking here. Either check this
after the call of gfc_match_omp_variable_list, or add something like a
only_sections variant next to its allow_sections parameter. */
- match m = gfc_match_omp_variable_list (" (",
- &c->lists[OMP_LIST_CACHE], true,
- NULL, NULL, true);
+ match m = gfc_match_omp_variable_list (
+ " (", gfc_omp_get_nm_ref (c, OMP_LIST_CACHE),
+ true, NULL, NULL, true);
if (m != MATCH_YES)
{
gfc_free_omp_clauses(c);
@@ -2911,7 +3006,7 @@ gfc_match_omp_do_simd (void)
match
gfc_match_omp_flush (void)
{
- gfc_omp_namelist *list = NULL;
+ gfc_omp_namelist_item *list = NULL;
gfc_omp_clauses *c = NULL;
gfc_gobble_whitespace ();
enum gfc_omp_memorder mo = OMP_MEMORDER_UNSET;
@@ -2936,14 +3031,14 @@ gfc_match_omp_flush (void)
{
gfc_error ("List specified together with memory order clause in FLUSH "
"directive at %C");
- gfc_free_omp_namelist (list);
- gfc_free_omp_clauses (c);
+ gfc_free_omp_namelist_item (list);
return MATCH_ERROR;
}
if (gfc_match_omp_eos () != MATCH_YES)
{
gfc_error ("Unexpected junk after $OMP FLUSH statement at %C");
- gfc_free_omp_namelist (list);
+ gfc_free_omp_namelist_item (list);
+ free (list);
gfc_free_omp_clauses (c);
return MATCH_ERROR;
}
@@ -3387,8 +3482,7 @@ gfc_match_omp_declare_target (void)
locus old_loc;
match m;
gfc_omp_clauses *c = NULL;
- int list;
- gfc_omp_namelist *n;
+ gfc_omp_namelist_item *n;
gfc_symbol *s;
old_loc = gfc_current_locus;
@@ -3416,7 +3510,7 @@ gfc_match_omp_declare_target (void)
{
c = gfc_get_omp_clauses ();
gfc_current_locus = old_loc;
- m = gfc_match_omp_to_link (" (", &c->lists[OMP_LIST_TO]);
+ m = gfc_match_omp_to_link (" (", gfc_omp_get_nm_ref (c, OMP_LIST_TO));
if (m != MATCH_YES)
goto syntax;
if (gfc_match_omp_eos () != MATCH_YES)
@@ -3430,17 +3524,19 @@ gfc_match_omp_declare_target (void)
gfc_buffer_error (false);
- for (list = OMP_LIST_TO; list != OMP_LIST_NUM;
- list = (list == OMP_LIST_TO ? OMP_LIST_LINK : OMP_LIST_NUM))
- for (n = c->lists[list]; n; n = n->next)
+ for (gfc_omp_namelist *list = c->lists; list; list = list->next)
+ for (n = (list->clause == OMP_LIST_TO || list->clause == OMP_LIST_LINK)
+ ? list->item : NULL;
+ n; n = n->next)
if (n->sym)
n->sym->mark = 0;
else if (n->u.common->head)
n->u.common->head->mark = 0;
- for (list = OMP_LIST_TO; list != OMP_LIST_NUM;
- list = (list == OMP_LIST_TO ? OMP_LIST_LINK : OMP_LIST_NUM))
- for (n = c->lists[list]; n; n = n->next)
+ for (gfc_omp_namelist *list = c->lists; list; list = list->next)
+ for (n = (list->clause == OMP_LIST_TO || list->clause == OMP_LIST_LINK)
+ ? list->item : NULL;
+ n; n = n->next)
if (n->sym)
{
if (n->sym->attr.in_common)
@@ -3448,13 +3544,13 @@ gfc_match_omp_declare_target (void)
"element of a COMMON block", &n->where);
else if (n->sym->attr.omp_declare_target
&& n->sym->attr.omp_declare_target_link
- && list != OMP_LIST_LINK)
+ && list->clause != OMP_LIST_LINK)
gfc_error_now ("OMP DECLARE TARGET variable at %L previously "
"mentioned in LINK clause and later in TO clause",
&n->where);
else if (n->sym->attr.omp_declare_target
&& !n->sym->attr.omp_declare_target_link
- && list == OMP_LIST_LINK)
+ && list->clause == OMP_LIST_LINK)
gfc_error_now ("OMP DECLARE TARGET variable at %L previously "
"mentioned in TO clause and later in LINK clause",
&n->where);
@@ -3465,7 +3561,7 @@ gfc_match_omp_declare_target (void)
else if (gfc_add_omp_declare_target (&n->sym->attr, n->sym->name,
&n->sym->declared_at))
{
- if (list == OMP_LIST_LINK)
+ if (list->clause == OMP_LIST_LINK)
gfc_add_omp_declare_target_link (&n->sym->attr, n->sym->name,
&n->sym->declared_at);
}
@@ -3482,13 +3578,13 @@ gfc_match_omp_declare_target (void)
}
else if (n->u.common->omp_declare_target
&& n->u.common->omp_declare_target_link
- && list != OMP_LIST_LINK)
+ && list->clause != OMP_LIST_LINK)
gfc_error_now ("OMP DECLARE TARGET COMMON at %L previously "
"mentioned in LINK clause and later in TO clause",
&n->where);
else if (n->u.common->omp_declare_target
&& !n->u.common->omp_declare_target_link
- && list == OMP_LIST_LINK)
+ && list->clause == OMP_LIST_LINK)
gfc_error_now ("OMP DECLARE TARGET COMMON at %L previously "
"mentioned in TO clause and later in LINK clause",
&n->where);
@@ -3499,7 +3595,8 @@ gfc_match_omp_declare_target (void)
else
{
n->u.common->omp_declare_target = 1;
- n->u.common->omp_declare_target_link = (list == OMP_LIST_LINK);
+ n->u.common->omp_declare_target_link
+ = (list->clause == OMP_LIST_LINK);
if (n->u.common->omp_device_type != OMP_DEVICE_TYPE_UNSET
&& n->u.common->omp_device_type != c->device_type)
gfc_error_now ("COMMON at %L set in previous OMP DECLARE "
@@ -3513,7 +3610,7 @@ gfc_match_omp_declare_target (void)
if (gfc_add_omp_declare_target (&s->attr, s->name,
&s->declared_at))
{
- if (list == OMP_LIST_LINK)
+ if (list->clause == OMP_LIST_LINK)
gfc_add_omp_declare_target_link (&s->attr, s->name,
&s->declared_at);
}
@@ -3525,7 +3622,9 @@ gfc_match_omp_declare_target (void)
s->attr.omp_device_type = c->device_type;
}
}
- if (c->device_type && !c->lists[OMP_LIST_TO] && !c->lists[OMP_LIST_LINK])
+ if (c->device_type
+ && !gfc_omp_get_nm_list (c, OMP_LIST_TO)
+ && !gfc_omp_get_nm_list (c, OMP_LIST_LINK))
gfc_warning_now (0, "OMP DECLARE TARGET directive at %L with only "
"DEVICE_TYPE clause is ignored", &old_loc);
@@ -4561,7 +4660,7 @@ resolve_omp_udr_callback2 (gfc_expr **e, int *, void *)
static gfc_code *
-resolve_omp_udr_clause (gfc_omp_namelist *n, gfc_namespace *ns,
+resolve_omp_udr_clause (gfc_omp_namelist_item *n, gfc_namespace *ns,
gfc_symbol *sym1, gfc_symbol *sym2)
{
gfc_code *copy;
@@ -4619,21 +4718,11 @@ static void
resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
gfc_namespace *ns, bool openacc = false)
{
- gfc_omp_namelist *n;
+ gfc_omp_namelist_item *n;
gfc_expr_list *el;
- int list;
int ifc;
bool if_without_mod = false;
gfc_omp_linear_op linear_op = OMP_LINEAR_DEFAULT;
- static const char *clause_names[]
- = { "PRIVATE", "FIRSTPRIVATE", "LASTPRIVATE", "COPYPRIVATE", "SHARED",
- "COPYIN", "UNIFORM", "ALIGNED", "LINEAR", "DEPEND", "MAP",
- "TO", "FROM", "REDUCTION", "REDUCTION" /*inscan*/, "REDUCTION" /*task*/,
- "IN_REDUCTION", "TASK_REDUCTION",
- "DEVICE_RESIDENT", "LINK", "USE_DEVICE",
- "CACHE", "IS_DEVICE_PTR", "USE_DEVICE_PTR", "USE_DEVICE_ADDR",
- "NONTEMPORAL" };
- STATIC_ASSERT (ARRAY_SIZE (clause_names) == OMP_LIST_NUM);
if (omp_clauses == NULL)
return;
@@ -4807,8 +4896,8 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
/* Check that no symbol appears on multiple clauses, except that
a symbol can appear on both firstprivate and lastprivate. */
- for (list = 0; list < OMP_LIST_NUM; list++)
- for (n = omp_clauses->lists[list]; n; n = n->next)
+ for (gfc_omp_namelist *list = omp_clauses->lists; list; list = list->next)
+ for (n = list->item; n; n = n->next)
{
n->sym->mark = 0;
n->sym->comp_mark = 0;
@@ -4849,7 +4938,7 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
continue;
}
}
- if (list == OMP_LIST_MAP
+ if (list->clause == OMP_LIST_MAP
&& n->sym->attr.flavor == FL_PARAMETER)
{
if (openacc)
@@ -4866,20 +4955,20 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
&n->where);
}
- for (list = 0; list < OMP_LIST_NUM; list++)
- if (list != OMP_LIST_FIRSTPRIVATE
- && list != OMP_LIST_LASTPRIVATE
- && list != OMP_LIST_ALIGNED
- && list != OMP_LIST_DEPEND
- && (list != OMP_LIST_MAP || openacc)
- && list != OMP_LIST_FROM
- && list != OMP_LIST_TO
- && (list != OMP_LIST_REDUCTION || !openacc)
- && list != OMP_LIST_REDUCTION_INSCAN
- && list != OMP_LIST_REDUCTION_TASK
- && list != OMP_LIST_IN_REDUCTION
- && list != OMP_LIST_TASK_REDUCTION)
- for (n = omp_clauses->lists[list]; n; n = n->next)
+ for (gfc_omp_namelist *list = omp_clauses->lists; list; list = list->next)
+ if (list->clause != OMP_LIST_FIRSTPRIVATE
+ && list->clause != OMP_LIST_LASTPRIVATE
+ && list->clause != OMP_LIST_ALIGNED
+ && list->clause != OMP_LIST_DEPEND
+ && (list->clause != OMP_LIST_MAP || openacc)
+ && list->clause != OMP_LIST_FROM
+ && list->clause != OMP_LIST_TO
+ && (list->clause != OMP_LIST_REDUCTION || !openacc)
+ && list->clause != OMP_LIST_REDUCTION_INSCAN
+ && list->clause != OMP_LIST_REDUCTION_TASK
+ && list->clause != OMP_LIST_IN_REDUCTION
+ && list->clause != OMP_LIST_TASK_REDUCTION)
+ for (n = list->item; n; n = n->next)
{
bool component_ref_p = false;
@@ -4904,18 +4993,19 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
n->sym->mark = 1;
}
}
+ for (gfc_omp_namelist *list = omp_clauses->lists; list; list = list->next)
+ if (list->clause == OMP_LIST_FIRSTPRIVATE
+ || list->clause == OMP_LIST_LASTPRIVATE)
+ for (n = list->item; n; n = n->next)
+ if (n->sym->mark)
+ {
+ gfc_error ("Symbol %qs present on multiple clauses at %L",
+ n->sym->name, &n->where);
+ n->sym->mark = 0;
+ }
- gcc_assert (OMP_LIST_LASTPRIVATE == OMP_LIST_FIRSTPRIVATE + 1);
- for (list = OMP_LIST_FIRSTPRIVATE; list <= OMP_LIST_LASTPRIVATE; list++)
- for (n = omp_clauses->lists[list]; n; n = n->next)
- if (n->sym->mark)
- {
- gfc_error ("Symbol %qs present on multiple clauses at %L",
- n->sym->name, &n->where);
- n->sym->mark = 0;
- }
-
- for (n = omp_clauses->lists[OMP_LIST_FIRSTPRIVATE]; n; n = n->next)
+ for (n = gfc_omp_get_nm_list (omp_clauses, OMP_LIST_FIRSTPRIVATE);
+ n; n = n->next)
{
if (n->sym->mark)
gfc_error ("Symbol %qs present on multiple clauses at %L",
@@ -4923,10 +5013,12 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
else
n->sym->mark = 1;
}
- for (n = omp_clauses->lists[OMP_LIST_LASTPRIVATE]; n; n = n->next)
+ for (n = gfc_omp_get_nm_list (omp_clauses, OMP_LIST_LASTPRIVATE);
+ n; n = n->next)
n->sym->mark = 0;
- for (n = omp_clauses->lists[OMP_LIST_LASTPRIVATE]; n; n = n->next)
+ for (n = gfc_omp_get_nm_list (omp_clauses, OMP_LIST_LASTPRIVATE);
+ n; n = n->next)
{
if (n->sym->mark)
gfc_error ("Symbol %qs present on multiple clauses at %L",
@@ -4935,10 +5027,10 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
n->sym->mark = 1;
}
- for (n = omp_clauses->lists[OMP_LIST_ALIGNED]; n; n = n->next)
+ for (n = gfc_omp_get_nm_list (omp_clauses, OMP_LIST_ALIGNED); n; n = n->next)
n->sym->mark = 0;
- for (n = omp_clauses->lists[OMP_LIST_ALIGNED]; n; n = n->next)
+ for (n = gfc_omp_get_nm_list (omp_clauses, OMP_LIST_ALIGNED); n; n = n->next)
{
if (n->sym->mark)
gfc_error ("Symbol %qs present on multiple clauses at %L",
@@ -4950,10 +5042,12 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
/* OpenACC reductions. */
if (openacc)
{
- for (n = omp_clauses->lists[OMP_LIST_REDUCTION]; n; n = n->next)
+ for (n = gfc_omp_get_nm_list (omp_clauses, OMP_LIST_REDUCTION);
+ n; n = n->next)
n->sym->mark = 0;
- for (n = omp_clauses->lists[OMP_LIST_REDUCTION]; n; n = n->next)
+ for (n = gfc_omp_get_nm_list (omp_clauses, OMP_LIST_REDUCTION);
+ n; n = n->next)
{
if (n->sym->mark)
gfc_error ("Symbol %qs present on multiple clauses at %L",
@@ -4968,12 +5062,12 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
}
}
- for (n = omp_clauses->lists[OMP_LIST_TO]; n; n = n->next)
+ for (n = gfc_omp_get_nm_list (omp_clauses, OMP_LIST_TO); n; n = n->next)
n->sym->mark = 0;
- for (n = omp_clauses->lists[OMP_LIST_FROM]; n; n = n->next)
+ for (n = gfc_omp_get_nm_list (omp_clauses, OMP_LIST_FROM); n; n = n->next)
if (n->expr == NULL)
n->sym->mark = 1;
- for (n = omp_clauses->lists[OMP_LIST_TO]; n; n = n->next)
+ for (n = gfc_omp_get_nm_list (omp_clauses, OMP_LIST_TO); n; n = n->next)
{
if (n->expr == NULL && n->sym->mark)
gfc_error ("Symbol %qs present on both FROM and TO clauses at %L",
@@ -4982,12 +5076,12 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
n->sym->mark = 1;
}
- for (list = 0; list < OMP_LIST_NUM; list++)
- if ((n = omp_clauses->lists[list]) != NULL)
+ for (gfc_omp_namelist *list = omp_clauses->lists; list; list = list->next)
{
- const char *name = clause_names[list];
+ const char *name = gfc_omp_get_clause_name (list->clause);
+ n = list->item;
- switch (list)
+ switch (list->clause)
{
case OMP_LIST_COPYIN:
for (; n != NULL; n = n->next)
@@ -5058,7 +5152,7 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
case OMP_LIST_CACHE:
for (; n != NULL; n = n->next)
{
- if (list == OMP_LIST_DEPEND)
+ if (list->clause == OMP_LIST_DEPEND)
{
if (n->u.depend_op == OMP_DEPEND_SINK_FIRST
|| n->u.depend_op == OMP_DEPEND_SINK)
@@ -5106,8 +5200,8 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
array isn't contiguous. An expression such as
arr(-n:n,-n:n) could be contiguous even if it looks
like it may not be. */
- if (list != OMP_LIST_CACHE
- && list != OMP_LIST_DEPEND
+ if (list->clause != OMP_LIST_CACHE
+ && list->clause != OMP_LIST_DEPEND
&& !gfc_is_simply_contiguous (n->expr, false, true)
&& gfc_is_not_contiguous (n->expr))
gfc_error ("Array is not contiguous at %L",
@@ -5153,7 +5247,7 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
n->sym->name, name, &n->where);
break;
}
- else if (list == OMP_LIST_DEPEND
+ else if (list->clause == OMP_LIST_DEPEND
&& ar->start[i]
&& ar->start[i]->expr_type == EXPR_CONSTANT
&& ar->end[i]
@@ -5170,25 +5264,25 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
}
else if (openacc)
{
- if (list == OMP_LIST_MAP
+ if (list->clause == OMP_LIST_MAP
&& n->u.map_op == OMP_MAP_FORCE_DEVICEPTR)
resolve_oacc_deviceptr_clause (n->sym, n->where, name);
else
resolve_oacc_data_clauses (n->sym, n->where, name);
}
- else if (list != OMP_LIST_DEPEND
+ else if (list->clause != OMP_LIST_DEPEND
&& n->sym->as
&& n->sym->as->type == AS_ASSUMED_SIZE)
gfc_error ("Assumed size array %qs in %s clause at %L",
n->sym->name, name, &n->where);
if (!openacc
- && list == OMP_LIST_MAP
+ && list->clause == OMP_LIST_MAP
&& n->sym->ts.type == BT_DERIVED
&& n->sym->ts.u.derived->attr.alloc_comp)
gfc_error ("List item %qs with allocatable components is not "
"permitted in map clause at %L", n->sym->name,
&n->where);
- if (list == OMP_LIST_MAP && !openacc)
+ if (list->clause == OMP_LIST_MAP && !openacc)
switch (code->op)
{
case EXEC_OMP_TARGET:
@@ -5246,8 +5340,8 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
}
}
- if (list != OMP_LIST_DEPEND)
- for (n = omp_clauses->lists[list]; n != NULL; n = n->next)
+ if (list->clause != OMP_LIST_DEPEND)
+ for (n = list->item; n != NULL; n = n->next)
{
n->sym->attr.referenced = 1;
if (n->sym->attr.threadprivate)
@@ -5284,11 +5378,12 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
for (; n != NULL; n = n->next)
{
bool bad = false;
- bool is_reduction = (list == OMP_LIST_REDUCTION
- || list == OMP_LIST_REDUCTION_INSCAN
- || list == OMP_LIST_REDUCTION_TASK
- || list == OMP_LIST_IN_REDUCTION
- || list == OMP_LIST_TASK_REDUCTION);
+ bool is_reduction
+ = (list->clause == OMP_LIST_REDUCTION
+ || list->clause == OMP_LIST_REDUCTION_INSCAN
+ || list->clause == OMP_LIST_REDUCTION_TASK
+ || list->clause == OMP_LIST_IN_REDUCTION
+ || list->clause == OMP_LIST_TASK_REDUCTION);
if (n->sym->attr.threadprivate)
gfc_error ("THREADPRIVATE object %qs in %s clause at %L",
n->sym->name, name, &n->where);
@@ -5298,7 +5393,7 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
if (n->sym->attr.associate_var)
gfc_error ("ASSOCIATE name %qs in %s clause at %L",
n->sym->name, name, &n->where);
- if (list != OMP_LIST_PRIVATE && is_reduction)
+ if (list->clause != OMP_LIST_PRIVATE && is_reduction)
{
if (n->sym->attr.proc_pointer)
gfc_error ("Procedure pointer %qs in %s clause at %L",
@@ -5323,7 +5418,7 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
"NAMELIST statement at %L",
n->sym->name, name, &n->where);
if (n->sym->attr.pointer && n->sym->attr.intent == INTENT_IN)
- switch (list)
+ switch (list->clause)
{
case OMP_LIST_PRIVATE:
case OMP_LIST_LASTPRIVATE:
@@ -5336,7 +5431,7 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
break;
}
- switch (list)
+ switch (list->clause)
{
case OMP_LIST_REDUCTION_INSCAN:
case OMP_LIST_REDUCTION_TASK:
@@ -5497,9 +5592,10 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
&& expr->symtree->n.sym->attr.dummy
&& expr->symtree->n.sym->ns == ns)
{
- gfc_omp_namelist *n2;
- for (n2 = omp_clauses->lists[OMP_LIST_UNIFORM];
- n2; n2 = n2->next)
+ gfc_omp_namelist_item *n2;
+ n2 = gfc_omp_get_nm_list (omp_clauses,
+ OMP_LIST_UNIFORM);
+ for (; n2; n2 = n2->next)
if (n2->sym == expr->symtree->n.sym)
break;
if (n2)
@@ -5614,9 +5710,9 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
"on ORDERED directive at %L", &code->loc);
if (!openacc
&& code
- && omp_clauses->lists[OMP_LIST_MAP] == NULL
- && omp_clauses->lists[OMP_LIST_USE_DEVICE_PTR] == NULL
- && omp_clauses->lists[OMP_LIST_USE_DEVICE_ADDR] == NULL)
+ && !gfc_omp_get_nm_list (omp_clauses, OMP_LIST_MAP)
+ && !gfc_omp_get_nm_list (omp_clauses, OMP_LIST_USE_DEVICE_PTR)
+ && !gfc_omp_get_nm_list (omp_clauses, OMP_LIST_USE_DEVICE_ADDR))
{
const char *p = NULL;
switch (code->op)
@@ -6163,8 +6259,7 @@ gfc_resolve_omp_parallel_blocks (gfc_code *code, gfc_namespace *ns)
{
struct fortran_omp_context ctx;
gfc_omp_clauses *omp_clauses = code->ext.omp_clauses;
- gfc_omp_namelist *n;
- int list;
+ gfc_omp_namelist_item *n;
ctx.code = code;
ctx.sharing_clauses = new hash_set<gfc_symbol *>;
@@ -6173,8 +6268,8 @@ gfc_resolve_omp_parallel_blocks (gfc_code *code, gfc_namespace *ns)
ctx.is_openmp = true;
omp_current_ctx = &ctx;
- for (list = 0; list < OMP_LIST_NUM; list++)
- switch (list)
+ for (gfc_omp_namelist *list = omp_clauses->lists; list; list = list->next)
+ switch (list->clause)
{
case OMP_LIST_SHARED:
case OMP_LIST_PRIVATE:
@@ -6186,7 +6281,7 @@ gfc_resolve_omp_parallel_blocks (gfc_code *code, gfc_namespace *ns)
case OMP_LIST_IN_REDUCTION:
case OMP_LIST_TASK_REDUCTION:
case OMP_LIST_LINEAR:
- for (n = omp_clauses->lists[list]; n; n = n->next)
+ for (n = list->item; n; n = n->next)
ctx.sharing_clauses->add (n->sym);
break;
default:
@@ -6284,13 +6379,13 @@ gfc_resolve_do_iterator (gfc_code *code, gfc_symbol *sym, bool add_clause)
if (! omp_current_ctx->private_iterators->add (sym) && add_clause)
{
+ gfc_omp_namelist_item **list;
gfc_omp_clauses *omp_clauses = omp_current_ctx->code->ext.omp_clauses;
- gfc_omp_namelist *p;
-
- p = gfc_get_omp_namelist ();
+ list = gfc_omp_get_nm_ref (omp_clauses, OMP_LIST_PRIVATE);
+ gfc_omp_namelist_item *p = gfc_get_omp_namelist_item ();
p->sym = sym;
- p->next = omp_clauses->lists[OMP_LIST_PRIVATE];
- omp_clauses->lists[OMP_LIST_PRIVATE] = p;
+ p->next = *list;
+ *list = p;
}
}
@@ -6315,8 +6410,8 @@ static void
resolve_omp_do (gfc_code *code)
{
gfc_code *do_code, *c;
- int list, i, collapse;
- gfc_omp_namelist *n;
+ int i, collapse;
+ gfc_omp_namelist_item *n;
gfc_symbol *dovar;
const char *name;
bool is_simd = false;
@@ -6421,12 +6516,15 @@ resolve_omp_do (gfc_code *code)
gfc_error ("%s iteration variable must not be THREADPRIVATE "
"at %L", name, &do_code->loc);
if (code->ext.omp_clauses)
- for (list = 0; list < OMP_LIST_NUM; list++)
+ for (gfc_omp_namelist *list = code->ext.omp_clauses->lists;
+ list; list = list->next)
if (!is_simd || code->ext.omp_clauses->collapse > 1
- ? (list != OMP_LIST_PRIVATE && list != OMP_LIST_LASTPRIVATE)
- : (list != OMP_LIST_PRIVATE && list != OMP_LIST_LASTPRIVATE
- && list != OMP_LIST_LINEAR))
- for (n = code->ext.omp_clauses->lists[list]; n; n = n->next)
+ ? (list->clause != OMP_LIST_PRIVATE
+ && list->clause != OMP_LIST_LASTPRIVATE)
+ : (list->clause != OMP_LIST_PRIVATE
+ && list->clause != OMP_LIST_LASTPRIVATE
+ && list->clause != OMP_LIST_LINEAR))
+ for (n = list->item; n; n = n->next)
if (dovar == n->sym)
{
if (!is_simd || code->ext.omp_clauses->collapse > 1)
@@ -6786,8 +6884,7 @@ gfc_resolve_oacc_blocks (gfc_code *code, gfc_namespace *ns)
{
fortran_omp_context ctx;
gfc_omp_clauses *omp_clauses = code->ext.omp_clauses;
- gfc_omp_namelist *n;
- int list;
+ gfc_omp_namelist_item *n;
resolve_oacc_loop_blocks (code);
@@ -6798,11 +6895,11 @@ gfc_resolve_oacc_blocks (gfc_code *code, gfc_namespace *ns)
ctx.is_openmp = false;
omp_current_ctx = &ctx;
- for (list = 0; list < OMP_LIST_NUM; list++)
- switch (list)
+ for (gfc_omp_namelist *list = omp_clauses->lists; list; list = list->next)
+ switch (list->clause)
{
case OMP_LIST_PRIVATE:
- for (n = omp_clauses->lists[list]; n; n = n->next)
+ for (n = list->item; n; n = n->next)
ctx.sharing_clauses->add (n->sym);
break;
default:
@@ -6849,8 +6946,7 @@ resolve_oacc_loop (gfc_code *code)
void
gfc_resolve_oacc_declare (gfc_namespace *ns)
{
- int list;
- gfc_omp_namelist *n;
+ gfc_omp_namelist_item *n;
gfc_oacc_declare *oc;
if (ns->oacc_declare == NULL)
@@ -6858,8 +6954,8 @@ gfc_resolve_oacc_declare (gfc_namespace *ns)
for (oc = ns->oacc_declare; oc; oc = oc->next)
{
- for (list = 0; list < OMP_LIST_NUM; list++)
- for (n = oc->clauses->lists[list]; n; n = n->next)
+ for (gfc_omp_namelist *list = oc->clauses->lists; list; list = list->next)
+ for (n = list->item; n; n = n->next)
{
n->sym->mark = 0;
if (n->sym->attr.flavor != FL_VARIABLE
@@ -6879,14 +6975,15 @@ gfc_resolve_oacc_declare (gfc_namespace *ns)
}
}
- for (n = oc->clauses->lists[OMP_LIST_DEVICE_RESIDENT]; n; n = n->next)
+ n = gfc_omp_get_nm_list (oc->clauses, OMP_LIST_DEVICE_RESIDENT);
+ for (; n; n = n->next)
check_array_not_assumed (n->sym, oc->loc, "DEVICE_RESIDENT");
}
for (oc = ns->oacc_declare; oc; oc = oc->next)
{
- for (list = 0; list < OMP_LIST_NUM; list++)
- for (n = oc->clauses->lists[list]; n; n = n->next)
+ for (gfc_omp_namelist *list = oc->clauses->lists; list; list = list->next)
+ for (n = list->item; n; n = n->next)
{
if (n->sym->mark)
{
@@ -6901,8 +6998,8 @@ gfc_resolve_oacc_declare (gfc_namespace *ns)
for (oc = ns->oacc_declare; oc; oc = oc->next)
{
- for (list = 0; list < OMP_LIST_NUM; list++)
- for (n = oc->clauses->lists[list]; n; n = n->next)
+ for (gfc_omp_namelist *list = oc->clauses->lists; list; list = list->next)
+ for (n = list->item; n; n = n->next)
n->sym->mark = 0;
}
}
@@ -7027,8 +7124,8 @@ gfc_resolve_omp_directive (gfc_code *code, gfc_namespace *ns ATTRIBUTE_UNUSED)
if (code->ext.omp_clauses)
resolve_omp_clauses (code, code->ext.omp_clauses, NULL);
if (code->ext.omp_clauses == NULL
- || (code->ext.omp_clauses->lists[OMP_LIST_TO] == NULL
- && code->ext.omp_clauses->lists[OMP_LIST_FROM] == NULL))
+ || (!gfc_omp_get_nm_list (code->ext.omp_clauses, OMP_LIST_TO)
+ && !gfc_omp_get_nm_list (code->ext.omp_clauses, OMP_LIST_FROM)))
gfc_error ("OMP TARGET UPDATE at %L requires at least one TO or "
"FROM clause", &code->loc);
break;
@@ -5434,9 +5434,13 @@ parse_omp_structured_block (gfc_statement omp_st, bool workshare_stmts_only)
new_st.ext.omp_name = NULL;
break;
case EXEC_OMP_END_SINGLE:
- cp->ext.omp_clauses->lists[OMP_LIST_COPYPRIVATE]
- = new_st.ext.omp_clauses->lists[OMP_LIST_COPYPRIVATE];
- new_st.ext.omp_clauses->lists[OMP_LIST_COPYPRIVATE] = NULL;
+ if (cp->ext.omp_clauses->lists && new_st.ext.omp_clauses->lists)
+ {
+ gcc_assert (!new_st.ext.omp_clauses->lists->next);
+ new_st.ext.omp_clauses->lists->next = cp->ext.omp_clauses->lists;
+ }
+ cp->ext.omp_clauses->lists = new_st.ext.omp_clauses->lists;
+ new_st.ext.omp_clauses->lists = NULL;
gfc_free_omp_clauses (new_st.ext.omp_clauses);
break;
case EXEC_NOP:
@@ -265,7 +265,7 @@ gfc_free_statement (gfc_code *p)
break;
case EXEC_OMP_FLUSH:
- gfc_free_omp_namelist (p->ext.omp_namelist);
+ gfc_free_omp_namelist_item (p->ext.omp_namelist);
break;
case EXEC_OMP_BARRIER:
@@ -6603,19 +6603,27 @@ static gfc_omp_clauses *module_oacc_clauses;
static void
add_clause (gfc_symbol *sym, gfc_omp_map_op map_op)
{
- gfc_omp_namelist *n;
+ gfc_omp_namelist *list;
+ gfc_omp_namelist_item *n;
- n = gfc_get_omp_namelist ();
+ n = gfc_get_omp_namelist_item ();
n->sym = sym;
n->u.map_op = map_op;
if (!module_oacc_clauses)
module_oacc_clauses = gfc_get_omp_clauses ();
- if (module_oacc_clauses->lists[OMP_LIST_MAP])
- n->next = module_oacc_clauses->lists[OMP_LIST_MAP];
-
- module_oacc_clauses->lists[OMP_LIST_MAP] = n;
+ for (list = module_oacc_clauses->lists; list; list = list->next)
+ if (list->clause == OMP_LIST_MAP)
+ break;
+ if (list)
+ n->next = list->item;
+ else
+ {
+ module_oacc_clauses->lists = list = gfc_get_omp_namelist ();
+ list->clause = OMP_LIST_MAP;
+ }
+ list->item = n;
}
@@ -6657,7 +6665,7 @@ finish_oacc_declare (gfc_namespace *ns, gfc_symbol *sym, bool block)
gfc_oacc_declare *oc;
locus where = gfc_current_locus;
gfc_omp_clauses *omp_clauses = NULL;
- gfc_omp_namelist *n, *p;
+ gfc_omp_namelist_item *n, *p;
module_oacc_clauses = NULL;
gfc_traverse_ns (ns, find_module_oacc_declare_clauses);
@@ -6685,8 +6693,10 @@ finish_oacc_declare (gfc_namespace *ns, gfc_symbol *sym, bool block)
gfc_error ("Sorry, !$ACC DECLARE at %L is not allowed "
"in BLOCK construct", &oc->loc);
-
- if (oc->clauses && oc->clauses->lists[OMP_LIST_MAP])
+ gfc_omp_namelist_item *oc_list;
+ oc_list = (oc->clauses ? gfc_omp_get_nm_list (oc->clauses, OMP_LIST_MAP)
+ : NULL);
+ if (oc_list)
{
if (omp_clauses == NULL)
{
@@ -6694,12 +6704,12 @@ finish_oacc_declare (gfc_namespace *ns, gfc_symbol *sym, bool block)
continue;
}
- for (n = oc->clauses->lists[OMP_LIST_MAP]; n; p = n, n = n->next)
+ for (n = oc_list; n; p = n, n = n->next)
;
gcc_assert (p->next == NULL);
- p->next = omp_clauses->lists[OMP_LIST_MAP];
+ p->next = gfc_omp_get_nm_list (omp_clauses, OMP_LIST_MAP);
omp_clauses = oc->clauses;
}
}
@@ -6707,7 +6717,8 @@ finish_oacc_declare (gfc_namespace *ns, gfc_symbol *sym, bool block)
if (!omp_clauses)
return;
- for (n = omp_clauses->lists[OMP_LIST_MAP]; n; n = n->next)
+ n = gfc_omp_get_nm_list (omp_clauses, OMP_LIST_MAP);
+ for (; n; n = n->next)
{
switch (n->u.map_op)
{
@@ -1694,7 +1694,7 @@ gfc_trans_omp_variable (gfc_symbol *sym, bool declare_simd)
static tree
gfc_trans_omp_variable_list (enum omp_clause_code code,
- gfc_omp_namelist *namelist, tree list,
+ gfc_omp_namelist_item *namelist, tree list,
bool declare_simd)
{
for (; namelist != NULL; namelist = namelist->next)
@@ -1734,7 +1734,7 @@ omp_udr_find_orig (gfc_expr **e, int *walk_subtrees ATTRIBUTE_UNUSED,
}
static void
-gfc_trans_omp_array_reduction_or_udr (tree c, gfc_omp_namelist *n, locus where)
+gfc_trans_omp_array_reduction_or_udr (tree c, gfc_omp_namelist_item *n, locus where)
{
gfc_symbol *sym = n->sym;
gfc_symtree *root1 = NULL, *root2 = NULL, *root3 = NULL, *root4 = NULL;
@@ -2033,7 +2033,8 @@ gfc_trans_omp_array_reduction_or_udr (tree c, gfc_omp_namelist *n, locus where)
}
static tree
-gfc_trans_omp_reduction_list (int kind, gfc_omp_namelist *namelist, tree list,
+gfc_trans_omp_reduction_list (enum omp_list_clauses kind,
+ gfc_omp_namelist_item *namelist, tree list,
locus where, bool mark_addressable)
{
omp_clause_code clause = OMP_CLAUSE_REDUCTION;
@@ -2142,7 +2143,7 @@ static vec<tree, va_heap, vl_embed> *doacross_steps;
/* Translate an array section or array element. */
static void
-gfc_trans_omp_array_section (stmtblock_t *block, gfc_omp_namelist *n,
+gfc_trans_omp_array_section (stmtblock_t *block, gfc_omp_namelist_item *n,
tree decl, bool element, gomp_map_kind ptr_kind,
tree &node, tree &node2, tree &node3, tree &node4)
{
@@ -2275,20 +2276,20 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
bool openacc = false)
{
tree omp_clauses = NULL_TREE, chunk_size, c;
- int list, ifc;
+ int ifc;
enum omp_clause_code clause_code;
gfc_se se;
if (clauses == NULL)
return NULL_TREE;
- for (list = 0; list < OMP_LIST_NUM; list++)
+ for (gfc_omp_namelist *list = clauses->lists; list; list = list->next)
{
- gfc_omp_namelist *n = clauses->lists[list];
+ gfc_omp_namelist_item *n = list->item;
if (n == NULL)
continue;
- switch (list)
+ switch (list->clause)
{
case OMP_LIST_REDUCTION:
case OMP_LIST_REDUCTION_INSCAN:
@@ -2297,8 +2298,9 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
case OMP_LIST_TASK_REDUCTION:
/* An OpenACC async clause indicates the need to set reduction
arguments addressable, to allow asynchronous copy-out. */
- omp_clauses = gfc_trans_omp_reduction_list (list, n, omp_clauses,
- where, clauses->async);
+ omp_clauses = gfc_trans_omp_reduction_list (list->clause, n,
+ omp_clauses, where,
+ clauses->async);
break;
case OMP_LIST_PRIVATE:
clause_code = OMP_CLAUSE_PRIVATE;
@@ -3162,7 +3164,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
if (!n->sym->attr.referenced)
continue;
- switch (list)
+ switch (list->clause)
{
case OMP_LIST_TO:
clause_code = OMP_CLAUSE_TO;
@@ -4445,9 +4447,9 @@ gfc_trans_omp_do (gfc_code *code, gfc_exec_op op, stmtblock_t *pblock,
if (clauses)
{
- gfc_omp_namelist *n = NULL;
+ gfc_omp_namelist_item *n = NULL;
if (op == EXEC_OMP_SIMD && collapse == 1)
- for (n = clauses->lists[OMP_LIST_LINEAR];
+ for (n = gfc_omp_get_nm_list (clauses, OMP_LIST_LINEAR);
n != NULL; n = n->next)
if (code->ext.iterator->var->symtree->n.sym == n->sym)
{
@@ -4455,7 +4457,7 @@ gfc_trans_omp_do (gfc_code *code, gfc_exec_op op, stmtblock_t *pblock,
break;
}
if (n == NULL && op != EXEC_OMP_DISTRIBUTE)
- for (n = clauses->lists[OMP_LIST_LASTPRIVATE];
+ for (n = gfc_omp_get_nm_list (clauses, OMP_LIST_LASTPRIVATE);
n != NULL; n = n->next)
if (code->ext.iterator->var->symtree->n.sym == n->sym)
{
@@ -4463,7 +4465,8 @@ gfc_trans_omp_do (gfc_code *code, gfc_exec_op op, stmtblock_t *pblock,
break;
}
if (n == NULL)
- for (n = clauses->lists[OMP_LIST_PRIVATE]; n != NULL; n = n->next)
+ for (n = gfc_omp_get_nm_list (clauses, OMP_LIST_PRIVATE);
+ n != NULL; n = n->next)
if (code->ext.iterator->var->symtree->n.sym == n->sym)
{
dovar_found = 1;
@@ -4791,10 +4794,22 @@ gfc_trans_oacc_combined_directive (gfc_code *code)
loop_clauses.par_auto = construct_clauses.par_auto;
loop_clauses.independent = construct_clauses.independent;
loop_clauses.tile_list = construct_clauses.tile_list;
- loop_clauses.lists[OMP_LIST_PRIVATE]
- = construct_clauses.lists[OMP_LIST_PRIVATE];
- loop_clauses.lists[OMP_LIST_REDUCTION]
- = construct_clauses.lists[OMP_LIST_REDUCTION];
+ for (gfc_omp_namelist *list = construct_clauses.lists;
+ list; list = list->next)
+ {
+ if (list->clause == OMP_LIST_PRIVATE)
+ {
+ *gfc_omp_get_nm_ref (&loop_clauses, OMP_LIST_PRIVATE) = list->item;
+ list->item = NULL;
+ }
+ else if (list->clause == OMP_LIST_REDUCTION)
+ {
+ *gfc_omp_get_nm_ref (&loop_clauses, OMP_LIST_REDUCTION)
+ = list->item;
+ if (construct_code == OACC_KERNELS)
+ list->item = NULL;
+ }
+ }
construct_clauses.gang = false;
construct_clauses.gang_static = false;
construct_clauses.gang_num_expr = NULL;
@@ -4808,9 +4823,6 @@ gfc_trans_oacc_combined_directive (gfc_code *code)
construct_clauses.independent = false;
construct_clauses.independent = false;
construct_clauses.tile_list = NULL;
- construct_clauses.lists[OMP_LIST_PRIVATE] = NULL;
- if (construct_code == OACC_KERNELS)
- construct_clauses.lists[OMP_LIST_REDUCTION] = NULL;
oacc_clauses = gfc_trans_omp_clauses (&block, &construct_clauses,
code->loc, false, true);
}
@@ -4923,6 +4935,17 @@ enum
};
static void
+gfc_copy_list_clauses (gfc_omp_clauses *to, gfc_omp_clauses *from,
+ enum omp_list_clauses clause)
+{
+ gfc_omp_namelist_item *list = gfc_omp_get_nm_list (from, clause);
+ if (list)
+ *gfc_omp_get_nm_ref (to, clause) = list;
+}
+
+/* Return true if actual splitting was done. */
+
+bool
gfc_split_omp_clauses (gfc_code *code,
gfc_omp_clauses clausesa[GFC_OMP_SPLIT_NUM])
{
@@ -5045,17 +5068,17 @@ gfc_split_omp_clauses (gfc_code *code,
if (mask == 0)
{
clausesa[innermost] = *code->ext.omp_clauses;
- return;
+ return false;
}
if (code->ext.omp_clauses != NULL)
{
if (mask & GFC_OMP_MASK_TARGET)
{
/* First the clauses that are unique to some constructs. */
- clausesa[GFC_OMP_SPLIT_TARGET].lists[OMP_LIST_MAP]
- = code->ext.omp_clauses->lists[OMP_LIST_MAP];
- clausesa[GFC_OMP_SPLIT_TARGET].lists[OMP_LIST_IS_DEVICE_PTR]
- = code->ext.omp_clauses->lists[OMP_LIST_IS_DEVICE_PTR];
+ gfc_copy_list_clauses (&clausesa[GFC_OMP_SPLIT_TARGET],
+ code->ext.omp_clauses, OMP_LIST_MAP);
+ gfc_copy_list_clauses (&clausesa[GFC_OMP_SPLIT_TARGET],
+ code->ext.omp_clauses, OMP_LIST_IS_DEVICE_PTR);
clausesa[GFC_OMP_SPLIT_TARGET].device
= code->ext.omp_clauses->device;
clausesa[GFC_OMP_SPLIT_TARGET].defaultmap
@@ -5075,8 +5098,8 @@ gfc_split_omp_clauses (gfc_code *code,
= code->ext.omp_clauses->thread_limit;
/* Shared and default clauses are allowed on parallel, teams
and taskloop. */
- clausesa[GFC_OMP_SPLIT_TEAMS].lists[OMP_LIST_SHARED]
- = code->ext.omp_clauses->lists[OMP_LIST_SHARED];
+ gfc_copy_list_clauses (&clausesa[GFC_OMP_SPLIT_TEAMS],
+ code->ext.omp_clauses, OMP_LIST_SHARED);
clausesa[GFC_OMP_SPLIT_TEAMS].default_sharing
= code->ext.omp_clauses->default_sharing;
}
@@ -5096,16 +5119,16 @@ gfc_split_omp_clauses (gfc_code *code,
if (mask & GFC_OMP_MASK_PARALLEL)
{
/* First the clauses that are unique to some constructs. */
- clausesa[GFC_OMP_SPLIT_PARALLEL].lists[OMP_LIST_COPYIN]
- = code->ext.omp_clauses->lists[OMP_LIST_COPYIN];
+ gfc_copy_list_clauses (&clausesa[GFC_OMP_SPLIT_PARALLEL],
+ code->ext.omp_clauses, OMP_LIST_COPYIN);
clausesa[GFC_OMP_SPLIT_PARALLEL].num_threads
= code->ext.omp_clauses->num_threads;
clausesa[GFC_OMP_SPLIT_PARALLEL].proc_bind
= code->ext.omp_clauses->proc_bind;
/* Shared and default clauses are allowed on parallel, teams
and taskloop. */
- clausesa[GFC_OMP_SPLIT_PARALLEL].lists[OMP_LIST_SHARED]
- = code->ext.omp_clauses->lists[OMP_LIST_SHARED];
+ gfc_copy_list_clauses (&clausesa[GFC_OMP_SPLIT_PARALLEL],
+ code->ext.omp_clauses, OMP_LIST_SHARED);
clausesa[GFC_OMP_SPLIT_PARALLEL].default_sharing
= code->ext.omp_clauses->default_sharing;
clausesa[GFC_OMP_SPLIT_PARALLEL].if_exprs[OMP_IF_PARALLEL]
@@ -5146,8 +5169,8 @@ gfc_split_omp_clauses (gfc_code *code,
= code->ext.omp_clauses->safelen_expr;
clausesa[GFC_OMP_SPLIT_SIMD].simdlen_expr
= code->ext.omp_clauses->simdlen_expr;
- clausesa[GFC_OMP_SPLIT_SIMD].lists[OMP_LIST_ALIGNED]
- = code->ext.omp_clauses->lists[OMP_LIST_ALIGNED];
+ gfc_copy_list_clauses (&clausesa[GFC_OMP_SPLIT_SIMD],
+ code->ext.omp_clauses, OMP_LIST_ALIGNED);
/* Duplicate collapse. */
clausesa[GFC_OMP_SPLIT_SIMD].collapse
= code->ext.omp_clauses->collapse;
@@ -5183,8 +5206,8 @@ gfc_split_omp_clauses (gfc_code *code,
= code->ext.omp_clauses->if_expr;
/* Shared and default clauses are allowed on parallel, teams
and taskloop. */
- clausesa[GFC_OMP_SPLIT_TASKLOOP].lists[OMP_LIST_SHARED]
- = code->ext.omp_clauses->lists[OMP_LIST_SHARED];
+ gfc_copy_list_clauses (&clausesa[GFC_OMP_SPLIT_TASKLOOP],
+ code->ext.omp_clauses, OMP_LIST_SHARED);
clausesa[GFC_OMP_SPLIT_TASKLOOP].default_sharing
= code->ext.omp_clauses->default_sharing;
/* Duplicate collapse. */
@@ -5195,75 +5218,92 @@ gfc_split_omp_clauses (gfc_code *code,
it is enough to put it on the innermost one. For
!$ omp parallel do put it on parallel though,
as that's what we did for OpenMP 3.1. */
- clausesa[innermost == GFC_OMP_SPLIT_DO
- ? (int) GFC_OMP_SPLIT_PARALLEL
- : innermost].lists[OMP_LIST_PRIVATE]
- = code->ext.omp_clauses->lists[OMP_LIST_PRIVATE];
+ gfc_copy_list_clauses (&clausesa[innermost == GFC_OMP_SPLIT_DO
+ ? (int) GFC_OMP_SPLIT_PARALLEL
+ : innermost],
+ code->ext.omp_clauses, OMP_LIST_PRIVATE);
/* Firstprivate clause is supported on all constructs but
simd. Put it on the outermost of those and duplicate
on parallel and teams. */
if (mask & GFC_OMP_MASK_TARGET)
- clausesa[GFC_OMP_SPLIT_TARGET].lists[OMP_LIST_FIRSTPRIVATE]
- = code->ext.omp_clauses->lists[OMP_LIST_FIRSTPRIVATE];
+ gfc_copy_list_clauses (&clausesa[GFC_OMP_SPLIT_TARGET],
+ code->ext.omp_clauses, OMP_LIST_FIRSTPRIVATE);
if (mask & GFC_OMP_MASK_TEAMS)
- clausesa[GFC_OMP_SPLIT_TEAMS].lists[OMP_LIST_FIRSTPRIVATE]
- = code->ext.omp_clauses->lists[OMP_LIST_FIRSTPRIVATE];
+ gfc_copy_list_clauses (&clausesa[GFC_OMP_SPLIT_TEAMS],
+ code->ext.omp_clauses, OMP_LIST_FIRSTPRIVATE);
else if (mask & GFC_OMP_MASK_DISTRIBUTE)
- clausesa[GFC_OMP_SPLIT_DISTRIBUTE].lists[OMP_LIST_FIRSTPRIVATE]
- = code->ext.omp_clauses->lists[OMP_LIST_FIRSTPRIVATE];
+ gfc_copy_list_clauses (&clausesa[GFC_OMP_SPLIT_DISTRIBUTE],
+ code->ext.omp_clauses, OMP_LIST_FIRSTPRIVATE);
if (mask & GFC_OMP_MASK_PARALLEL)
- clausesa[GFC_OMP_SPLIT_PARALLEL].lists[OMP_LIST_FIRSTPRIVATE]
- = code->ext.omp_clauses->lists[OMP_LIST_FIRSTPRIVATE];
+ gfc_copy_list_clauses (&clausesa[GFC_OMP_SPLIT_PARALLEL],
+ code->ext.omp_clauses, OMP_LIST_FIRSTPRIVATE);
else if (mask & GFC_OMP_MASK_DO)
- clausesa[GFC_OMP_SPLIT_DO].lists[OMP_LIST_FIRSTPRIVATE]
- = code->ext.omp_clauses->lists[OMP_LIST_FIRSTPRIVATE];
+ gfc_copy_list_clauses (&clausesa[GFC_OMP_SPLIT_DO],
+ code->ext.omp_clauses, OMP_LIST_FIRSTPRIVATE);
/* Lastprivate is allowed on distribute, do and simd.
In parallel do{, simd} we actually want to put it on
parallel rather than do. */
if (mask & GFC_OMP_MASK_DISTRIBUTE)
- clausesa[GFC_OMP_SPLIT_DISTRIBUTE].lists[OMP_LIST_LASTPRIVATE]
- = code->ext.omp_clauses->lists[OMP_LIST_LASTPRIVATE];
+ gfc_copy_list_clauses (&clausesa[GFC_OMP_SPLIT_DISTRIBUTE],
+ code->ext.omp_clauses, OMP_LIST_LASTPRIVATE);
if (mask & GFC_OMP_MASK_PARALLEL)
- clausesa[GFC_OMP_SPLIT_PARALLEL].lists[OMP_LIST_LASTPRIVATE]
- = code->ext.omp_clauses->lists[OMP_LIST_LASTPRIVATE];
+ gfc_copy_list_clauses (&clausesa[GFC_OMP_SPLIT_PARALLEL],
+ code->ext.omp_clauses, OMP_LIST_LASTPRIVATE);
else if (mask & GFC_OMP_MASK_DO)
- clausesa[GFC_OMP_SPLIT_DO].lists[OMP_LIST_LASTPRIVATE]
- = code->ext.omp_clauses->lists[OMP_LIST_LASTPRIVATE];
+ gfc_copy_list_clauses (&clausesa[GFC_OMP_SPLIT_DO],
+ code->ext.omp_clauses, OMP_LIST_LASTPRIVATE);
if (mask & GFC_OMP_MASK_SIMD)
- clausesa[GFC_OMP_SPLIT_SIMD].lists[OMP_LIST_LASTPRIVATE]
- = code->ext.omp_clauses->lists[OMP_LIST_LASTPRIVATE];
+ gfc_copy_list_clauses (&clausesa[GFC_OMP_SPLIT_SIMD],
+ code->ext.omp_clauses, OMP_LIST_LASTPRIVATE);
/* Reduction is allowed on simd, do, parallel and teams.
Duplicate it on all of them, but omit on do if
parallel is present. */
- for (int i = OMP_LIST_REDUCTION; i <= OMP_LIST_REDUCTION_TASK; i++)
- {
- if (mask & GFC_OMP_MASK_TEAMS)
- clausesa[GFC_OMP_SPLIT_TEAMS].lists[i]
- = code->ext.omp_clauses->lists[i];
- if (mask & GFC_OMP_MASK_PARALLEL)
- clausesa[GFC_OMP_SPLIT_PARALLEL].lists[i]
- = code->ext.omp_clauses->lists[i];
- else if (mask & GFC_OMP_MASK_DO)
- clausesa[GFC_OMP_SPLIT_DO].lists[i]
- = code->ext.omp_clauses->lists[i];
- if (mask & GFC_OMP_MASK_SIMD)
- clausesa[GFC_OMP_SPLIT_SIMD].lists[i]
- = code->ext.omp_clauses->lists[i];
- }
+ for (gfc_omp_namelist *list = code->ext.omp_clauses->lists;
+ list; list = list->next)
+ if (list->clause == OMP_LIST_REDUCTION
+ || list->clause == OMP_LIST_REDUCTION_INSCAN
+ || list->clause == OMP_LIST_REDUCTION_TASK)
+ {
+ if (mask & GFC_OMP_MASK_TEAMS)
+ *gfc_omp_get_nm_ref (&clausesa[GFC_OMP_SPLIT_TEAMS], list->clause)
+ = list->item;
+ if (mask & GFC_OMP_MASK_PARALLEL)
+ *gfc_omp_get_nm_ref (&clausesa[GFC_OMP_SPLIT_PARALLEL],
+ list->clause) = list->item;
+ else if (mask & GFC_OMP_MASK_DO)
+ *gfc_omp_get_nm_ref (&clausesa[GFC_OMP_SPLIT_DO], list->clause)
+ = list->item;
+ if (mask & GFC_OMP_MASK_SIMD)
+ *gfc_omp_get_nm_ref (&clausesa[GFC_OMP_SPLIT_SIMD], list->clause)
+ = list->item;
+ }
if (mask & GFC_OMP_MASK_TARGET)
- clausesa[GFC_OMP_SPLIT_TARGET].lists[OMP_LIST_IN_REDUCTION]
- = code->ext.omp_clauses->lists[OMP_LIST_IN_REDUCTION];
+ gfc_copy_list_clauses (&clausesa[GFC_OMP_SPLIT_TARGET],
+ code->ext.omp_clauses, OMP_LIST_IN_REDUCTION);
if (mask & GFC_OMP_MASK_TASKLOOP)
- clausesa[GFC_OMP_SPLIT_TASKLOOP].lists[OMP_LIST_IN_REDUCTION]
- = code->ext.omp_clauses->lists[OMP_LIST_IN_REDUCTION];
+ gfc_copy_list_clauses (&clausesa[GFC_OMP_SPLIT_TASKLOOP],
+ code->ext.omp_clauses, OMP_LIST_IN_REDUCTION);
/* Linear clause is supported on do and simd,
put it on the innermost one. */
- clausesa[innermost].lists[OMP_LIST_LINEAR]
- = code->ext.omp_clauses->lists[OMP_LIST_LINEAR];
+ gfc_copy_list_clauses (&clausesa[innermost],
+ code->ext.omp_clauses, OMP_LIST_LINEAR);
}
if ((mask & (GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO))
== (GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO))
clausesa[GFC_OMP_SPLIT_DO].nowait = true;
+ return true;
+}
+
+static void
+gfc_trans_omp_free_clausea (gfc_omp_clauses clausesa[GFC_OMP_SPLIT_NUM])
+{
+ gfc_omp_namelist *next, *list;
+ for (int i = 0; i < GFC_OMP_SPLIT_NUM; ++i)
+ for (list = clausesa[i].lists; list; list = next)
+ {
+ next = list->next;
+ free (list);
+ }
}
static tree
@@ -5273,6 +5313,7 @@ gfc_trans_omp_do_simd (gfc_code *code, stmtblock_t *pblock,
stmtblock_t block;
gfc_omp_clauses clausesa_buf[GFC_OMP_SPLIT_NUM];
tree stmt, body, omp_do_clauses = NULL_TREE;
+ bool do_free = false;
if (pblock == NULL)
gfc_start_block (&block);
@@ -5282,7 +5323,7 @@ gfc_trans_omp_do_simd (gfc_code *code, stmtblock_t *pblock,
if (clausesa == NULL)
{
clausesa = clausesa_buf;
- gfc_split_omp_clauses (code, clausesa);
+ do_free = gfc_split_omp_clauses (code, clausesa);
}
if (flag_openmp)
omp_do_clauses
@@ -5308,6 +5349,8 @@ gfc_trans_omp_do_simd (gfc_code *code, stmtblock_t *pblock,
else
stmt = body;
gfc_add_expr_to_block (&block, stmt);
+ if (clausesa == clausesa_buf && do_free)
+ gfc_trans_omp_free_clausea (clausesa_buf);
return gfc_finish_block (&block);
}
@@ -5318,6 +5361,7 @@ gfc_trans_omp_parallel_do (gfc_code *code, stmtblock_t *pblock,
stmtblock_t block, *new_pblock = pblock;
gfc_omp_clauses clausesa_buf[GFC_OMP_SPLIT_NUM];
tree stmt, omp_clauses = NULL_TREE;
+ bool do_free = false;
if (pblock == NULL)
gfc_start_block (&block);
@@ -5327,7 +5371,7 @@ gfc_trans_omp_parallel_do (gfc_code *code, stmtblock_t *pblock,
if (clausesa == NULL)
{
clausesa = clausesa_buf;
- gfc_split_omp_clauses (code, clausesa);
+ do_free = gfc_split_omp_clauses (code, clausesa);
}
omp_clauses
= gfc_trans_omp_clauses (&block, &clausesa[GFC_OMP_SPLIT_PARALLEL],
@@ -5355,6 +5399,8 @@ gfc_trans_omp_parallel_do (gfc_code *code, stmtblock_t *pblock,
void_type_node, stmt, omp_clauses);
OMP_PARALLEL_COMBINED (stmt) = 1;
gfc_add_expr_to_block (&block, stmt);
+ if (clausesa == clausesa_buf && do_free)
+ gfc_trans_omp_free_clausea (clausesa_buf);
return gfc_finish_block (&block);
}
@@ -5365,6 +5411,7 @@ gfc_trans_omp_parallel_do_simd (gfc_code *code, stmtblock_t *pblock,
stmtblock_t block;
gfc_omp_clauses clausesa_buf[GFC_OMP_SPLIT_NUM];
tree stmt, omp_clauses = NULL_TREE;
+ bool do_free = false;
if (pblock == NULL)
gfc_start_block (&block);
@@ -5374,7 +5421,7 @@ gfc_trans_omp_parallel_do_simd (gfc_code *code, stmtblock_t *pblock,
if (clausesa == NULL)
{
clausesa = clausesa_buf;
- gfc_split_omp_clauses (code, clausesa);
+ do_free = gfc_split_omp_clauses (code, clausesa);
}
if (flag_openmp)
omp_clauses
@@ -5399,6 +5446,8 @@ gfc_trans_omp_parallel_do_simd (gfc_code *code, stmtblock_t *pblock,
OMP_PARALLEL_COMBINED (stmt) = 1;
}
gfc_add_expr_to_block (&block, stmt);
+ if (clausesa == clausesa_buf && do_free)
+ gfc_trans_omp_free_clausea (clausesa_buf);
return gfc_finish_block (&block);
}
@@ -5456,7 +5505,7 @@ gfc_trans_omp_sections (gfc_code *code, gfc_omp_clauses *clauses)
{
stmtblock_t block, body;
tree omp_clauses, stmt;
- bool has_lastprivate = clauses->lists[OMP_LIST_LASTPRIVATE] != NULL;
+ bool has_lastprivate = !!gfc_omp_get_nm_list (clauses, OMP_LIST_LASTPRIVATE);
location_t loc = gfc_get_location (&code->loc);
gfc_start_block (&block);
@@ -5543,12 +5592,13 @@ gfc_trans_omp_distribute (gfc_code *code, gfc_omp_clauses *clausesa)
stmtblock_t block;
gfc_omp_clauses clausesa_buf[GFC_OMP_SPLIT_NUM];
tree stmt, omp_clauses = NULL_TREE;
+ bool do_free = false;
gfc_start_block (&block);
if (clausesa == NULL)
{
clausesa = clausesa_buf;
- gfc_split_omp_clauses (code, clausesa);
+ do_free = gfc_split_omp_clauses (code, clausesa);
}
if (flag_openmp)
omp_clauses
@@ -5602,6 +5652,8 @@ gfc_trans_omp_distribute (gfc_code *code, gfc_omp_clauses *clausesa)
stmt = distribute;
}
gfc_add_expr_to_block (&block, stmt);
+ if (clausesa == clausesa_buf && do_free)
+ gfc_trans_omp_free_clausea (clausesa_buf);
return gfc_finish_block (&block);
}
@@ -5613,12 +5665,13 @@ gfc_trans_omp_teams (gfc_code *code, gfc_omp_clauses *clausesa,
gfc_omp_clauses clausesa_buf[GFC_OMP_SPLIT_NUM];
tree stmt;
bool combined = true;
+ bool do_free = false;
gfc_start_block (&block);
if (clausesa == NULL)
{
clausesa = clausesa_buf;
- gfc_split_omp_clauses (code, clausesa);
+ do_free = gfc_split_omp_clauses (code, clausesa);
}
if (flag_openmp)
{
@@ -5655,6 +5708,8 @@ gfc_trans_omp_teams (gfc_code *code, gfc_omp_clauses *clausesa,
OMP_TEAMS_COMBINED (stmt) = 1;
}
gfc_add_expr_to_block (&block, stmt);
+ if (clausesa == clausesa_buf && do_free)
+ gfc_trans_omp_free_clausea (clausesa_buf);
return gfc_finish_block (&block);
}
@@ -5664,9 +5719,10 @@ gfc_trans_omp_target (gfc_code *code)
stmtblock_t block;
gfc_omp_clauses clausesa[GFC_OMP_SPLIT_NUM];
tree stmt, omp_clauses = NULL_TREE;
+ bool do_free = false;
gfc_start_block (&block);
- gfc_split_omp_clauses (code, clausesa);
+ do_free = gfc_split_omp_clauses (code, clausesa);
if (flag_openmp)
omp_clauses
= gfc_trans_omp_clauses (&block, &clausesa[GFC_OMP_SPLIT_TARGET],
@@ -5760,6 +5816,8 @@ gfc_trans_omp_target (gfc_code *code)
cfun->has_omp_target = true;
}
gfc_add_expr_to_block (&block, stmt);
+ if (do_free)
+ gfc_trans_omp_free_clausea (clausesa);
return gfc_finish_block (&block);
}
@@ -5769,9 +5827,10 @@ gfc_trans_omp_taskloop (gfc_code *code)
stmtblock_t block;
gfc_omp_clauses clausesa[GFC_OMP_SPLIT_NUM];
tree stmt, omp_clauses = NULL_TREE;
+ bool do_free = false;
gfc_start_block (&block);
- gfc_split_omp_clauses (code, clausesa);
+ do_free = gfc_split_omp_clauses (code, clausesa);
if (flag_openmp)
omp_clauses
= gfc_trans_omp_clauses (&block, &clausesa[GFC_OMP_SPLIT_TASKLOOP],
@@ -5802,6 +5861,8 @@ gfc_trans_omp_taskloop (gfc_code *code)
stmt = taskloop;
}
gfc_add_expr_to_block (&block, stmt);
+ if (do_free)
+ gfc_trans_omp_free_clausea (clausesa);
return gfc_finish_block (&block);
}
@@ -146,5 +146,6 @@ end subroutine test
! { dg-final { scan-tree-dump-times "acc loop private.i. private.j. tile.2, 3" 2 "gimple" } }
! { dg-final { scan-tree-dump-times "acc loop private.i. independent" 2 "gimple" } }
! { dg-final { scan-tree-dump-times "private.z" 2 "gimple" } }
-! { dg-final { scan-tree-dump-times "omp target oacc_\[^ \]+ map.tofrom:y" 2 "gimple" } }
-! { dg-final { scan-tree-dump-times "acc loop private.i. reduction..:y." 2 "gimple" } }
+! { dg-final { scan-tree-dump-times "omp target oacc_parallel reduction..:y. map.tofrom:y" 1 "gimple" } }
+! { dg-final { scan-tree-dump-times "omp target oacc_kernels map.tofrom:y" 1 "gimple" } }
+! { dg-final { scan-tree-dump-times "acc loop reduction..:y. private.i." 2 "gimple" } }
@@ -16,7 +16,7 @@ subroutine foo ()
end subroutine
! { dg-final { scan-tree-dump-times "target oacc_parallel reduction..:a. map.tofrom.a." 1 "gimple" } }
-! { dg-final { scan-tree-dump-times "acc loop private.p. reduction..:a." 1 "gimple" } }
+! { dg-final { scan-tree-dump-times "acc loop reduction..:a. private.p." 1 "gimple" } }
! { dg-final { scan-tree-dump-times "target oacc_kernels map.force_tofrom:a .len: 4.." 1 "gimple" } }
-! { dg-final { scan-tree-dump-times "acc loop private.k. reduction..:a." 1 "gimple" } }
+! { dg-final { scan-tree-dump-times "acc loop reduction..:a. private.k." 1 "gimple" } }
@@ -49,9 +49,9 @@ subroutine bar(n, m, u)
end
-! { dg-final { scan-tree-dump-times "#pragma omp teams firstprivate\\(a1\\) firstprivate\\(b1\\) shared\\(u\\) default\\(none\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "#pragma omp teams shared\\(u\\) firstprivate\\(a1\\) firstprivate\\(b1\\) default\\(none\\)" 1 "original" } }
! { dg-final { scan-tree-dump-times "#pragma omp distribute lastprivate\\(d1\\)" 1 "original" } }
-! { dg-final { scan-tree-dump-times "#pragma omp parallel firstprivate\\(a1\\) firstprivate\\(b1\\) lastprivate\\(d1\\) shared\\(u\\) default\\(none\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "#pragma omp parallel shared\\(u\\) firstprivate\\(a1\\) firstprivate\\(b1\\) lastprivate\\(d1\\) default\\(none\\)" 1 "original" } }
! { dg-final { scan-tree-dump-times "#pragma omp for nowait" 1 "original" } }
! { dg-final { scan-tree-dump-times "#pragma omp simd lastprivate\\(d1\\)" 1 "original" } }
@@ -155,9 +155,9 @@ end
! { dg-final { scan-tree-dump-times "#pragma omp for reduction\\(inscan,\\\+:a\\)" 1 "original" } }
! { dg-final { scan-tree-dump-times "#pragma omp for reduction\\(task,\\\+:a\\)" 1 "original" } }
! { dg-final { scan-tree-dump-times "#pragma omp parallel\[\n\r\]" 8 "original" } }
-! { dg-final { scan-tree-dump-times "#pragma omp parallel private\\(i\\) reduction\\(\\\+:a\\)" 2 "original" } }
-! { dg-final { scan-tree-dump-times "#pragma omp parallel private\\(i\\) reduction\\(inscan,\\\+:a\\)" 1 "original" } }
-! { dg-final { scan-tree-dump-times "#pragma omp parallel private\\(i\\) reduction\\(task,\\\+:a\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "#pragma omp parallel reduction\\(\\\+:a\\) private\\(i\\)" 2 "original" } }
+! { dg-final { scan-tree-dump-times "#pragma omp parallel reduction\\(inscan,\\\+:a\\) private\\(i\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "#pragma omp parallel reduction\\(task,\\\+:a\\) private\\(i\\)" 1 "original" } }
! { dg-final { scan-tree-dump-times "#pragma omp section\[\n\r\]" 4 "original" } }
! { dg-final { scan-tree-dump-times "#pragma omp sections reduction\\(\\\+:a\\)" 2 "original" } }
! { dg-final { scan-tree-dump-times "#pragma omp sections reduction\\(inscan,\\\+:a\\)" 1 "original" } }
Hi all, as discussed the other day (I think via IRC or in a patch review), omp_list_clauses did grow quite a bit: it has 26 entries and I am about to add two more. This variable is used as: typedef struct gfc_omp_clauses { ... gfc_omp_namelist *lists[OMP_LIST_NUM]; with sizeof(gfc_omp_namelist) = 5*sizeof(void*) + sizeof(locus); This patch replaces it with a linked list. I am not really sure the new version is that readable and whether we move into the right direction or not. Comments? Tobias PS: If the direction is sensible, a very careful reading of the patch is probably useful. ----------------- Mentor Graphics (Deutschland) GmbH, Arnulfstraße 201, 80634 München / Germany Registergericht München HRB 106955, Geschäftsführer: Thomas Heurung, Alexander Walter