Skip to content

R
riscv-gcc-1
Commit 0f66751a by Jakub Jelinek Committed by Jakub Jelinek
Options

openmp.c (gfc_match_omp_clauses): Restructuralize... 

	* openmp.c (gfc_match_omp_clauses): Restructuralize, so that clause
	parsing is done in a big switch based on gfc_peek_ascii_char and
	individual clauses under their first letters are sorted too.

From-SVN: r235922
parent 568bac8c
Showing with 447 additions and 376 deletions
gcc/fortran/ChangeLog
2016-05-05 Jakub Jelinek <jakub@redhat.com>
* openmp.c (gfc_match_omp_clauses): Restructuralize, so that clause
parsing is done in a big switch based on gfc_peek_ascii_char and
individual clauses under their first letters are sorted too.
2016-05-02 Michael Meissner <meissner@linux.vnet.ibm.com> 2016-05-02 Michael Meissner <meissner@linux.vnet.ibm.com>
* trans-types.c (gfc_build_complex_type): * trans-types.c (gfc_build_complex_type):
......
gcc/fortran/openmp.c
...@@ -640,92 +640,94 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask, ...@@ -640,92 +640,94 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask,
needs_space = false; needs_space = false;
first = false; first = false;
gfc_gobble_whitespace (); gfc_gobble_whitespace ();
if ((mask & OMP_CLAUSE_ASYNC) && !c->async) bool end_colon;
if (gfc_match ("async") == MATCH_YES) gfc_omp_namelist **head;
old_loc = gfc_current_locus;
char pc = gfc_peek_ascii_char ();
switch (pc)
{
case 'a':
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_expr *alignment = NULL;
gfc_omp_namelist *n;
if (end_colon && gfc_match (" %e )", &alignment) != MATCH_YES)
{
gfc_free_omp_namelist (*head);
gfc_current_locus = old_loc;
*head = NULL;
break;
}
for (n = *head; n; n = n->next)
if (n->next && alignment)
n->expr = gfc_copy_expr (alignment);
else
n->expr = alignment;
continue;
}
if ((mask & OMP_CLAUSE_ASYNC)
&& !c->async
&& gfc_match ("async") == MATCH_YES)
{ {
c->async = true; c->async = true;
needs_space = false; needs_space = false;
if (gfc_match (" ( %e )", &c->async_expr) != MATCH_YES) if (gfc_match (" ( %e )", &c->async_expr) != MATCH_YES)
{ {
c->async_expr = gfc_get_constant_expr (BT_INTEGER, c->async_expr
= gfc_get_constant_expr (BT_INTEGER,
gfc_default_integer_kind, gfc_default_integer_kind,
&gfc_current_locus); &gfc_current_locus);
mpz_set_si (c->async_expr->value.integer, GOMP_ASYNC_NOVAL); mpz_set_si (c->async_expr->value.integer, GOMP_ASYNC_NOVAL);
} }
continue; continue;
} }
if ((mask & OMP_CLAUSE_GANG) && !c->gang) if ((mask & OMP_CLAUSE_AUTO)
if (gfc_match ("gang") == MATCH_YES) && !c->par_auto
&& gfc_match ("auto") == MATCH_YES)
{ {
c->gang = true; c->par_auto = true;
if (match_oacc_clause_gang(c) == MATCH_YES)
needs_space = false;
else
needs_space = true; needs_space = true;
continue; continue;
} }
if ((mask & OMP_CLAUSE_WORKER) && !c->worker) break;
if (gfc_match ("worker") == MATCH_YES) case 'c':
if ((mask & OMP_CLAUSE_COLLAPSE)
&& !c->collapse)
{ {
c->worker = true; gfc_expr *cexpr = NULL;
if (gfc_match (" ( num : %e )", &c->worker_expr) == MATCH_YES match m = gfc_match ("collapse ( %e )", &cexpr);
|| gfc_match (" ( %e )", &c->worker_expr) == MATCH_YES)
needs_space = false; if (m == MATCH_YES)
else {
needs_space = true; int collapse;
continue; const char *p = gfc_extract_int (cexpr, &collapse);
if (p)
{
gfc_error_now (p);
collapse = 1;
} }
if ((mask & OMP_CLAUSE_VECTOR_LENGTH) && c->vector_length_expr == NULL else if (collapse <= 0)
&& gfc_match ("vector_length ( %e )", &c->vector_length_expr)
== MATCH_YES)
continue;
if ((mask & OMP_CLAUSE_VECTOR) && !c->vector)
if (gfc_match ("vector") == MATCH_YES)
{ {
c->vector = true; gfc_error_now ("COLLAPSE clause argument not"
if (gfc_match (" ( length : %e )", &c->vector_expr) == MATCH_YES " constant positive integer at %C");
|| gfc_match (" ( %e )", &c->vector_expr) == MATCH_YES) collapse = 1;
needs_space = false;
else
needs_space = true;
continue;
} }
if ((mask & OMP_CLAUSE_IF) && c->if_expr == NULL c->collapse = collapse;
&& gfc_match ("if ( %e )", &c->if_expr) == MATCH_YES) gfc_free_expr (cexpr);
continue;
if ((mask & OMP_CLAUSE_FINAL) && c->final_expr == NULL
&& gfc_match ("final ( %e )", &c->final_expr) == MATCH_YES)
continue;
if ((mask & OMP_CLAUSE_NUM_THREADS) && c->num_threads == NULL
&& gfc_match ("num_threads ( %e )", &c->num_threads) == MATCH_YES)
continue;
if ((mask & OMP_CLAUSE_PRIVATE)
&& gfc_match_omp_variable_list ("private (",
&c->lists[OMP_LIST_PRIVATE], true)
== MATCH_YES)
continue;
if ((mask & OMP_CLAUSE_FIRSTPRIVATE)
&& gfc_match_omp_variable_list ("firstprivate (",
&c->lists[OMP_LIST_FIRSTPRIVATE],
true)
== MATCH_YES)
continue;
if ((mask & OMP_CLAUSE_LASTPRIVATE)
&& gfc_match_omp_variable_list ("lastprivate (",
&c->lists[OMP_LIST_LASTPRIVATE],
true)
== MATCH_YES)
continue;
if ((mask & OMP_CLAUSE_COPYPRIVATE)
&& gfc_match_omp_variable_list ("copyprivate (",
&c->lists[OMP_LIST_COPYPRIVATE],
true)
== MATCH_YES)
continue; continue;
if ((mask & OMP_CLAUSE_SHARED) }
&& gfc_match_omp_variable_list ("shared (", }
&c->lists[OMP_LIST_SHARED], true) if ((mask & OMP_CLAUSE_COPY)
== MATCH_YES) && gfc_match ("copy ( ") == MATCH_YES
&& gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
OMP_MAP_FORCE_TOFROM))
continue; continue;
if (mask & OMP_CLAUSE_COPYIN) if (mask & OMP_CLAUSE_COPYIN)
{ {
...@@ -741,85 +743,88 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask, ...@@ -741,85 +743,88 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask,
true) == MATCH_YES) true) == MATCH_YES)
continue; continue;
} }
if ((mask & OMP_CLAUSE_NUM_GANGS) && c->num_gangs_expr == NULL
&& gfc_match ("num_gangs ( %e )", &c->num_gangs_expr) == MATCH_YES)
continue;
if ((mask & OMP_CLAUSE_NUM_WORKERS) && c->num_workers_expr == NULL
&& gfc_match ("num_workers ( %e )", &c->num_workers_expr)
== MATCH_YES)
continue;
if ((mask & OMP_CLAUSE_COPY)
&& gfc_match ("copy ( ") == MATCH_YES
&& gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
OMP_MAP_FORCE_TOFROM))
continue;
if ((mask & OMP_CLAUSE_COPYOUT) if ((mask & OMP_CLAUSE_COPYOUT)
&& gfc_match ("copyout ( ") == MATCH_YES && gfc_match ("copyout ( ") == MATCH_YES
&& gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP], && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
OMP_MAP_FORCE_FROM)) OMP_MAP_FORCE_FROM))
continue; continue;
if ((mask & OMP_CLAUSE_COPYPRIVATE)
&& gfc_match_omp_variable_list ("copyprivate (",
&c->lists[OMP_LIST_COPYPRIVATE],
true) == MATCH_YES)
continue;
if ((mask & OMP_CLAUSE_CREATE) if ((mask & OMP_CLAUSE_CREATE)
&& gfc_match ("create ( ") == MATCH_YES && gfc_match ("create ( ") == MATCH_YES
&& gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP], && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
OMP_MAP_FORCE_ALLOC)) OMP_MAP_FORCE_ALLOC))
continue; continue;
break;
case 'd':
if ((mask & OMP_CLAUSE_DELETE) if ((mask & OMP_CLAUSE_DELETE)
&& gfc_match ("delete ( ") == MATCH_YES && gfc_match ("delete ( ") == MATCH_YES
&& gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP], && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
OMP_MAP_DELETE)) OMP_MAP_DELETE))
continue; continue;
if ((mask & OMP_CLAUSE_PRESENT) if ((mask & OMP_CLAUSE_DEFAULT)
&& gfc_match ("present ( ") == MATCH_YES && c->default_sharing == OMP_DEFAULT_UNKNOWN)
&& gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP], {
OMP_MAP_FORCE_PRESENT)) if (gfc_match ("default ( none )") == MATCH_YES)
continue; c->default_sharing = OMP_DEFAULT_NONE;
if ((mask & OMP_CLAUSE_PRESENT_OR_COPY) else if (openacc)
&& gfc_match ("present_or_copy ( ") == MATCH_YES /* c->default_sharing = OMP_DEFAULT_UNKNOWN */;
&& gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP], else if (gfc_match ("default ( shared )") == MATCH_YES)
OMP_MAP_TOFROM)) c->default_sharing = OMP_DEFAULT_SHARED;
continue; else if (gfc_match ("default ( private )") == MATCH_YES)
if ((mask & OMP_CLAUSE_PRESENT_OR_COPY) c->default_sharing = OMP_DEFAULT_PRIVATE;
&& gfc_match ("pcopy ( ") == MATCH_YES else if (gfc_match ("default ( firstprivate )") == MATCH_YES)
&& gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP], c->default_sharing = OMP_DEFAULT_FIRSTPRIVATE;
OMP_MAP_TOFROM)) if (c->default_sharing != OMP_DEFAULT_UNKNOWN)
continue;
if ((mask & OMP_CLAUSE_PRESENT_OR_COPYIN)
&& gfc_match ("present_or_copyin ( ") == MATCH_YES
&& gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
OMP_MAP_TO))
continue;
if ((mask & OMP_CLAUSE_PRESENT_OR_COPYIN)
&& gfc_match ("pcopyin ( ") == MATCH_YES
&& gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
OMP_MAP_TO))
continue;
if ((mask & OMP_CLAUSE_PRESENT_OR_COPYOUT)
&& gfc_match ("present_or_copyout ( ") == MATCH_YES
&& gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
OMP_MAP_FROM))
continue; continue;
if ((mask & OMP_CLAUSE_PRESENT_OR_COPYOUT) }
&& gfc_match ("pcopyout ( ") == MATCH_YES if ((mask & OMP_CLAUSE_DEPEND)
&& gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP], && gfc_match ("depend ( ") == MATCH_YES)
OMP_MAP_FROM)) {
match m = MATCH_YES;
gfc_omp_depend_op depend_op = OMP_DEPEND_OUT;
if (gfc_match ("inout") == MATCH_YES)
depend_op = OMP_DEPEND_INOUT;
else if (gfc_match ("in") == MATCH_YES)
depend_op = OMP_DEPEND_IN;
else if (gfc_match ("out") == MATCH_YES)
depend_op = OMP_DEPEND_OUT;
else
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_omp_namelist *n;
for (n = *head; n; n = n->next)
n->u.depend_op = depend_op;
continue; continue;
if ((mask & OMP_CLAUSE_PRESENT_OR_CREATE) }
&& gfc_match ("present_or_create ( ") == MATCH_YES else
&& gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP], gfc_current_locus = old_loc;
OMP_MAP_ALLOC)) }
if ((mask & OMP_CLAUSE_DEVICE)
&& c->device == NULL
&& gfc_match ("device ( %e )", &c->device) == MATCH_YES)
continue; continue;
if ((mask & OMP_CLAUSE_PRESENT_OR_CREATE) if ((mask & OMP_CLAUSE_OACC_DEVICE)
&& gfc_match ("pcreate ( ") == MATCH_YES && gfc_match ("device ( ") == MATCH_YES
&& gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP], && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
OMP_MAP_ALLOC)) OMP_MAP_FORCE_TO))
continue; continue;
if ((mask & OMP_CLAUSE_DEVICEPTR) if ((mask & OMP_CLAUSE_DEVICEPTR)
&& gfc_match ("deviceptr ( ") == MATCH_YES) && gfc_match ("deviceptr ( ") == MATCH_YES)
{ {
gfc_omp_namelist **list = &c->lists[OMP_LIST_MAP]; gfc_omp_namelist **list = &c->lists[OMP_LIST_MAP];
gfc_omp_namelist **head = NULL; gfc_omp_namelist **head = NULL;
if (gfc_match_omp_variable_list ("", list, true, NULL, &head, false) if (gfc_match_omp_variable_list ("", list, true, NULL,
== MATCH_YES) &head, false) == MATCH_YES)
{ {
gfc_omp_namelist *n; gfc_omp_namelist *n;
for (n = *head; n; n = n->next) for (n = *head; n; n = n->next)
...@@ -827,66 +832,262 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask, ...@@ -827,66 +832,262 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask,
continue; continue;
} }
} }
if ((mask & OMP_CLAUSE_USE_DEVICE)
&& gfc_match_omp_variable_list ("use_device (",
&c->lists[OMP_LIST_USE_DEVICE], true)
== MATCH_YES)
continue;
if ((mask & OMP_CLAUSE_DEVICE_RESIDENT) if ((mask & OMP_CLAUSE_DEVICE_RESIDENT)
&& gfc_match_omp_variable_list ("device_resident (", && gfc_match_omp_variable_list
&c->lists[OMP_LIST_DEVICE_RESIDENT], ("device_resident (",
true) &c->lists[OMP_LIST_DEVICE_RESIDENT], true) == MATCH_YES)
== MATCH_YES)
continue; continue;
if ((mask & OMP_CLAUSE_LINK) if ((mask & OMP_CLAUSE_DIST_SCHEDULE)
&& gfc_match_oacc_clause_link ("link (", && c->dist_sched_kind == OMP_SCHED_NONE
&c->lists[OMP_LIST_LINK]) && gfc_match ("dist_schedule ( static") == MATCH_YES)
== MATCH_YES) {
match m = MATCH_NO;
c->dist_sched_kind = OMP_SCHED_STATIC;
m = gfc_match (" , %e )", &c->dist_chunk_size);
if (m != MATCH_YES)
m = gfc_match_char (')');
if (m != MATCH_YES)
{
c->dist_sched_kind = OMP_SCHED_NONE;
gfc_current_locus = old_loc;
}
else
continue; continue;
if ((mask & OMP_CLAUSE_OACC_DEVICE) }
&& gfc_match ("device ( ") == MATCH_YES break;
&& gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP], case 'f':
OMP_MAP_FORCE_TO)) if ((mask & OMP_CLAUSE_FINAL)
&& c->final_expr == NULL
&& gfc_match ("final ( %e )", &c->final_expr) == MATCH_YES)
continue;
if ((mask & OMP_CLAUSE_FIRSTPRIVATE)
&& gfc_match_omp_variable_list ("firstprivate (",
&c->lists[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)
continue;
break;
case 'g':
if ((mask & OMP_CLAUSE_GANG)
&& !c->gang
&& gfc_match ("gang") == MATCH_YES)
{
c->gang = true;
if (match_oacc_clause_gang(c) == MATCH_YES)
needs_space = false;
else
needs_space = true;
continue; continue;
}
break;
case 'h':
if ((mask & OMP_CLAUSE_HOST_SELF) if ((mask & OMP_CLAUSE_HOST_SELF)
&& (gfc_match ("host ( ") == MATCH_YES && gfc_match ("host ( ") == MATCH_YES
|| gfc_match ("self ( ") == MATCH_YES)
&& gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP], && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
OMP_MAP_FORCE_FROM)) OMP_MAP_FORCE_FROM))
continue; continue;
if ((mask & OMP_CLAUSE_TILE) break;
&& !c->tile_list case 'i':
&& match_oacc_expr_list ("tile (", &c->tile_list, true) == MATCH_YES) if ((mask & OMP_CLAUSE_IF)
&& c->if_expr == NULL
&& gfc_match ("if ( %e )", &c->if_expr) == MATCH_YES)
continue; continue;
if ((mask & OMP_CLAUSE_SEQ) && !c->seq if ((mask & OMP_CLAUSE_INBRANCH)
&& gfc_match ("seq") == MATCH_YES) && !c->inbranch
&& !c->notinbranch
&& gfc_match ("inbranch") == MATCH_YES)
{ {
c->seq = true; c->inbranch = needs_space = true;
needs_space = true;
continue; continue;
} }
if ((mask & OMP_CLAUSE_INDEPENDENT) && !c->independent if ((mask & OMP_CLAUSE_INDEPENDENT)
&& !c->independent
&& gfc_match ("independent") == MATCH_YES) && gfc_match ("independent") == MATCH_YES)
{ {
c->independent = true; c->independent = true;
needs_space = true; needs_space = true;
continue; continue;
} }
if ((mask & OMP_CLAUSE_AUTO) && !c->par_auto break;
&& gfc_match ("auto") == MATCH_YES) case 'l':
if ((mask & OMP_CLAUSE_LASTPRIVATE)
&& gfc_match_omp_variable_list ("lastprivate (",
&c->lists[OMP_LIST_LASTPRIVATE],
true) == MATCH_YES)
continue;
end_colon = false;
head = NULL;
if ((mask & OMP_CLAUSE_LINEAR)
&& gfc_match_omp_variable_list ("linear (",
&c->lists[OMP_LIST_LINEAR],
false, &end_colon,
&head) == MATCH_YES)
{ {
c->par_auto = true; gfc_expr *step = NULL;
needs_space = true;
if (end_colon && gfc_match (" %e )", &step) != MATCH_YES)
{
gfc_free_omp_namelist (*head);
gfc_current_locus = old_loc;
*head = NULL;
break;
}
else if (!end_colon)
{
step = gfc_get_constant_expr (BT_INTEGER,
gfc_default_integer_kind,
&old_loc);
mpz_set_si (step->value.integer, 1);
}
(*head)->expr = step;
continue;
}
if ((mask & OMP_CLAUSE_LINK)
&& (gfc_match_oacc_clause_link ("link (",
&c->lists[OMP_LIST_LINK])
== MATCH_YES))
continue;
break;
case 'm':
if ((mask & OMP_CLAUSE_MAP)
&& gfc_match ("map ( ") == MATCH_YES)
{
gfc_omp_map_op map_op = OMP_MAP_TOFROM;
if (gfc_match ("alloc : ") == MATCH_YES)
map_op = OMP_MAP_ALLOC;
else if (gfc_match ("tofrom : ") == MATCH_YES)
map_op = OMP_MAP_TOFROM;
else if (gfc_match ("to : ") == MATCH_YES)
map_op = OMP_MAP_TO;
else if (gfc_match ("from : ") == MATCH_YES)
map_op = OMP_MAP_FROM;
head = NULL;
if (gfc_match_omp_variable_list ("", &c->lists[OMP_LIST_MAP],
false, NULL, &head,
true) == MATCH_YES)
{
gfc_omp_namelist *n;
for (n = *head; n; n = n->next)
n->u.map_op = map_op;
continue;
}
else
gfc_current_locus = old_loc;
}
if ((mask & OMP_CLAUSE_MERGEABLE) && !c->mergeable
&& gfc_match ("mergeable") == MATCH_YES)
{
c->mergeable = needs_space = true;
continue;
}
break;
case 'n':
if ((mask & OMP_CLAUSE_NOTINBRANCH)
&& !c->notinbranch
&& !c->inbranch
&& gfc_match ("notinbranch") == MATCH_YES)
{
c->notinbranch = needs_space = true;
continue;
}
if ((mask & OMP_CLAUSE_NUM_GANGS)
&& c->num_gangs_expr == NULL
&& gfc_match ("num_gangs ( %e )",
&c->num_gangs_expr) == MATCH_YES)
continue;
if ((mask & OMP_CLAUSE_NUM_TEAMS)
&& c->num_teams == NULL
&& gfc_match ("num_teams ( %e )", &c->num_teams) == MATCH_YES)
continue;
if ((mask & OMP_CLAUSE_NUM_THREADS)
&& c->num_threads == NULL
&& (gfc_match ("num_threads ( %e )", &c->num_threads)
== MATCH_YES))
continue;
if ((mask & OMP_CLAUSE_NUM_WORKERS)
&& c->num_workers_expr == NULL
&& gfc_match ("num_workers ( %e )",
&c->num_workers_expr) == MATCH_YES)
continue;
break;
case 'o':
if ((mask & OMP_CLAUSE_ORDERED)
&& !c->ordered
&& gfc_match ("ordered") == MATCH_YES)
{
c->ordered = needs_space = true;
continue;
}
break;
case 'p':
if ((mask & OMP_CLAUSE_PRESENT_OR_COPY)
&& gfc_match ("pcopy ( ") == MATCH_YES
&& gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
OMP_MAP_TOFROM))
continue;
if ((mask & OMP_CLAUSE_PRESENT_OR_COPYIN)
&& gfc_match ("pcopyin ( ") == MATCH_YES
&& gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
OMP_MAP_TO))
continue;
if ((mask & OMP_CLAUSE_PRESENT_OR_COPYOUT)
&& gfc_match ("pcopyout ( ") == MATCH_YES
&& gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
OMP_MAP_FROM))
continue;
if ((mask & OMP_CLAUSE_PRESENT_OR_CREATE)
&& gfc_match ("pcreate ( ") == MATCH_YES
&& gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
OMP_MAP_ALLOC))
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))
continue;
if ((mask & OMP_CLAUSE_PRESENT_OR_COPY)
&& gfc_match ("present_or_copy ( ") == MATCH_YES
&& gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
OMP_MAP_TOFROM))
continue;
if ((mask & OMP_CLAUSE_PRESENT_OR_COPYIN)
&& gfc_match ("present_or_copyin ( ") == MATCH_YES
&& gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
OMP_MAP_TO))
continue;
if ((mask & OMP_CLAUSE_PRESENT_OR_COPYOUT)
&& gfc_match ("present_or_copyout ( ") == MATCH_YES
&& gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
OMP_MAP_FROM))
continue;
if ((mask & OMP_CLAUSE_PRESENT_OR_CREATE)
&& gfc_match ("present_or_create ( ") == MATCH_YES
&& gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
OMP_MAP_ALLOC))
continue; continue;
} if ((mask & OMP_CLAUSE_PRIVATE)
if ((mask & OMP_CLAUSE_WAIT) && !c->wait && gfc_match_omp_variable_list ("private (",
&& gfc_match ("wait") == MATCH_YES) &c->lists[OMP_LIST_PRIVATE],
true) == MATCH_YES)
continue;
if ((mask & OMP_CLAUSE_PROC_BIND)
&& c->proc_bind == OMP_PROC_BIND_UNKNOWN)
{ {
c->wait = true; if (gfc_match ("proc_bind ( master )") == MATCH_YES)
match_oacc_expr_list (" (", &c->wait_list, false); c->proc_bind = OMP_PROC_BIND_MASTER;
else if (gfc_match ("proc_bind ( spread )") == MATCH_YES)
c->proc_bind = OMP_PROC_BIND_SPREAD;
else if (gfc_match ("proc_bind ( close )") == MATCH_YES)
c->proc_bind = OMP_PROC_BIND_CLOSE;
if (c->proc_bind != OMP_PROC_BIND_UNKNOWN)
continue; continue;
} }
old_loc = gfc_current_locus; break;
case 'r':
if ((mask & OMP_CLAUSE_REDUCTION) if ((mask & OMP_CLAUSE_REDUCTION)
&& gfc_match ("reduction ( ") == MATCH_YES) && gfc_match ("reduction ( ") == MATCH_YES)
{ {
...@@ -907,8 +1108,8 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask, ...@@ -907,8 +1108,8 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask,
else if (gfc_match (".neqv.") == MATCH_YES) else if (gfc_match (".neqv.") == MATCH_YES)
rop = OMP_REDUCTION_NEQV; rop = OMP_REDUCTION_NEQV;
if (rop != OMP_REDUCTION_NONE) if (rop != OMP_REDUCTION_NONE)
snprintf (buffer, sizeof buffer, snprintf (buffer, sizeof buffer, "operator %s",
"operator %s", gfc_op2string ((gfc_intrinsic_op) rop)); gfc_op2string ((gfc_intrinsic_op) rop));
else if (gfc_match_defined_op_name (buffer + 1, 1) == MATCH_YES) else if (gfc_match_defined_op_name (buffer + 1, 1) == MATCH_YES)
{ {
buffer[0] = '.'; buffer[0] = '.';
...@@ -980,8 +1181,8 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask, ...@@ -980,8 +1181,8 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask,
if (gfc_match_omp_variable_list (" :", if (gfc_match_omp_variable_list (" :",
&c->lists[OMP_LIST_REDUCTION], &c->lists[OMP_LIST_REDUCTION],
false, NULL, &head, openacc) false, NULL, &head,
== MATCH_YES) openacc) == MATCH_YES)
{ {
gfc_omp_namelist *n; gfc_omp_namelist *n;
if (rop == OMP_REDUCTION_NONE) if (rop == OMP_REDUCTION_NONE)
...@@ -1007,23 +1208,12 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask, ...@@ -1007,23 +1208,12 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask,
else else
gfc_current_locus = old_loc; gfc_current_locus = old_loc;
} }
if ((mask & OMP_CLAUSE_DEFAULT) break;
&& c->default_sharing == OMP_DEFAULT_UNKNOWN) case 's':
{ if ((mask & OMP_CLAUSE_SAFELEN)
if (gfc_match ("default ( none )") == MATCH_YES) && c->safelen_expr == NULL
c->default_sharing = OMP_DEFAULT_NONE; && gfc_match ("safelen ( %e )", &c->safelen_expr) == MATCH_YES)
else if (openacc)
/* c->default_sharing = OMP_DEFAULT_UNKNOWN */;
else if (gfc_match ("default ( shared )") == MATCH_YES)
c->default_sharing = OMP_DEFAULT_SHARED;
else if (gfc_match ("default ( private )") == MATCH_YES)
c->default_sharing = OMP_DEFAULT_PRIVATE;
else if (gfc_match ("default ( firstprivate )") == MATCH_YES)
c->default_sharing = OMP_DEFAULT_FIRSTPRIVATE;
if (c->default_sharing != OMP_DEFAULT_UNKNOWN)
continue; continue;
}
old_loc = gfc_current_locus;
if ((mask & OMP_CLAUSE_SCHEDULE) if ((mask & OMP_CLAUSE_SCHEDULE)
&& c->sched_kind == OMP_SCHED_NONE && c->sched_kind == OMP_SCHED_NONE
&& gfc_match ("schedule ( ") == MATCH_YES) && gfc_match ("schedule ( ") == MATCH_YES)
...@@ -1054,232 +1244,107 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask, ...@@ -1054,232 +1244,107 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask,
else else
gfc_current_locus = old_loc; gfc_current_locus = old_loc;
} }
if ((mask & OMP_CLAUSE_ORDERED) && !c->ordered if ((mask & OMP_CLAUSE_HOST_SELF)
&& gfc_match ("ordered") == MATCH_YES) && gfc_match ("self ( ") == MATCH_YES
{ && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
c->ordered = needs_space = true; OMP_MAP_FORCE_FROM))
continue;
}
if ((mask & OMP_CLAUSE_UNTIED) && !c->untied
&& gfc_match ("untied") == MATCH_YES)
{
c->untied = needs_space = true;
continue;
}
if ((mask & OMP_CLAUSE_MERGEABLE) && !c->mergeable
&& gfc_match ("mergeable") == MATCH_YES)
{
c->mergeable = needs_space = true;
continue; continue;
} if ((mask & OMP_CLAUSE_SEQ)
if ((mask & OMP_CLAUSE_COLLAPSE) && !c->collapse) && !c->seq
{ && gfc_match ("seq") == MATCH_YES)
gfc_expr *cexpr = NULL;
match m = gfc_match ("collapse ( %e )", &cexpr);
if (m == MATCH_YES)
{
int collapse;
const char *p = gfc_extract_int (cexpr, &collapse);
if (p)
{
gfc_error_now (p);
collapse = 1;
}
else if (collapse <= 0)
{ {
gfc_error_now ("COLLAPSE clause argument not" c->seq = true;
" constant positive integer at %C"); needs_space = true;
collapse = 1;
}
c->collapse = collapse;
gfc_free_expr (cexpr);
continue; continue;
} }
} if ((mask & OMP_CLAUSE_SHARED)
if ((mask & OMP_CLAUSE_INBRANCH) && !c->inbranch && !c->notinbranch && gfc_match_omp_variable_list ("shared (",
&& gfc_match ("inbranch") == MATCH_YES) &c->lists[OMP_LIST_SHARED],
{ true) == MATCH_YES)
c->inbranch = needs_space = true;
continue; continue;
} if ((mask & OMP_CLAUSE_SIMDLEN)
if ((mask & OMP_CLAUSE_NOTINBRANCH) && !c->notinbranch && !c->inbranch && c->simdlen_expr == NULL
&& gfc_match ("notinbranch") == MATCH_YES) && gfc_match ("simdlen ( %e )", &c->simdlen_expr) == MATCH_YES)
{
c->notinbranch = needs_space = true;
continue; continue;
} break;
if ((mask & OMP_CLAUSE_PROC_BIND) case 't':
&& c->proc_bind == OMP_PROC_BIND_UNKNOWN) if ((mask & OMP_CLAUSE_THREAD_LIMIT)
{ && c->thread_limit == NULL
if (gfc_match ("proc_bind ( master )") == MATCH_YES) && gfc_match ("thread_limit ( %e )",
c->proc_bind = OMP_PROC_BIND_MASTER; &c->thread_limit) == MATCH_YES)
else if (gfc_match ("proc_bind ( spread )") == MATCH_YES)
c->proc_bind = OMP_PROC_BIND_SPREAD;
else if (gfc_match ("proc_bind ( close )") == MATCH_YES)
c->proc_bind = OMP_PROC_BIND_CLOSE;
if (c->proc_bind != OMP_PROC_BIND_UNKNOWN)
continue; continue;
} if ((mask & OMP_CLAUSE_TILE)
if ((mask & OMP_CLAUSE_SAFELEN) && c->safelen_expr == NULL && !c->tile_list
&& gfc_match ("safelen ( %e )", &c->safelen_expr) == MATCH_YES) && match_oacc_expr_list ("tile (", &c->tile_list,
true) == MATCH_YES)
continue; continue;
if ((mask & OMP_CLAUSE_SIMDLEN) && c->simdlen_expr == NULL if ((mask & OMP_CLAUSE_TO)
&& gfc_match ("simdlen ( %e )", &c->simdlen_expr) == MATCH_YES) && gfc_match_omp_variable_list ("to (",
&c->lists[OMP_LIST_TO], false,
NULL, &head, true) == MATCH_YES)
continue; continue;
break;
case 'u':
if ((mask & OMP_CLAUSE_UNIFORM) if ((mask & OMP_CLAUSE_UNIFORM)
&& gfc_match_omp_variable_list ("uniform (", && gfc_match_omp_variable_list ("uniform (",
&c->lists[OMP_LIST_UNIFORM], false) &c->lists[OMP_LIST_UNIFORM],
== MATCH_YES) false) == MATCH_YES)
continue; continue;
bool end_colon = false; if ((mask & OMP_CLAUSE_UNTIED)
gfc_omp_namelist **head = NULL; && !c->untied
old_loc = gfc_current_locus; && gfc_match ("untied") == MATCH_YES)
if ((mask & OMP_CLAUSE_ALIGNED)
&& gfc_match_omp_variable_list ("aligned (",
&c->lists[OMP_LIST_ALIGNED], false,
&end_colon, &head)
== MATCH_YES)
{
gfc_expr *alignment = NULL;
gfc_omp_namelist *n;
if (end_colon
&& gfc_match (" %e )", &alignment) != MATCH_YES)
{ {
gfc_free_omp_namelist (*head); c->untied = needs_space = true;
gfc_current_locus = old_loc;
*head = NULL;
break;
}
for (n = *head; n; n = n->next)
if (n->next && alignment)
n->expr = gfc_copy_expr (alignment);
else
n->expr = alignment;
continue; continue;
} }
end_colon = false; if ((mask & OMP_CLAUSE_USE_DEVICE)
head = NULL; && gfc_match_omp_variable_list ("use_device (",
old_loc = gfc_current_locus; &c->lists[OMP_LIST_USE_DEVICE],
if ((mask & OMP_CLAUSE_LINEAR) true) == MATCH_YES)
&& gfc_match_omp_variable_list ("linear (",
&c->lists[OMP_LIST_LINEAR], false,
&end_colon, &head)
== MATCH_YES)
{
gfc_expr *step = NULL;
if (end_colon
&& gfc_match (" %e )", &step) != MATCH_YES)
{
gfc_free_omp_namelist (*head);
gfc_current_locus = old_loc;
*head = NULL;
break;
}
else if (!end_colon)
{
step = gfc_get_constant_expr (BT_INTEGER,
gfc_default_integer_kind,
&old_loc);
mpz_set_si (step->value.integer, 1);
}
(*head)->expr = step;
continue; continue;
} break;
if ((mask & OMP_CLAUSE_DEPEND) case 'v':
&& gfc_match ("depend ( ") == MATCH_YES) if ((mask & OMP_CLAUSE_VECTOR)
&& !c->vector
&& gfc_match ("vector") == MATCH_YES)
{ {
match m = MATCH_YES; c->vector = true;
gfc_omp_depend_op depend_op = OMP_DEPEND_OUT; if (gfc_match (" ( length : %e )", &c->vector_expr) == MATCH_YES
if (gfc_match ("inout") == MATCH_YES) || gfc_match (" ( %e )", &c->vector_expr) == MATCH_YES)
depend_op = OMP_DEPEND_INOUT; needs_space = false;
else if (gfc_match ("in") == MATCH_YES)
depend_op = OMP_DEPEND_IN;
else if (gfc_match ("out") == MATCH_YES)
depend_op = OMP_DEPEND_OUT;
else else
m = MATCH_NO; needs_space = true;
head = NULL;
if (m == MATCH_YES
&& gfc_match_omp_variable_list (" : ",
&c->lists[OMP_LIST_DEPEND],
false, NULL, &head, true)
== MATCH_YES)
{
gfc_omp_namelist *n;
for (n = *head; n; n = n->next)
n->u.depend_op = depend_op;
continue; continue;
} }
else if ((mask & OMP_CLAUSE_VECTOR_LENGTH)
gfc_current_locus = old_loc; && c->vector_length_expr == NULL
} && (gfc_match ("vector_length ( %e )", &c->vector_length_expr)
if ((mask & OMP_CLAUSE_DIST_SCHEDULE) == MATCH_YES))
&& c->dist_sched_kind == OMP_SCHED_NONE continue;
&& gfc_match ("dist_schedule ( static") == MATCH_YES) break;
{ case 'w':
match m = MATCH_NO; if ((mask & OMP_CLAUSE_WAIT)
c->dist_sched_kind = OMP_SCHED_STATIC; && !c->wait
m = gfc_match (" , %e )", &c->dist_chunk_size); && gfc_match ("wait") == MATCH_YES)
if (m != MATCH_YES)
m = gfc_match_char (')');
if (m != MATCH_YES)
{ {
c->dist_sched_kind = OMP_SCHED_NONE; c->wait = true;
gfc_current_locus = old_loc; match_oacc_expr_list (" (", &c->wait_list, false);
}
else
continue; continue;
} }
if ((mask & OMP_CLAUSE_NUM_TEAMS) && c->num_teams == NULL if ((mask & OMP_CLAUSE_WORKER)
&& gfc_match ("num_teams ( %e )", &c->num_teams) == MATCH_YES) && !c->worker
continue; && gfc_match ("worker") == MATCH_YES)
if ((mask & OMP_CLAUSE_DEVICE) && c->device == NULL
&& gfc_match ("device ( %e )", &c->device) == MATCH_YES)
continue;
if ((mask & OMP_CLAUSE_THREAD_LIMIT) && c->thread_limit == NULL
&& gfc_match ("thread_limit ( %e )", &c->thread_limit) == MATCH_YES)
continue;
if ((mask & OMP_CLAUSE_MAP)
&& gfc_match ("map ( ") == MATCH_YES)
{
gfc_omp_map_op map_op = OMP_MAP_TOFROM;
if (gfc_match ("alloc : ") == MATCH_YES)
map_op = OMP_MAP_ALLOC;
else if (gfc_match ("tofrom : ") == MATCH_YES)
map_op = OMP_MAP_TOFROM;
else if (gfc_match ("to : ") == MATCH_YES)
map_op = OMP_MAP_TO;
else if (gfc_match ("from : ") == MATCH_YES)
map_op = OMP_MAP_FROM;
head = NULL;
if (gfc_match_omp_variable_list ("", &c->lists[OMP_LIST_MAP],
false, NULL, &head, true)
== MATCH_YES)
{ {
gfc_omp_namelist *n; c->worker = true;
for (n = *head; n; n = n->next) if (gfc_match (" ( num : %e )", &c->worker_expr) == MATCH_YES
n->u.map_op = map_op; || gfc_match (" ( %e )", &c->worker_expr) == MATCH_YES)
needs_space = false;
else
needs_space = true;
continue; continue;
} }
else break;
gfc_current_locus = old_loc;
} }
if ((mask & OMP_CLAUSE_TO)
&& gfc_match_omp_variable_list ("to (",
&c->lists[OMP_LIST_TO], false,
NULL, &head, 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)
continue;
break; break;
} }
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment