2018-06-19 Chung-Lin Tang Thomas Schwinge Cesar Philippidis gcc/fortran/ * gfortran.h (gfc_omp_clauses): Add unsigned if_present, finalize bitfields. * openmp.c (enum omp_mask2): Remove OMP_CLAUSE_PRESENT_OR_*. Add OMP_CLAUSE_{IF_PRESENT,FINALIZE}. (gfc_match_omp_clauses): Update handling of copy, copyin, copyout, create, deviceptr, present_of_*. Add support for finalize and if_present. (OACC_PARALLEL_CLAUSES): Remove PRESENT_OR_* clauses. (OACC_KERNELS_CLAUSES): Likewise. (OACC_DATA_CLAUSES): Likewise. (OACC_DECLARE_CLAUSES): Likewise. (OACC_UPDATE_CLAUSES): Add IF_PRESENT clause. (OACC_ENTER_DATA_CLAUSES): Remove PRESENT_OR_* clauses. (OACC_EXIT_DATA_CLAUSES): Add FINALIZE clause. (gfc_match_oacc_declare): Update to OpenACC 2.5 semantics. * trans-openmp.c (gfc_trans_omp_clauses): Add support for IF_PRESENT and FINALIZE. From 5a74cac327d44a6674a608c3fd3b80f2e04d0b47 Mon Sep 17 00:00:00 2001 From: Cesar Philippidis Date: Tue, 19 Jun 2018 09:31:57 -0700 Subject: [PATCH 5/7] fortran front end --- gcc/fortran/gfortran.h | 1 + gcc/fortran/openmp.c | 105 ++++++++++++++++++++----------------- gcc/fortran/trans-openmp.c | 10 ++++ 3 files changed, 67 insertions(+), 49 deletions(-) diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 1d98d2554c7..0b89f8de950 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -1344,6 +1344,7 @@ typedef struct gfc_omp_clauses gfc_expr_list *tile_list; unsigned async:1, gang:1, worker:1, vector:1, seq:1, independent:1; unsigned wait:1, par_auto:1, gang_static:1; + unsigned if_present:1, finalize:1; locus loc; } diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c index 97d6e782373..94a7f7eaa50 100644 --- a/gcc/fortran/openmp.c +++ b/gcc/fortran/openmp.c @@ -796,10 +796,6 @@ enum omp_mask2 OMP_CLAUSE_COPYOUT, OMP_CLAUSE_CREATE, OMP_CLAUSE_PRESENT, - OMP_CLAUSE_PRESENT_OR_COPY, - OMP_CLAUSE_PRESENT_OR_COPYIN, - OMP_CLAUSE_PRESENT_OR_COPYOUT, - OMP_CLAUSE_PRESENT_OR_CREATE, OMP_CLAUSE_DEVICEPTR, OMP_CLAUSE_GANG, OMP_CLAUSE_WORKER, @@ -813,6 +809,8 @@ enum omp_mask2 OMP_CLAUSE_DELETE, OMP_CLAUSE_AUTO, OMP_CLAUSE_TILE, + OMP_CLAUSE_IF_PRESENT, + OMP_CLAUSE_FINALIZE, /* This must come last. */ OMP_MASK2_LAST }; @@ -1041,7 +1039,7 @@ 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_FORCE_TOFROM)) + OMP_MAP_TOFROM)) continue; if (mask & OMP_CLAUSE_COPYIN) { @@ -1049,7 +1047,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, { if (gfc_match ("copyin ( ") == MATCH_YES && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP], - OMP_MAP_FORCE_TO)) + OMP_MAP_TO)) continue; } else if (gfc_match_omp_variable_list ("copyin (", @@ -1060,7 +1058,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, if ((mask & OMP_CLAUSE_COPYOUT) && gfc_match ("copyout ( ") == MATCH_YES && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP], - OMP_MAP_FORCE_FROM)) + OMP_MAP_FROM)) continue; if ((mask & OMP_CLAUSE_COPYPRIVATE) && gfc_match_omp_variable_list ("copyprivate (", @@ -1070,7 +1068,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, if ((mask & OMP_CLAUSE_CREATE) && gfc_match ("create ( ") == MATCH_YES && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP], - OMP_MAP_FORCE_ALLOC)) + OMP_MAP_ALLOC)) continue; break; case 'd': @@ -1106,7 +1104,7 @@ 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_DELETE)) + OMP_MAP_RELEASE)) continue; if ((mask & OMP_CLAUSE_DEPEND) && gfc_match ("depend ( ") == MATCH_YES) @@ -1161,19 +1159,10 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, OMP_MAP_FORCE_TO)) continue; if ((mask & OMP_CLAUSE_DEVICEPTR) - && gfc_match ("deviceptr ( ") == MATCH_YES) - { - gfc_omp_namelist **list = &c->lists[OMP_LIST_MAP]; - gfc_omp_namelist **head = NULL; - if (gfc_match_omp_variable_list ("", list, true, NULL, - &head, false) == MATCH_YES) - { - gfc_omp_namelist *n; - for (n = *head; n; n = n->next) - n->u.map_op = OMP_MAP_FORCE_DEVICEPTR; - continue; - } - } + && gfc_match ("deviceptr ( ") == MATCH_YES + && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP], + OMP_MAP_FORCE_DEVICEPTR)) + continue; if ((mask & OMP_CLAUSE_DEVICE_RESIDENT) && gfc_match_omp_variable_list ("device_resident (", @@ -1202,6 +1191,14 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, && c->final_expr == NULL && gfc_match ("final ( %e )", &c->final_expr) == MATCH_YES) continue; + if ((mask & OMP_CLAUSE_FINALIZE) + && !c->finalize + && gfc_match ("finalize") == MATCH_YES) + { + c->finalize = true; + needs_space = true; + continue; + } if ((mask & OMP_CLAUSE_FIRSTPRIVATE) && gfc_match_omp_variable_list ("firstprivate (", &c->lists[OMP_LIST_FIRSTPRIVATE], @@ -1274,6 +1271,14 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, } gfc_current_locus = old_loc; } + if ((mask & OMP_CLAUSE_IF_PRESENT) + && !c->if_present + && gfc_match ("if_present") == MATCH_YES) + { + c->if_present = true; + needs_space = true; + continue; + } if ((mask & OMP_CLAUSE_INBRANCH) && !c->inbranch && !c->notinbranch @@ -1503,22 +1508,22 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, } break; case 'p': - if ((mask & OMP_CLAUSE_PRESENT_OR_COPY) + if ((mask & OMP_CLAUSE_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) + if ((mask & OMP_CLAUSE_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) + if ((mask & OMP_CLAUSE_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) + if ((mask & OMP_CLAUSE_CREATE) && gfc_match ("pcreate ( ") == MATCH_YES && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP], OMP_MAP_ALLOC)) @@ -1528,22 +1533,22 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP], OMP_MAP_FORCE_PRESENT)) continue; - if ((mask & OMP_CLAUSE_PRESENT_OR_COPY) + 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)) continue; - if ((mask & OMP_CLAUSE_PRESENT_OR_COPYIN) + 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)) continue; - if ((mask & OMP_CLAUSE_PRESENT_OR_COPYOUT) + 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)) continue; - if ((mask & OMP_CLAUSE_PRESENT_OR_CREATE) + 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)) @@ -1925,23 +1930,19 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, (omp_mask (OMP_CLAUSE_IF) | OMP_CLAUSE_ASYNC | OMP_CLAUSE_NUM_GANGS \ | OMP_CLAUSE_NUM_WORKERS | OMP_CLAUSE_VECTOR_LENGTH | OMP_CLAUSE_REDUCTION \ | OMP_CLAUSE_COPY | OMP_CLAUSE_COPYIN | OMP_CLAUSE_COPYOUT \ - | OMP_CLAUSE_CREATE | OMP_CLAUSE_PRESENT | OMP_CLAUSE_PRESENT_OR_COPY \ - | OMP_CLAUSE_PRESENT_OR_COPYIN | OMP_CLAUSE_PRESENT_OR_COPYOUT \ - | OMP_CLAUSE_PRESENT_OR_CREATE | OMP_CLAUSE_DEVICEPTR | OMP_CLAUSE_PRIVATE \ - | OMP_CLAUSE_FIRSTPRIVATE | OMP_CLAUSE_DEFAULT | OMP_CLAUSE_WAIT) + | OMP_CLAUSE_CREATE | OMP_CLAUSE_PRESENT | OMP_CLAUSE_DEVICEPTR \ + | OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE | OMP_CLAUSE_DEFAULT \ + | OMP_CLAUSE_WAIT) #define OACC_KERNELS_CLAUSES \ (omp_mask (OMP_CLAUSE_IF) | OMP_CLAUSE_ASYNC | OMP_CLAUSE_NUM_GANGS \ | OMP_CLAUSE_NUM_WORKERS | OMP_CLAUSE_VECTOR_LENGTH | OMP_CLAUSE_DEVICEPTR \ | OMP_CLAUSE_COPY | OMP_CLAUSE_COPYIN | OMP_CLAUSE_COPYOUT \ - | OMP_CLAUSE_CREATE | OMP_CLAUSE_PRESENT | OMP_CLAUSE_PRESENT_OR_COPY \ - | OMP_CLAUSE_PRESENT_OR_COPYIN | OMP_CLAUSE_PRESENT_OR_COPYOUT \ - | OMP_CLAUSE_PRESENT_OR_CREATE | OMP_CLAUSE_DEFAULT | OMP_CLAUSE_WAIT) + | OMP_CLAUSE_CREATE | OMP_CLAUSE_PRESENT | OMP_CLAUSE_DEFAULT \ + | OMP_CLAUSE_WAIT) #define OACC_DATA_CLAUSES \ (omp_mask (OMP_CLAUSE_IF) | OMP_CLAUSE_DEVICEPTR | OMP_CLAUSE_COPY \ | OMP_CLAUSE_COPYIN | OMP_CLAUSE_COPYOUT | OMP_CLAUSE_CREATE \ - | OMP_CLAUSE_PRESENT | OMP_CLAUSE_PRESENT_OR_COPY \ - | OMP_CLAUSE_PRESENT_OR_COPYIN | OMP_CLAUSE_PRESENT_OR_COPYOUT \ - | OMP_CLAUSE_PRESENT_OR_CREATE) + | OMP_CLAUSE_PRESENT) #define OACC_LOOP_CLAUSES \ (omp_mask (OMP_CLAUSE_COLLAPSE) | OMP_CLAUSE_GANG | OMP_CLAUSE_WORKER \ | OMP_CLAUSE_VECTOR | OMP_CLAUSE_SEQ | OMP_CLAUSE_INDEPENDENT \ @@ -1955,19 +1956,17 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, #define OACC_DECLARE_CLAUSES \ (omp_mask (OMP_CLAUSE_COPY) | OMP_CLAUSE_COPYIN | OMP_CLAUSE_COPYOUT \ | OMP_CLAUSE_CREATE | OMP_CLAUSE_DEVICEPTR | OMP_CLAUSE_DEVICE_RESIDENT \ - | OMP_CLAUSE_PRESENT | OMP_CLAUSE_PRESENT_OR_COPY \ - | OMP_CLAUSE_PRESENT_OR_COPYIN | OMP_CLAUSE_PRESENT_OR_COPYOUT \ - | OMP_CLAUSE_PRESENT_OR_CREATE | OMP_CLAUSE_LINK) + | OMP_CLAUSE_PRESENT \ + | OMP_CLAUSE_LINK) #define OACC_UPDATE_CLAUSES \ (omp_mask (OMP_CLAUSE_IF) | OMP_CLAUSE_ASYNC | OMP_CLAUSE_HOST_SELF \ - | OMP_CLAUSE_DEVICE | OMP_CLAUSE_WAIT) + | OMP_CLAUSE_DEVICE | OMP_CLAUSE_WAIT | OMP_CLAUSE_IF_PRESENT) #define OACC_ENTER_DATA_CLAUSES \ (omp_mask (OMP_CLAUSE_IF) | OMP_CLAUSE_ASYNC | OMP_CLAUSE_WAIT \ - | OMP_CLAUSE_COPYIN | OMP_CLAUSE_CREATE | OMP_CLAUSE_PRESENT_OR_COPYIN \ - | OMP_CLAUSE_PRESENT_OR_CREATE) + | OMP_CLAUSE_COPYIN | OMP_CLAUSE_CREATE) #define OACC_EXIT_DATA_CLAUSES \ (omp_mask (OMP_CLAUSE_IF) | OMP_CLAUSE_ASYNC | OMP_CLAUSE_WAIT \ - | OMP_CLAUSE_COPYOUT | OMP_CLAUSE_DELETE) + | OMP_CLAUSE_COPYOUT | OMP_CLAUSE_DELETE | OMP_CLAUSE_FINALIZE) #define OACC_WAIT_CLAUSES \ omp_mask (OMP_CLAUSE_ASYNC) #define OACC_ROUTINE_CLAUSES \ @@ -2061,8 +2060,7 @@ gfc_match_oacc_declare (void) if (s->ns->proc_name && s->ns->proc_name->attr.proc == PROC_MODULE) { - if (n->u.map_op != OMP_MAP_FORCE_ALLOC - && n->u.map_op != OMP_MAP_FORCE_TO) + if (n->u.map_op != OMP_MAP_ALLOC && n->u.map_op != OMP_MAP_TO) { gfc_error ("Invalid clause in module with !$ACC DECLARE at %L", &where); @@ -2072,6 +2070,13 @@ gfc_match_oacc_declare (void) module_var = true; } + if (ns->proc_name->attr.oacc_function) + { + gfc_error ("Invalid declare in routine with $!ACC DECLARE at %L", + &where); + return MATCH_ERROR; + } + if (s->attr.use_assoc) { gfc_error ("Variable is USE-associated with !$ACC DECLARE at %L", @@ -2090,10 +2095,12 @@ gfc_match_oacc_declare (void) switch (n->u.map_op) { case OMP_MAP_FORCE_ALLOC: + case OMP_MAP_ALLOC: s->attr.oacc_declare_create = 1; break; case OMP_MAP_FORCE_TO: + case OMP_MAP_TO: s->attr.oacc_declare_copyin = 1; break; diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c index 795175d701a..f038f4c5bf8 100644 --- a/gcc/fortran/trans-openmp.c +++ b/gcc/fortran/trans-openmp.c @@ -2895,6 +2895,16 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, c = build_omp_clause (where.lb->location, OMP_CLAUSE_AUTO); omp_clauses = gfc_trans_add_clause (c, omp_clauses); } + if (clauses->if_present) + { + c = build_omp_clause (where.lb->location, OMP_CLAUSE_IF_PRESENT); + omp_clauses = gfc_trans_add_clause (c, omp_clauses); + } + if (clauses->finalize) + { + c = build_omp_clause (where.lb->location, OMP_CLAUSE_FINALIZE); + omp_clauses = gfc_trans_add_clause (c, omp_clauses); + } if (clauses->independent) { c = build_omp_clause (where.lb->location, OMP_CLAUSE_INDEPENDENT); -- 2.17.1