Fortran/OpenMP: Add 'omp depobj' and 'depend(mutexinoutset:' gcc/fortran/ChangeLog: * dump-parse-tree.c (show_omp_namelist): Handle depobj + mutexinoutset in the depend clause. (show_omp_clauses, show_omp_node, show_code_node): Handle depobj. * gfortran.h (enum gfc_statement): Add ST_OMP_DEPOBJ. (enum gfc_omp_depend_op): Add OMP_DEPEND_UNSET, OMP_DEPEND_MUTEXINOUTSET and OMP_DEPEND_DEPOBJ. (gfc_omp_clauses): Add destroy, depobj_update and depobj. (enum gfc_exec_op): Add EXEC_OMP_DEPOBJ * match.h (gfc_match_omp_depobj): Match 'omp depobj'. * openmp.c (gfc_match_omp_clauses): Add depobj + mutexinoutset to depend clause. (gfc_match_omp_depobj, resolve_omp_clauses, gfc_resolve_omp_directive): Handle 'omp depobj'. * parse.c (decode_omp_directive, next_statement, gfc_ascii_statement): Likewise. * resolve.c (gfc_resolve_code): Likewise. * st.c (gfc_free_statement): Likewise. * trans-openmp.c (gfc_trans_omp_clauses): Handle depobj + mutexinoutset in the depend clause. (gfc_trans_omp_depobj, gfc_trans_omp_directive): Handle EXEC_OMP_DEPOBJ. * trans.c (trans_code): Likewise. libgomp/ChangeLog: * testsuite/libgomp.fortran/depobj-1.f90: New test. gcc/testsuite/ChangeLog: * gfortran.dg/gomp/depobj-1.f90: New test. * gfortran.dg/gomp/depobj-2.f90: New test. gcc/fortran/dump-parse-tree.c | 33 ++++++++ gcc/fortran/gfortran.h | 12 ++- gcc/fortran/match.h | 1 + gcc/fortran/openmp.c | 113 +++++++++++++++++++++++++ gcc/fortran/parse.c | 6 +- gcc/fortran/resolve.c | 1 + gcc/fortran/st.c | 1 + gcc/fortran/trans-openmp.c | 68 +++++++++++++++ gcc/fortran/trans.c | 1 + gcc/testsuite/gfortran.dg/gomp/depobj-1.f90 | 25 ++++++ gcc/testsuite/gfortran.dg/gomp/depobj-2.f90 | 33 ++++++++ libgomp/testsuite/libgomp.fortran/depobj-1.f90 | 113 +++++++++++++++++++++++++ 12 files changed, 402 insertions(+), 5 deletions(-) diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c index 059d8421bb5..b50265ac742 100644 --- a/gcc/fortran/dump-parse-tree.c +++ b/gcc/fortran/dump-parse-tree.c @@ -1332,6 +1332,10 @@ show_omp_namelist (int list_type, gfc_omp_namelist *n) case OMP_DEPEND_IN: fputs ("in:", dumpfile); break; case OMP_DEPEND_OUT: fputs ("out:", dumpfile); break; case OMP_DEPEND_INOUT: fputs ("inout:", dumpfile); break; + case OMP_DEPEND_DEPOBJ: fputs ("depobj:", dumpfile); break; + case OMP_DEPEND_MUTEXINOUTSET: + fputs ("mutexinoutset:", dumpfile); + break; case OMP_DEPEND_SINK_FIRST: fputs ("sink:", dumpfile); while (1) @@ -1754,10 +1758,27 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses) show_expr (omp_clauses->if_exprs[i]); fputc (')', dumpfile); } + if (omp_clauses->destroy) + fputs (" DESTROY", dumpfile); if (omp_clauses->depend_source) fputs (" DEPEND(source)", dumpfile); if (omp_clauses->capture) fputs (" CAPTURE", dumpfile); + if (omp_clauses->depobj_update != OMP_DEPEND_UNSET) + { + const char *deptype; + fputs (" UPDATE(", dumpfile); + switch (omp_clauses->depobj_update) + { + case OMP_DEPEND_IN: deptype = "IN"; break; + case OMP_DEPEND_OUT: deptype = "OUT"; break; + case OMP_DEPEND_INOUT: deptype = "INOUT"; break; + case OMP_DEPEND_MUTEXINOUTSET: deptype = "MUTEXINOUTSET"; break; + default: gcc_unreachable (); + } + fputs (deptype, dumpfile); + fputc (')', dumpfile); + } if (omp_clauses->atomic_op != GFC_OMP_ATOMIC_UNSET) { const char *atomic_op; @@ -1831,6 +1852,7 @@ show_omp_node (int level, gfc_code *c) case EXEC_OMP_FLUSH: name = "FLUSH"; break; case EXEC_OMP_MASTER: name = "MASTER"; break; case EXEC_OMP_ORDERED: name = "ORDERED"; break; + case EXEC_OMP_DEPOBJ: name = "DEPOBJ"; break; case EXEC_OMP_PARALLEL: name = "PARALLEL"; break; case EXEC_OMP_PARALLEL_DO: name = "PARALLEL DO"; break; case EXEC_OMP_PARALLEL_DO_SIMD: name = "PARALLEL DO SIMD"; break; @@ -1941,6 +1963,15 @@ show_omp_node (int level, gfc_code *c) if (omp_clauses) fprintf (dumpfile, " (%s)", c->ext.omp_clauses->critical_name); break; + case EXEC_OMP_DEPOBJ: + omp_clauses = c->ext.omp_clauses; + if (omp_clauses) + { + fputc ('(', dumpfile); + show_expr (c->ext.omp_clauses->depobj); + fputc (')', dumpfile); + } + break; case EXEC_OMP_FLUSH: if (c->ext.omp_namelist) { @@ -1969,6 +2000,7 @@ show_omp_node (int level, gfc_code *c) || c->op == EXEC_OACC_ENTER_DATA || c->op == EXEC_OACC_EXIT_DATA || c->op == EXEC_OMP_TARGET_UPDATE || c->op == EXEC_OMP_TARGET_ENTER_DATA || c->op == EXEC_OMP_TARGET_EXIT_DATA || c->op == EXEC_OMP_SCAN + || c->op == EXEC_OMP_DEPOBJ || (c->op == EXEC_OMP_ORDERED && c->block == NULL)) return; if (c->op == EXEC_OMP_SECTIONS || c->op == EXEC_OMP_PARALLEL_SECTIONS) @@ -3094,6 +3126,7 @@ show_code_node (int level, gfc_code *c) case EXEC_OMP_CANCELLATION_POINT: case EXEC_OMP_BARRIER: case EXEC_OMP_CRITICAL: + case EXEC_OMP_DEPOBJ: case EXEC_OMP_DISTRIBUTE: case EXEC_OMP_DISTRIBUTE_PARALLEL_DO: case EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD: diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 7935aca23db..d12be0cdbab 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -261,7 +261,7 @@ enum gfc_statement ST_OMP_TARGET_PARALLEL_DO_SIMD, ST_OMP_END_TARGET_PARALLEL_DO_SIMD, ST_OMP_TARGET_ENTER_DATA, ST_OMP_TARGET_EXIT_DATA, ST_OMP_TARGET_SIMD, ST_OMP_END_TARGET_SIMD, - ST_OMP_TASKLOOP, ST_OMP_END_TASKLOOP, ST_OMP_SCAN, + ST_OMP_TASKLOOP, ST_OMP_END_TASKLOOP, ST_OMP_SCAN, ST_OMP_DEPOBJ, ST_OMP_TASKLOOP_SIMD, ST_OMP_END_TASKLOOP_SIMD, ST_OMP_ORDERED_DEPEND, ST_OMP_REQUIRES, ST_PROCEDURE, ST_GENERIC, ST_CRITICAL, ST_END_CRITICAL, ST_GET_FCN_CHARACTERISTICS, ST_LOCK, ST_UNLOCK, ST_EVENT_POST, @@ -1198,9 +1198,12 @@ enum gfc_omp_reduction_op enum gfc_omp_depend_op { + OMP_DEPEND_UNSET, OMP_DEPEND_IN, OMP_DEPEND_OUT, OMP_DEPEND_INOUT, + OMP_DEPEND_MUTEXINOUTSET, + OMP_DEPEND_DEPOBJ, OMP_DEPEND_SINK_FIRST, OMP_DEPEND_SINK }; @@ -1402,11 +1405,12 @@ typedef struct gfc_omp_clauses bool nowait, ordered, untied, mergeable; bool inbranch, notinbranch, defaultmap, nogroup; bool sched_simd, sched_monotonic, sched_nonmonotonic; - bool simd, threads, depend_source, order_concurrent, capture; + bool simd, threads, depend_source, destroy, order_concurrent, capture; enum gfc_omp_atomic_op atomic_op; enum gfc_omp_memorder memorder; enum gfc_omp_cancel_kind cancel; enum gfc_omp_proc_bind_kind proc_bind; + enum gfc_omp_depend_op depobj_update; struct gfc_expr *safelen_expr; struct gfc_expr *simdlen_expr; struct gfc_expr *num_teams; @@ -1417,6 +1421,7 @@ typedef struct gfc_omp_clauses struct gfc_expr *num_tasks; struct gfc_expr *priority; struct gfc_expr *detach; + struct gfc_expr *depobj; struct gfc_expr *if_exprs[OMP_IF_LAST]; enum gfc_omp_sched_kind dist_sched_kind; struct gfc_expr *dist_chunk_size; @@ -1437,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; @@ -2700,7 +2704,7 @@ enum gfc_exec_op EXEC_OMP_TARGET_ENTER_DATA, EXEC_OMP_TARGET_EXIT_DATA, EXEC_OMP_TARGET_PARALLEL, EXEC_OMP_TARGET_PARALLEL_DO, EXEC_OMP_TARGET_PARALLEL_DO_SIMD, EXEC_OMP_TARGET_SIMD, - EXEC_OMP_TASKLOOP, EXEC_OMP_TASKLOOP_SIMD, EXEC_OMP_SCAN + EXEC_OMP_TASKLOOP, EXEC_OMP_TASKLOOP_SIMD, EXEC_OMP_SCAN, EXEC_OMP_DEPOBJ }; typedef struct gfc_code diff --git a/gcc/fortran/match.h b/gcc/fortran/match.h index 20a530f23c2..b72ec67d665 100644 --- a/gcc/fortran/match.h +++ b/gcc/fortran/match.h @@ -160,6 +160,7 @@ match gfc_match_omp_critical (void); match gfc_match_omp_declare_reduction (void); match gfc_match_omp_declare_simd (void); match gfc_match_omp_declare_target (void); +match gfc_match_omp_depobj (void); match gfc_match_omp_distribute (void); match gfc_match_omp_distribute_parallel_do (void); match gfc_match_omp_distribute_parallel_do_simd (void); diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c index 1f1920cf0e1..a1b057227b7 100644 --- a/gcc/fortran/openmp.c +++ b/gcc/fortran/openmp.c @@ -1381,6 +1381,10 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, depend_op = OMP_DEPEND_IN; else if (gfc_match ("out") == MATCH_YES) depend_op = OMP_DEPEND_OUT; + else if (gfc_match ("mutexinoutset") == MATCH_YES) + depend_op = OMP_DEPEND_MUTEXINOUTSET; + else if (gfc_match ("depobj") == MATCH_YES) + depend_op = OMP_DEPEND_DEPOBJ; else if (!c->depend_source && gfc_match ("source )") == MATCH_YES) { @@ -2898,6 +2902,86 @@ gfc_match_omp_end_critical (void) return MATCH_YES; } +/* depobj(depobj) depend(dep-type:loc)|destroy|update(dep-type) + dep-type = in/out/inout/mutexinoutset/depobj/source/sink + depend: !source, !sink + update: !source, !sink, !depobj + locator = exactly one list item .*/ +match +gfc_match_omp_depobj (void) +{ + gfc_omp_clauses *c = NULL; + gfc_expr *depobj; + + if (gfc_match (" ( %v ) ", &depobj) != MATCH_YES) + { + gfc_error ("Expected %<( depobj )%> at %C"); + return MATCH_ERROR; + } + if (gfc_match ("update ( ") == MATCH_YES) + { + c = gfc_get_omp_clauses (); + if (gfc_match ("inout )") == MATCH_YES) + c->depobj_update = OMP_DEPEND_INOUT; + else if (gfc_match ("in )") == MATCH_YES) + c->depobj_update = OMP_DEPEND_IN; + else if (gfc_match ("out )") == MATCH_YES) + c->depobj_update = OMP_DEPEND_OUT; + else if (gfc_match ("mutexinoutset )") == MATCH_YES) + c->depobj_update = OMP_DEPEND_MUTEXINOUTSET; + else + { + gfc_error ("Expected IN, OUT, INOUT, MUTEXINOUTSET followed by " + "%<)%> at %C"); + goto error; + } + } + else if (gfc_match ("destroy") == MATCH_YES) + { + c = gfc_get_omp_clauses (); + c->destroy = true; + } + else if (gfc_match_omp_clauses (&c, omp_mask (OMP_CLAUSE_DEPEND), true, false) + != MATCH_YES) + goto error; + + if (c->depobj_update == OMP_DEPEND_UNSET && !c->destroy) + { + if (!c->depend_source && !c->lists[OMP_LIST_DEPEND]) + { + gfc_error ("Expected DEPEND, UPDATE, or DESTROY clause at %C"); + goto error; + } + if (c->depend_source + || c->lists[OMP_LIST_DEPEND]->u.depend_op == OMP_DEPEND_SINK_FIRST + || c->lists[OMP_LIST_DEPEND]->u.depend_op == OMP_DEPEND_SINK + || c->lists[OMP_LIST_DEPEND]->u.depend_op == OMP_DEPEND_DEPOBJ) + { + gfc_error ("DEPEND clause at %L of OMP DEPOBJ construct shall not " + "have dependence-type SOURCE, SINK or DEPOBJ", + c->lists[OMP_LIST_DEPEND] + ? &c->lists[OMP_LIST_DEPEND]->where : &gfc_current_locus); + goto error; + } + if (c->lists[OMP_LIST_DEPEND]->next) + { + gfc_error ("DEPEND clause at %L of OMP DEPOBJ construct shall have " + "only a single locator", + &c->lists[OMP_LIST_DEPEND]->next->where); + goto error; + } + } + + c->depobj = depobj; + new_st.op = EXEC_OMP_DEPOBJ; + new_st.ext.omp_clauses = c; + return MATCH_YES; + +error: + gfc_free_expr (depobj); + gfc_free_omp_clauses (c); + return MATCH_ERROR; +} match gfc_match_omp_distribute (void) @@ -4877,6 +4961,14 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, "clause at %L", &code->loc); } + if (omp_clauses->depobj + && (!gfc_resolve_expr (omp_clauses->depobj) + || omp_clauses->depobj->ts.type != BT_INTEGER + || omp_clauses->depobj->ts.kind != 2 * gfc_index_integer_kind + || omp_clauses->depobj->rank != 0)) + gfc_error ("DEPOBJ in DEPOBJ construct at %L shall be a scalar integer " + "of OMP_DEPEND_KIND kind", &omp_clauses->depobj->where); + /* 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++) @@ -5173,6 +5265,26 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, gfc_error ("Only SOURCE or SINK dependence types " "are allowed on ORDERED directive at %L", &n->where); + else if (n->u.depend_op == OMP_DEPEND_DEPOBJ + && !n->expr + && (n->sym->ts.type != BT_INTEGER + || n->sym->ts.kind + != 2 * gfc_index_integer_kind + || n->sym->attr.dimension)) + gfc_error ("Locator %qs at %L in DEPEND clause of depobj " + "type shall be a scalar integer of " + "OMP_DEPEND_KIND kind", n->sym->name, + &n->where); + else if (n->u.depend_op == OMP_DEPEND_DEPOBJ + && n->expr + && (!gfc_resolve_expr (n->expr) + || n->expr->ts.type != BT_INTEGER + || n->expr->ts.kind + != 2 * gfc_index_integer_kind + || n->expr->rank != 0)) + gfc_error ("Locator at %L in DEPEND clause of depobj " + "type shall be a scalar integer of " + "OMP_DEPEND_KIND kind", &n->expr->where); } gfc_ref *lastref = NULL, *lastslice = NULL; bool resolved = false; @@ -7211,6 +7323,7 @@ gfc_resolve_omp_directive (gfc_code *code, gfc_namespace *ns) case EXEC_OMP_TASK: case EXEC_OMP_TEAMS: case EXEC_OMP_WORKSHARE: + case EXEC_OMP_DEPOBJ: if (code->ext.omp_clauses) resolve_omp_clauses (code, code->ext.omp_clauses, NULL); break; diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c index 1549f8e1635..9bbe9e83c8e 100644 --- a/gcc/fortran/parse.c +++ b/gcc/fortran/parse.c @@ -895,6 +895,7 @@ decode_omp_directive (void) case 'd': matchds ("declare reduction", gfc_match_omp_declare_reduction, ST_OMP_DECLARE_REDUCTION); + matcho ("depobj", gfc_match_omp_depobj, ST_OMP_DEPOBJ); matchs ("distribute parallel do simd", gfc_match_omp_distribute_parallel_do_simd, ST_OMP_DISTRIBUTE_PARALLEL_DO_SIMD); @@ -1588,7 +1589,7 @@ next_statement (void) case ST_ASSIGNMENT: case ST_ARITHMETIC_IF: case ST_WHERE: case ST_FORALL: \ case ST_LABEL_ASSIGNMENT: case ST_FLUSH: case ST_OMP_FLUSH: \ case ST_OMP_BARRIER: case ST_OMP_TASKWAIT: case ST_OMP_TASKYIELD: \ - case ST_OMP_CANCEL: case ST_OMP_CANCELLATION_POINT: \ + case ST_OMP_CANCEL: case ST_OMP_CANCELLATION_POINT: case ST_OMP_DEPOBJ: \ case ST_OMP_TARGET_UPDATE: case ST_OMP_TARGET_ENTER_DATA: \ case ST_OMP_TARGET_EXIT_DATA: case ST_OMP_ORDERED_DEPEND: \ case ST_ERROR_STOP: case ST_OMP_SCAN: case ST_SYNC_ALL: \ @@ -2285,6 +2286,9 @@ gfc_ascii_statement (gfc_statement st) case ST_OMP_DECLARE_TARGET: p = "!$OMP DECLARE TARGET"; break; + case ST_OMP_DEPOBJ: + p = "!$OMP DEPOBJ"; + break; case ST_OMP_DISTRIBUTE: p = "!$OMP DISTRIBUTE"; break; diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index dd4b26680e0..5a81387e277 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -12198,6 +12198,7 @@ start: case EXEC_OMP_CANCELLATION_POINT: case EXEC_OMP_CRITICAL: case EXEC_OMP_FLUSH: + case EXEC_OMP_DEPOBJ: case EXEC_OMP_DISTRIBUTE: case EXEC_OMP_DISTRIBUTE_PARALLEL_DO: case EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD: diff --git a/gcc/fortran/st.c b/gcc/fortran/st.c index 13b3880720a..9e761996eec 100644 --- a/gcc/fortran/st.c +++ b/gcc/fortran/st.c @@ -218,6 +218,7 @@ gfc_free_statement (gfc_code *p) case EXEC_OMP_CANCEL: case EXEC_OMP_CANCELLATION_POINT: case EXEC_OMP_CRITICAL: + case EXEC_OMP_DEPOBJ: case EXEC_OMP_DISTRIBUTE: case EXEC_OMP_DISTRIBUTE_PARALLEL_DO: case EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD: diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c index 349df1cc346..bf3f2617776 100644 --- a/gcc/fortran/trans-openmp.c +++ b/gcc/fortran/trans-openmp.c @@ -2545,6 +2545,9 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, tree decl = gfc_trans_omp_variable (n->sym, false); if (gfc_omp_privatize_by_reference (decl)) decl = build_fold_indirect_ref (decl); + if (n->u.depend_op == OMP_DEPEND_DEPOBJ + && POINTER_TYPE_P (TREE_TYPE (decl))) + decl = build_fold_indirect_ref (decl); if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (decl))) { decl = gfc_conv_descriptor_data_get (decl); @@ -2587,6 +2590,13 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, case OMP_DEPEND_INOUT: OMP_CLAUSE_DEPEND_KIND (node) = OMP_CLAUSE_DEPEND_INOUT; break; + case OMP_DEPEND_MUTEXINOUTSET: + OMP_CLAUSE_DEPEND_KIND (node) + = OMP_CLAUSE_DEPEND_MUTEXINOUTSET; + break; + case OMP_DEPEND_DEPOBJ: + OMP_CLAUSE_DEPEND_KIND (node) = OMP_CLAUSE_DEPEND_DEPOBJ; + break; default: gcc_unreachable (); } @@ -4912,6 +4922,62 @@ gfc_trans_oacc_combined_directive (gfc_code *code) return gfc_finish_block (&block); } +static tree +gfc_trans_omp_depobj (gfc_code *code) +{ + stmtblock_t block; + gfc_se se; + gfc_init_se (&se, NULL); + gfc_init_block (&block); + gfc_conv_expr (&se, code->ext.omp_clauses->depobj); + gcc_assert (se.pre.head == NULL && se.post.head == NULL); + tree depobj = se.expr; + location_t loc = EXPR_LOCATION (depobj); + if (!POINTER_TYPE_P (TREE_TYPE (depobj))) + depobj = gfc_build_addr_expr (NULL, depobj); + depobj = fold_convert (build_pointer_type_for_mode (ptr_type_node, + TYPE_MODE (ptr_type_node), + true), depobj); + gfc_omp_namelist *n = code->ext.omp_clauses->lists[OMP_LIST_DEPEND]; + if (n) + { + tree var; + if (n->expr) + var = gfc_convert_expr_to_tree (&block, n->expr); + else + var = gfc_get_symbol_decl (n->sym); + if (!POINTER_TYPE_P (TREE_TYPE (var))) + var = gfc_build_addr_expr (NULL, var); + depobj = save_expr (depobj); + tree r = build_fold_indirect_ref_loc (loc, depobj); + gfc_add_expr_to_block (&block, + build2 (MODIFY_EXPR, void_type_node, r, var)); + } + + /* Only one may be set. */ + gcc_assert (((int)(n != NULL) + (int)(code->ext.omp_clauses->destroy) + + (int)(code->ext.omp_clauses->depobj_update != OMP_DEPEND_UNSET)) + == 1); + int k = -1; /* omp_clauses->destroy */ + if (!code->ext.omp_clauses->destroy) + switch (code->ext.omp_clauses->depobj_update != OMP_DEPEND_UNSET + ? code->ext.omp_clauses->depobj_update : n->u.depend_op) + { + case OMP_DEPEND_IN: k = GOMP_DEPEND_IN; break; + case OMP_DEPEND_OUT: k = GOMP_DEPEND_IN; break; + case OMP_DEPEND_INOUT: k = GOMP_DEPEND_IN; break; + case OMP_DEPEND_MUTEXINOUTSET: k = GOMP_DEPEND_MUTEXINOUTSET; break; + default: gcc_unreachable (); + } + tree t = build_int_cst (ptr_type_node, k); + depobj = build2_loc (loc, POINTER_PLUS_EXPR, TREE_TYPE (depobj), depobj, + TYPE_SIZE_UNIT (ptr_type_node)); + depobj = build_fold_indirect_ref_loc (loc, depobj); + gfc_add_expr_to_block (&block, build2 (MODIFY_EXPR, void_type_node, depobj, t)); + + return gfc_finish_block (&block); +} + static tree gfc_trans_omp_flush (gfc_code *code) { @@ -6181,6 +6247,8 @@ gfc_trans_omp_directive (gfc_code *code) return gfc_trans_omp_cancellation_point (code); case EXEC_OMP_CRITICAL: return gfc_trans_omp_critical (code); + case EXEC_OMP_DEPOBJ: + return gfc_trans_omp_depobj (code); case EXEC_OMP_DISTRIBUTE: case EXEC_OMP_DO: case EXEC_OMP_SIMD: diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c index 9e8e8619ff8..624c7132539 100644 --- a/gcc/fortran/trans.c +++ b/gcc/fortran/trans.c @@ -2161,6 +2161,7 @@ trans_code (gfc_code * code, tree cond) case EXEC_OMP_CANCEL: case EXEC_OMP_CANCELLATION_POINT: case EXEC_OMP_CRITICAL: + case EXEC_OMP_DEPOBJ: case EXEC_OMP_DISTRIBUTE: case EXEC_OMP_DISTRIBUTE_PARALLEL_DO: case EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD: diff --git a/gcc/testsuite/gfortran.dg/gomp/depobj-1.f90 b/gcc/testsuite/gfortran.dg/gomp/depobj-1.f90 new file mode 100644 index 00000000000..66cfb61060f --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/depobj-1.f90 @@ -0,0 +1,25 @@ +! { dg-do compile { target { fortran_integer_16 || ilp32 } } } +! omp_depend_kind = 2*intptr_t --> 16 (128 bit) on 64bit-pointer systems +! --> 8 (128 bit) on 32bit-pointer systems +subroutine f1 + !use omp_lib ! N/A in gcc/testsuite + use iso_c_binding, only: c_intptr_t + implicit none + integer, parameter :: omp_depend_kind = 2*c_intptr_t + integer :: a + integer(kind=omp_depend_kind) :: depobj1, depobj2, depobj3, depobj4, depobj5 + !$omp depobj(depobj1) depend (in : a) + !$omp depobj(depobj2) depend (out : a) + !$omp depobj(depobj3) depend( inout : a) + !$omp depobj(depobj4) depend(mutexinoutset: a) + !$omp depobj(depobj1) update(out) + !$omp depobj(depobj2) update(mutexinoutset) + !$omp depobj(depobj3) update(in) + !$omp depobj(depobj4) update(inout) + !$omp task depend (depobj: depobj1, depobj2, depobj3) + !$omp end task + + !$omp task depend(mutexinoutset: a) + !$omp end task + !$omp depobj(depobj2) destroy +end subroutine f1 diff --git a/gcc/testsuite/gfortran.dg/gomp/depobj-2.f90 b/gcc/testsuite/gfortran.dg/gomp/depobj-2.f90 new file mode 100644 index 00000000000..3ffd3d5d01b --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/depobj-2.f90 @@ -0,0 +1,33 @@ +! { dg-do compile { target { fortran_integer_16 || ilp32 } } } +! omp_depend_kind = 2*intptr_t --> 16 (128 bit) on 64bit-pointer systems +! --> 8 (128 bit) on 32bit-pointer systems +subroutine f1 + !use omp_lib ! N/A in gcc/testsuite + use iso_c_binding, only: c_intptr_t + implicit none + integer, parameter :: omp_depend_kind = 2*c_intptr_t + integer :: a, b + integer(kind=omp_depend_kind) :: depobj, depobj1(5) + real :: r + integer(1) :: d + + !$omp depobj ! { dg-error "Expected '\\( depobj \\)\'" } + !$omp depobj(depobj) ! { dg-error "Expected DEPEND, UPDATE, or DESTROY clause" } + !$omp depobj destroy ! { dg-error "Expected '\\( depobj \\)\'" } + !$omp depobj ( depobj1 ( 1 ) ) depend( inout : a) ! OK + !$omp depobj(depobj1) depend( inout : a) ! { dg-error "DEPOBJ in DEPOBJ construct at .1. shall be a scalar integer of OMP_DEPEND_KIND kind" } + !$omp depobj(depobj1(:)) depend( inout : a) ! { dg-error "DEPOBJ in DEPOBJ construct at .1. shall be a scalar integer of OMP_DEPEND_KIND kind" } + !$omp depobj(r) depend( inout : a) ! { dg-error "DEPOBJ in DEPOBJ construct at .1. shall be a scalar integer of OMP_DEPEND_KIND kind" } + !$omp depobj(d) depend( inout : a) ! { dg-error "DEPOBJ in DEPOBJ construct at .1. shall be a scalar integer of OMP_DEPEND_KIND kind" } + !$omp depobj(depobj) depend( inout : a, b) ! { dg-error "DEPEND clause at .1. of OMP DEPOBJ construct shall have only a single locator" } + !$omp depobj(depobj) depend(mutexinoutset : a) ! OK + !$omp depobj(depobj) depend(source) ! { dg-error "DEPEND clause at .1. of OMP DEPOBJ construct shall not have dependence-type SOURCE, SINK or DEPOBJ" } + !$omp depobj(depobj) depend(sink : i + 1) ! { dg-error "DEPEND clause at .1. of OMP DEPOBJ construct shall not have dependence-type SOURCE, SINK or DEPOBJ" } + !$omp depobj(depobj) update(source) ! { dg-error "Expected IN, OUT, INOUT, MUTEXINOUTSET followed by '\\)'" } + !$omp depobj(depobj) update(sink) ! { dg-error "Expected IN, OUT, INOUT, MUTEXINOUTSET followed by '\\)'" } + !$omp depobj(depobj) update(depobj) ! { dg-error "Expected IN, OUT, INOUT, MUTEXINOUTSET followed by '\\)'" } + + ! Valid in OpenMP 5.1: + !$omp depobj(depobj5) depend(depobj: depobj3) ! { dg-error "DEPEND clause at .1. of OMP DEPOBJ construct shall not have dependence-type SOURCE, SINK or DEPOBJ" } +end subroutine f1 + diff --git a/libgomp/testsuite/libgomp.fortran/depobj-1.f90 b/libgomp/testsuite/libgomp.fortran/depobj-1.f90 new file mode 100644 index 00000000000..eb314f67bae --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/depobj-1.f90 @@ -0,0 +1,113 @@ +module m +! use omp_lib + implicit none (type, external) +integer, parameter :: omp_depend_kind = 16 + integer :: xx + integer(omp_depend_kind) :: dd1, dd2 +contains + subroutine dep + integer :: x + integer(omp_depend_kind) :: d1, d2 + x = 1 + + !$omp depobj (d1) depend(in: x) + !$omp depobj (d2) depend(in: x) + !$omp depobj (d2) update(out) + !$omp parallel + !$omp single + !$omp task shared (x) depend(depobj: d2) + x = 2 + !$omp end task + !$omp task shared (x) depend(depobj: d1) + if (x /= 2) & + stop 1 + !$omp end task + !$omp end single + !$omp end parallel + !$omp depobj (d2) destroy + !$omp depobj (d1) destroy + end + + subroutine dep2 + integer, pointer :: x + integer(omp_depend_kind) :: d1, d2 + pointer :: d1 + allocate(d1, x) + call dep2i(d1, d2, x) + deallocate(d1) + contains + subroutine dep2i(d1, d2, x) + integer(omp_depend_kind) :: d1 + integer(omp_depend_kind), optional :: d2 + integer, pointer, optional :: x + pointer :: d1 + !$omp parallel + !$omp single + x = 1 + !$omp depobj (d1) depend(out: x) + !$omp depobj (d2) depend (in:x) + !$omp depobj(d2)update(in) + !$omp task shared (x) depend(depobj:d1) + x = 2 + !$omp end task + !$omp task shared (x) depend(depobj : d2) + if (x /= 2) & + stop 2 + !$omp end task + !$omp taskwait + !$omp depobj(d1)destroy + !$omp depobj(d2) destroy + !$omp end single + !$omp end parallel + end + end + + subroutine dep3 + integer :: x + integer(omp_depend_kind) :: d(2) + !$omp parallel + x = 1 + !$omp single + !$omp depobj(d(1)) depend(out:x) + !$omp depobj(d(2)) depend(in: x) + !$omp task shared (x) depend(depobj: d(1)) + x = 2 + !$omp end task + !$omp task shared (x) depend(depobj: d(2)) + if (x /= 2) & + stop 3 + !$omp end task + !$omp end single + !$omp end parallel + !$omp depobj(d(1)) destroy + !$omp depobj(d(2)) destroy + end + + subroutine antidep + xx = 1 + !$omp parallel + !$omp single + !$omp task shared(xx) depend(depobj:dd2) + if (xx /= 1) & + stop 4 + !$omp end task + !$omp task shared(xx) depend(depobj:dd1) + xx = 2 + !$omp end task + !$omp end single + !$omp end parallel + end +end module m + +program main + use m + implicit none (type, external) + call dep () + call dep2 () + call dep3 () + !$omp depobj (dd1) depend (inout: xx) + !$omp depobj (dd2) depend (in : xx) + call antidep () + !$omp depobj (dd2) destroy + !$omp depobj (dd1) destroy +end program main