[PUSHED v4] Fortran support for init,set,shutdown OpenACC directives
Thomas Schwinge <[email protected]> Thu, 30 Jul 2026 10:28:01 +0200
| Newsgroups | gmane.comp.gcc.patches,gmane.comp.gcc.fortran |
|---|---|
| Message-ID | <[email protected]> |
From: Sebastian Galindo <[email protected]> This patch adds parsing and libgomp runtime calls for these directives, sharing the existing implementation with runtime API calls. It also includes support for the device_type and device_num clauses in the Fortran front-end. For the device_type clause, the current implementation limits usage to accepting only a single clause per directive. While the OpenACC specification states that device_type should modify the device for subsequent clauses inside other directives or constructs, supporting this behavior requires a larger refactoring and may be addressed in the future. The set directive does not yet support the default_async clause, as further discussion is needed to agree on its semantics and libgomp implementation. gcc/ChangeLog: * builtin-types.def (BT_FN_VOID_INT_INT): New definition. * omp-builtins.def (BUILT_IN_GOACC_INIT): New builtin for init directive. (BUILT_IN_GOACC_SHUTDOWN): New builtin for shutdown directive. (BUILT_IN_GOACC_SET_DEVICE): New builtin for set directive. gcc/fortran/ChangeLog: * dump-parse-tree.cc (show_omp_clauses): Dump OpenACC DEVICE_TYPE and DEVICE_NUM clauses. (show_omp_node): Handle INIT, SHUTDOWN, and SET directives. (show_code_node): Likewise. * frontend-passes.cc (gfc_code_walker): Walk device_num_expr for INIT, SHUTDOWN, and SET directives. * gfortran.h (enum gfc_statement): Add ST_OACC_INIT, ST_OACC_SHUTDOWN, and ST_OACC_SET. (gfc_omp_clauses): Add device_num_expr and oacc_device_type fields. (enum gfc_exec_op): Add EXEC_OACC_INIT, EXEC_OACC_SHUTDOWN, and EXEC_OACC_SET. * match.h (gfc_match_oacc_init): Declare. (gfc_match_oacc_shutdown): Likewise. (gfc_match_oacc_set): Likewise. * openmp.cc (gfc_free_omp_clauses): Free device_num_expr. (match_oacc_device_type_kind): New helper to parse OpenACC device_type arguments. (match_oacc_device_type): New helper to match the OpenACC DEVICE_TYPE clause. (enum omp_mask2): Add OMP_CLAUSE_DEVICE_NUM. (gfc_match_omp_clauses): Match OpenACC DEVICE_TYPE and DEVICE_NUM clauses. (OACC_INIT_CLAUSES): New clause mask. (OACC_SHUTDOWN_CLAUSES): Likewise. (OACC_SET_CLAUSES): Likewise. (gfc_match_oacc_init): New matcher. (gfc_match_oacc_shutdown): Likewise. (gfc_match_oacc_set): Likewise. (resolve_omp_clauses): Resolve DEVICE_NUM; require at least one of DEVICE_TYPE and DEVICE_NUM on SET. (oacc_code_to_statement): Map new exec ops to statement codes. (gfc_resolve_oacc_directive): Resolve INIT, SET, and SHUTDOWN directives. * parse.cc (decode_oacc_directive): Recognize init, set, and shutdown directives. (next_statement): Treat INIT, SET, and SHUTDOWN as executable statements. (gfc_ascii_statement): Add ASCII names for new directives. (is_oacc): Recognize new exec ops. * resolve.cc (gfc_resolve_blocks): Resolve INIT, SET, and SHUTDOWN directives. * st.cc (gfc_free_statement): Free clauses for new directives. * trans-openmp.cc (gfc_trans_omp_clauses): Assert that DEVICE_NUM and DEVICE_TYPE do not appear on construct clauses. (gfc_trans_oacc_executable_directive): Lower INIT, SHUTDOWN, and SET to GOACC builtins. (gfc_trans_oacc_directive): Dispatch new directives. * trans.cc (trans_code): Dispatch new directives. * types.def (BT_FN_VOID_INT_INT): New definition. libgomp/ChangeLog: * libgomp.map (GOACC_2.5): Export GOACC_init, GOACC_shutdown, and GOACC_set_device. * libgomp_g.h (GOACC_init): Declare. (GOACC_shutdown): Likewise. (GOACC_set_device): Likewise. * oacc-init.c (GOACC_DIRECTIVE_DEVICE_MASK): New macro for supported device types. (acc_init_1): Accept explicit device number argument. (acc_shutdown_1): Shut down a single device or all devices of a type. (goacc_attach_host_thread_to_device): Whitespace fix. (GOACC_init): New entry point for init directive. (GOACC_shutdown): New entry point for shutdown directive. (GOACC_set_device): New entry point for set directive. (acc_init): Pass default device number to acc_init_1. (acc_shutdown): Pass default device number to acc_shutdown_1. (acc_set_device_num): Whitespace fix. (goacc_restore_bind): Whitespace fix. (goacc_lazy_initialize): Pass default device number to acc_init_1. * testsuite/libgomp.oacc-fortran/init-1.f90: New test. * testsuite/libgomp.oacc-fortran/lib-1-directives.f90: New test. * testsuite/libgomp.oacc-fortran/lib-4-directives.f90: New test. * testsuite/libgomp.oacc-fortran/lib-5-directives.f90: New test. * testsuite/libgomp.oacc-fortran/lib-5-init.f90: New test. * testsuite/libgomp.oacc-fortran/set-1.f90: New test. * testsuite/libgomp.oacc-fortran/shutdown-1.f90: New test. gcc/testsuite/ChangeLog: * gfortran.dg/goacc/acc-init-1.f90: New test. * gfortran.dg/goacc/acc-init-clauses-1.f90: New test. * gfortran.dg/goacc/acc-set-1.f90: New test. * gfortran.dg/goacc/acc-set-clauses-1.f90: New test. * gfortran.dg/goacc/acc-shutdown-1.f90: New test. * gfortran.dg/goacc/acc-shutdown-clauses-1.f90: New test. * gfortran.dg/goacc/uninit-if-clause.f95: Test INIT with uninitialized IF clause. * gfortran.dg/goacc/update-if_present-2.f90: Update expected errors now that INIT and SHUTDOWN are recognized. Signed-off-by: Sebastian Galindo <[email protected]> Co-authored-by: Thomas Schwinge <[email protected]> --- gcc/builtin-types.def | 1 + gcc/fortran/dump-parse-tree.cc | 31 +++ gcc/fortran/frontend-passes.cc | 8 + gcc/fortran/gfortran.h | 4 + gcc/fortran/match.h | 3 + gcc/fortran/openmp.cc | 126 +++++++++++- gcc/fortran/parse.cc | 20 +- gcc/fortran/resolve.cc | 6 + gcc/fortran/st.cc | 3 + gcc/fortran/trans-openmp.cc | 74 ++++++- gcc/fortran/trans.cc | 3 + gcc/fortran/types.def | 1 + gcc/omp-builtins.def | 6 + .../gfortran.dg/goacc/acc-init-1.f90 | 47 +++++ .../gfortran.dg/goacc/acc-init-clauses-1.f90 | 28 +++ gcc/testsuite/gfortran.dg/goacc/acc-set-1.f90 | 36 ++++ .../gfortran.dg/goacc/acc-set-clauses-1.f90 | 58 ++++++ .../gfortran.dg/goacc/acc-shutdown-1.f90 | 47 +++++ .../goacc/acc-shutdown-clauses-1.f90 | 43 ++++ .../gfortran.dg/goacc/uninit-if-clause.f95 | 5 +- .../gfortran.dg/goacc/update-if_present-2.f90 | 4 +- libgomp/libgomp.map | 7 + libgomp/libgomp_g.h | 6 + libgomp/oacc-init.c | 185 ++++++++++++++++-- .../testsuite/libgomp.oacc-fortran/init-1.f90 | 59 ++++++ .../libgomp.oacc-fortran/lib-1-directives.f90 | 17 ++ .../libgomp.oacc-fortran/lib-4-directives.f90 | 37 ++++ .../libgomp.oacc-fortran/lib-5-directives.f90 | 59 ++++++ .../libgomp.oacc-fortran/lib-5-init.f90 | 59 ++++++ .../testsuite/libgomp.oacc-fortran/set-1.f90 | 82 ++++++++ .../libgomp.oacc-fortran/shutdown-1.f90 | 53 +++++ 31 files changed, 1094 insertions(+), 24 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/goacc/acc-init-1.f90 create mode 100644 gcc/testsuite/gfortran.dg/goacc/acc-init-clauses-1.f90 create mode 100644 gcc/testsuite/gfortran.dg/goacc/acc-set-1.f90 create mode 100644 gcc/testsuite/gfortran.dg/goacc/acc-set-clauses-1.f90 create mode 100644 gcc/testsuite/gfortran.dg/goacc/acc-shutdown-1.f90 create mode 100644 gcc/testsuite/gfortran.dg/goacc/acc-shutdown-clauses-1.f90 create mode 100644 libgomp/testsuite/libgomp.oacc-fortran/init-1.f90 create mode 100644 libgomp/testsuite/libgomp.oacc-fortran/lib-1-directives.f90 create mode 100644 libgomp/testsuite/libgomp.oacc-fortran/lib-4-directives.f90 create mode 100644 libgomp/testsuite/libgomp.oacc-fortran/lib-5-directives.f90 create mode 100644 libgomp/testsuite/libgomp.oacc-fortran/lib-5-init.f90 create mode 100644 libgomp/testsuite/libgomp.oacc-fortran/set-1.f90 create mode 100644 libgomp/testsuite/libgomp.oacc-fortran/shutdown-1.f90 diff --git a/gcc/builtin-types.def b/gcc/builtin-types.def index 23bfa76eaa4..19da735791e 100644 --- a/gcc/builtin-types.def +++ b/gcc/builtin-types.def @@ -694,6 +694,7 @@ DEF_FUNCTION_TYPE_2 (BT_FN_PTR_CONST_PTR_UINT8, BT_PTR, BT_CONST_PTR, BT_UINT8) DEF_FUNCTION_TYPE_2 (BT_FN_PTR_CONST_PTR_INT, BT_PTR, BT_CONST_PTR, BT_INT) DEF_FUNCTION_TYPE_2 (BT_FN_VOID_ULONGLONG_ULONGLONG, BT_VOID, BT_ULONGLONG, BT_ULONGLONG) +DEF_FUNCTION_TYPE_2 (BT_FN_VOID_INT_INT, BT_VOID, BT_INT, BT_INT) DEF_POINTER_TYPE (BT_PTR_FN_VOID_PTR_PTR, BT_FN_VOID_PTR_PTR) diff --git a/gcc/fortran/dump-parse-tree.cc b/gcc/fortran/dump-parse-tree.cc index 8d13acd8656..da185baecec 100644 --- a/gcc/fortran/dump-parse-tree.cc +++ b/gcc/fortran/dump-parse-tree.cc @@ -2494,6 +2494,28 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses) show_expr (omp_clauses->nocontext); fputc (')', dumpfile); } + if (omp_clauses->oacc_device_type_present) + { + const char *s; + switch (omp_clauses->oacc_device_type) + { + case GOMP_DEVICE_NONE: s = "all"; break; + case GOMP_DEVICE_HOST: s = "host"; break; + case GOMP_DEVICE_NVIDIA_PTX: s = "nvidia"; break; + case GOMP_DEVICE_GCN: s = "radeon"; break; + default: + gcc_unreachable (); + } + fputs (" DEVICE_TYPE(", dumpfile); + fputs (s, dumpfile); + fputc (')', dumpfile); + } + if (omp_clauses->device_num_expr) + { + fputs (" DEVICE_NUM(", dumpfile); + show_expr (omp_clauses->device_num_expr); + fputc (')', dumpfile); + } } /* Show a single OpenMP or OpenACC directive node and everything underneath it @@ -2523,6 +2545,9 @@ show_omp_node (int level, gfc_code *c) case EXEC_OACC_CACHE: name = "CACHE"; is_oacc = true; break; case EXEC_OACC_ENTER_DATA: name = "ENTER DATA"; is_oacc = true; break; case EXEC_OACC_EXIT_DATA: name = "EXIT DATA"; is_oacc = true; break; + case EXEC_OACC_INIT: name = "INIT"; is_oacc = true; break; + case EXEC_OACC_SHUTDOWN: name = "SHUTDOWN"; is_oacc = true; break; + case EXEC_OACC_SET: name = "SET"; is_oacc = true; break; case EXEC_OMP_ALLOCATE: name = "ALLOCATE"; break; case EXEC_OMP_ALLOCATORS: name = "ALLOCATORS"; break; case EXEC_OMP_ASSUME: name = "ASSUME"; break; @@ -2634,6 +2659,9 @@ show_omp_node (int level, gfc_code *c) case EXEC_OACC_CACHE: case EXEC_OACC_ENTER_DATA: case EXEC_OACC_EXIT_DATA: + case EXEC_OACC_INIT: + case EXEC_OACC_SHUTDOWN: + case EXEC_OACC_SET: case EXEC_OMP_ALLOCATE: case EXEC_OMP_ALLOCATORS: case EXEC_OMP_ASSUME: @@ -4031,6 +4059,9 @@ show_code_node (int level, gfc_code *c) case EXEC_OACC_CACHE: case EXEC_OACC_ENTER_DATA: case EXEC_OACC_EXIT_DATA: + case EXEC_OACC_INIT: + case EXEC_OACC_SHUTDOWN: + case EXEC_OACC_SET: case EXEC_OMP_ALLOCATE: case EXEC_OMP_ALLOCATORS: case EXEC_OMP_ASSUME: diff --git a/gcc/fortran/frontend-passes.cc b/gcc/fortran/frontend-passes.cc index 9bf5d40b9cc..8abe07e8f59 100644 --- a/gcc/fortran/frontend-passes.cc +++ b/gcc/fortran/frontend-passes.cc @@ -5740,6 +5740,14 @@ gfc_code_walker (gfc_code **c, walk_code_fn_t codefn, walk_expr_fn_t exprfn, WALK_SUBEXPR (n->expr); } break; + + case EXEC_OACC_INIT: + case EXEC_OACC_SHUTDOWN: + case EXEC_OACC_SET: + if (co->ext.omp_clauses) + WALK_SUBEXPR (co->ext.omp_clauses->device_num_expr); + break; + default: break; } diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 48ddd9a72d5..a5b2e035c84 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -273,6 +273,7 @@ enum gfc_statement ST_OACC_SERIAL_LOOP, ST_OACC_END_SERIAL_LOOP, ST_OACC_SERIAL, ST_OACC_END_SERIAL, ST_OACC_ENTER_DATA, ST_OACC_EXIT_DATA, ST_OACC_ROUTINE, ST_OACC_ATOMIC, ST_OACC_END_ATOMIC, + ST_OACC_INIT, ST_OACC_SHUTDOWN, ST_OACC_SET, ST_OMP_ATOMIC, ST_OMP_BARRIER, ST_OMP_CRITICAL, ST_OMP_END_ATOMIC, ST_OMP_END_CRITICAL, ST_OMP_END_DO, ST_OMP_END_MASTER, ST_OMP_END_ORDERED, ST_OMP_END_PARALLEL, ST_OMP_END_PARALLEL_DO, ST_OMP_END_PARALLEL_SECTIONS, @@ -1770,12 +1771,14 @@ typedef struct gfc_omp_clauses struct gfc_expr *num_gangs_expr; struct gfc_expr *num_workers_expr; struct gfc_expr *vector_length_expr; + struct gfc_expr *device_num_expr; gfc_expr_list *wait_list; gfc_expr_list *tile_list; unsigned async:1, gang:1, worker:1, vector:1, seq:1, independent:1; unsigned par_auto:1, gang_static:1; unsigned if_present:1, finalize:1; unsigned nohost:1; + unsigned oacc_device_type:4, oacc_device_type_present:1; locus loc; } gfc_omp_clauses; @@ -3286,6 +3289,7 @@ enum gfc_exec_op EXEC_OACC_DATA, EXEC_OACC_HOST_DATA, EXEC_OACC_LOOP, EXEC_OACC_UPDATE, EXEC_OACC_WAIT, EXEC_OACC_CACHE, EXEC_OACC_ENTER_DATA, EXEC_OACC_EXIT_DATA, EXEC_OACC_ATOMIC, EXEC_OACC_DECLARE, + EXEC_OACC_INIT, EXEC_OACC_SHUTDOWN, EXEC_OACC_SET, EXEC_OMP_CRITICAL, EXEC_OMP_FIRST_OPENMP_EXEC = EXEC_OMP_CRITICAL, EXEC_OMP_DO, EXEC_OMP_FLUSH, EXEC_OMP_MASTER, EXEC_OMP_ORDERED, EXEC_OMP_PARALLEL, EXEC_OMP_PARALLEL_DO, diff --git a/gcc/fortran/match.h b/gcc/fortran/match.h index 0641e5a434c..43cc804225c 100644 --- a/gcc/fortran/match.h +++ b/gcc/fortran/match.h @@ -131,6 +131,9 @@ gfc_common_head *gfc_get_common (const char *, int); /* OpenACC directive matchers. */ match gfc_match_oacc_atomic (void); match gfc_match_oacc_cache (void); +match gfc_match_oacc_init (void); +match gfc_match_oacc_shutdown (void); +match gfc_match_oacc_set (void); match gfc_match_oacc_wait (void); match gfc_match_oacc_update (void); match gfc_match_oacc_declare (void); diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc index 3613dc8bd45..e559a2db0db 100644 --- a/gcc/fortran/openmp.cc +++ b/gcc/fortran/openmp.cc @@ -209,6 +209,7 @@ 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); + gfc_free_expr (c->device_num_expr); for (enum gfc_omp_list_type t = OMP_LIST_FIRST; t < OMP_LIST_NUM; t = gfc_omp_list_type (t + 1)) gfc_free_omp_namelist (c->lists[t], t); @@ -832,6 +833,73 @@ cleanup: return MATCH_ERROR; } +static int +match_oacc_device_type_kind (void) +{ + char name[GFC_MAX_SYMBOL_LEN + 1]; + + /* Since device_type arg accept * as all, + we need to check first the case when + the user inputs * as the parameter. */ + gfc_gobble_whitespace (); + name[0] = (char) gfc_next_char (); + + if (name[0] == '*') + return GOMP_DEVICE_NONE; + + /* If is not *, we try to match the + pre-defined names. */ + + match m = gfc_match (" %n ", name + 1); + + if (m != MATCH_YES) + return -1; + + if (strcmp (name ,"host") == 0) + return GOMP_DEVICE_HOST; + if (strcmp (name, "nvidia") == 0) + return GOMP_DEVICE_NVIDIA_PTX; + if (strcmp (name, "radeon") == 0) + return GOMP_DEVICE_GCN; + + return -1; +} + +static match +match_oacc_device_type (gfc_omp_clauses *c) +{ + locus old_loc = gfc_current_locus; + + int result = match_oacc_device_type_kind (); + match m; + + if (result == -1) + goto syntax; + + m = gfc_match_char (')', true); + + if (m != MATCH_YES) + goto single_argument; + + c->oacc_device_type = (unsigned) result; + c->oacc_device_type_present = 1; + + return MATCH_YES; + +single_argument: + gfc_error ("OpenACC %<DEVICE_TYPE%> clause only accepts one argument, " + "unexpected char at %C"); + goto cleanup; + +syntax: + gfc_error ("Syntax error in OpenACC %<DEVICE_TYPE%> argument at %C. Expected " + "host, radeon, nvidia or * as argument."); + +cleanup: + gfc_current_locus = old_loc; + return MATCH_ERROR; +} + static match match_omp_oacc_expr_list (const char *str, gfc_expr_list **list, bool allow_asterisk, bool is_omp) @@ -1182,6 +1250,7 @@ enum omp_mask2 OMP_CLAUSE_INTEROP, /* OpenMP 5.1 */ OMP_CLAUSE_LOCAL, /* OpenMP 6.0 */ OMP_CLAUSE_DYN_GROUPPRIVATE, /* OpenMP 6.1 */ + OMP_CLAUSE_DEVICE_NUM, /* This must come last. */ OMP_MASK2_LAST }; @@ -3156,7 +3225,12 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, OMP_MAP_FORCE_DEVICEPTR, false, allow_derived)) continue; - if ((mask & OMP_CLAUSE_DEVICE_TYPE) + if ((mask & OMP_CLAUSE_DEVICE_TYPE) && openacc + && gfc_match_dupl_check (!c->oacc_device_type_present, + "device_type", true) == MATCH_YES + && match_oacc_device_type (c) == MATCH_YES) + continue; + if ((mask & OMP_CLAUSE_DEVICE_TYPE) && !openacc && gfc_match_dupl_check (c->device_type == OMP_DEVICE_TYPE_UNSET, "device_type", true) == MATCH_YES) { @@ -3175,6 +3249,16 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, break; continue; } + if ((mask & OMP_CLAUSE_DEVICE_NUM) + && (m = gfc_match_dupl_check (!c->device_num_expr, + "device_num")) != MATCH_NO) + { + if (m == MATCH_ERROR) + goto error; + if (gfc_match ("( %e )", &c->device_num_expr) != MATCH_YES) + goto error; + continue; + } if ((mask & OMP_CLAUSE_DEVICE_RESIDENT) && gfc_match_omp_variable_list ("device_resident (", @@ -5007,6 +5091,12 @@ error: (omp_mask (OMP_CLAUSE_GANG) | OMP_CLAUSE_WORKER | OMP_CLAUSE_VECTOR \ | OMP_CLAUSE_SEQ \ | OMP_CLAUSE_NOHOST) +#define OACC_INIT_CLAUSES \ + (omp_mask (OMP_CLAUSE_IF) | OMP_CLAUSE_DEVICE_NUM | OMP_CLAUSE_DEVICE_TYPE) +#define OACC_SHUTDOWN_CLAUSES \ + (omp_mask (OMP_CLAUSE_IF) | OMP_CLAUSE_DEVICE_NUM | OMP_CLAUSE_DEVICE_TYPE) +#define OACC_SET_CLAUSES \ + (omp_mask (OMP_CLAUSE_IF) | OMP_CLAUSE_DEVICE_NUM | OMP_CLAUSE_DEVICE_TYPE) static match @@ -5301,6 +5391,24 @@ gfc_match_oacc_cache (void) return MATCH_YES; } +match +gfc_match_oacc_init (void) +{ + return match_acc (EXEC_OACC_INIT, OACC_INIT_CLAUSES); +} + +match +gfc_match_oacc_shutdown (void) +{ + return match_acc (EXEC_OACC_SHUTDOWN, OACC_SHUTDOWN_CLAUSES); +} + +match +gfc_match_oacc_set (void) +{ + return match_acc (EXEC_OACC_SET, OACC_SET_CLAUSES); +} + /* Determine the OpenACC 'routine' directive's level of parallelism. */ static oacc_routine_lop @@ -11386,6 +11494,13 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, if (omp_clauses->async) if (omp_clauses->async_expr) resolve_scalar_int_expr (omp_clauses->async_expr, "ASYNC"); + if (omp_clauses->device_num_expr) + resolve_scalar_int_expr (omp_clauses->device_num_expr, "DEVICE_NUM"); + if (code && code->op == EXEC_OACC_SET + && !omp_clauses->device_num_expr + && !omp_clauses->oacc_device_type_present) + gfc_error ("At least one of the clauses %<DEVICE_TYPE%> and %<DEVICE_NUM%> " + "should be present in %<SET%> directive at %L", &code->loc); if (omp_clauses->num_gangs_expr) resolve_positive_int_expr (omp_clauses->num_gangs_expr, "NUM_GANGS"); if (omp_clauses->num_workers_expr) @@ -13638,6 +13753,12 @@ oacc_code_to_statement (gfc_code *code) return ST_OACC_EXIT_DATA; case EXEC_OACC_DECLARE: return ST_OACC_DECLARE; + case EXEC_OACC_INIT: + return ST_OACC_INIT; + case EXEC_OACC_SHUTDOWN: + return ST_OACC_SHUTDOWN; + case EXEC_OACC_SET: + return ST_OACC_SET; default: gcc_unreachable (); } @@ -13971,6 +14092,9 @@ gfc_resolve_oacc_directive (gfc_code *code, gfc_namespace *ns ATTRIBUTE_UNUSED) case EXEC_OACC_EXIT_DATA: case EXEC_OACC_WAIT: case EXEC_OACC_CACHE: + case EXEC_OACC_INIT: + case EXEC_OACC_SHUTDOWN: + case EXEC_OACC_SET: resolve_omp_clauses (code, code->ext.omp_clauses, NULL, true); break; case EXEC_OACC_PARALLEL_LOOP: diff --git a/gcc/fortran/parse.cc b/gcc/fortran/parse.cc index 7b6cf525a80..eeb98865513 100644 --- a/gcc/fortran/parse.cc +++ b/gcc/fortran/parse.cc @@ -790,6 +790,9 @@ decode_oacc_directive (void) case 'h': matcha ("host_data", gfc_match_oacc_host_data, ST_OACC_HOST_DATA); break; + case 'i': + matcha ("init", gfc_match_oacc_init, ST_OACC_INIT); + break; case 'p': matcha ("parallel loop", gfc_match_oacc_parallel_loop, ST_OACC_PARALLEL_LOOP); @@ -806,6 +809,8 @@ decode_oacc_directive (void) case 's': matcha ("serial loop", gfc_match_oacc_serial_loop, ST_OACC_SERIAL_LOOP); matcha ("serial", gfc_match_oacc_serial, ST_OACC_SERIAL); + matcha ("set", gfc_match_oacc_set, ST_OACC_SET); + matcha ("shutdown", gfc_match_oacc_shutdown, ST_OACC_SHUTDOWN); break; case 'u': matcha ("update", gfc_match_oacc_update, ST_OACC_UPDATE); @@ -1975,7 +1980,8 @@ next_statement (void) case ST_FORM_TEAM: case ST_SYNC_TEAM: \ case ST_EVENT_POST: case ST_EVENT_WAIT: case ST_FAIL_IMAGE: \ case ST_OACC_UPDATE: case ST_OACC_WAIT: case ST_OACC_CACHE: \ - case ST_OACC_ENTER_DATA: case ST_OACC_EXIT_DATA + case ST_OACC_ENTER_DATA: case ST_OACC_EXIT_DATA: \ + case ST_OACC_INIT: case ST_OACC_SHUTDOWN: case ST_OACC_SET /* Statements that mark other executable statements. */ @@ -2692,6 +2698,15 @@ gfc_ascii_statement (gfc_statement st, bool strip_sentinel) case ST_OACC_END_ATOMIC: p = "!$ACC END ATOMIC"; break; + case ST_OACC_INIT: + p = "!ACC INIT"; + break; + case ST_OACC_SHUTDOWN: + p = "!ACC SHUTDOWN"; + break; + case ST_OACC_SET: + p = "!ACC SET"; + break; case ST_OMP_ALLOCATE: case ST_OMP_ALLOCATE_EXEC: p = "!$OMP ALLOCATE"; @@ -8039,6 +8054,9 @@ is_oacc (gfc_state_data *sd) case EXEC_OACC_EXIT_DATA: case EXEC_OACC_ATOMIC: case EXEC_OACC_ROUTINE: + case EXEC_OACC_INIT: + case EXEC_OACC_SHUTDOWN: + case EXEC_OACC_SET: return true; default: diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc index 036da9a939e..389a7451619 100644 --- a/gcc/fortran/resolve.cc +++ b/gcc/fortran/resolve.cc @@ -13053,6 +13053,9 @@ gfc_resolve_blocks (gfc_code *b, gfc_namespace *ns) case EXEC_OACC_ENTER_DATA: case EXEC_OACC_EXIT_DATA: case EXEC_OACC_ROUTINE: + case EXEC_OACC_INIT: + case EXEC_OACC_SHUTDOWN: + case EXEC_OACC_SET: case EXEC_OMP_ALLOCATE: case EXEC_OMP_ALLOCATORS: case EXEC_OMP_ASSUME: @@ -14839,6 +14842,9 @@ start: case EXEC_OACC_EXIT_DATA: case EXEC_OACC_ATOMIC: case EXEC_OACC_DECLARE: + case EXEC_OACC_INIT: + case EXEC_OACC_SHUTDOWN: + case EXEC_OACC_SET: gfc_resolve_oacc_directive (code, ns); break; diff --git a/gcc/fortran/st.cc b/gcc/fortran/st.cc index 39711e32620..4c7e274b72a 100644 --- a/gcc/fortran/st.cc +++ b/gcc/fortran/st.cc @@ -221,6 +221,9 @@ gfc_free_statement (gfc_code *p) case EXEC_OACC_ENTER_DATA: case EXEC_OACC_EXIT_DATA: case EXEC_OACC_ROUTINE: + case EXEC_OACC_INIT: + case EXEC_OACC_SHUTDOWN: + case EXEC_OACC_SET: case EXEC_OMP_ALLOCATE: case EXEC_OMP_ALLOCATORS: case EXEC_OMP_ASSUME: diff --git a/gcc/fortran/trans-openmp.cc b/gcc/fortran/trans-openmp.cc index 31a84d51f16..3e4375f6d60 100644 --- a/gcc/fortran/trans-openmp.cc +++ b/gcc/fortran/trans-openmp.cc @@ -6412,6 +6412,10 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, /* OpenACC 'nohost' clauses cannot appear here. */ gcc_checking_assert (!clauses->nohost); + /* OpenACC 'device_num' and 'device_type' clauses cannot appear here. */ + gcc_checking_assert (!clauses->device_num_expr + && !clauses->oacc_device_type_present); + return nreverse (omp_clauses); } @@ -6482,7 +6486,7 @@ gfc_trans_oacc_construct (gfc_code *code) return gfc_finish_block (&block); } -/* update, enter_data, exit_data, cache. */ +/* update, enter_data, exit_data, cache, init, set, shutdown. */ static tree gfc_trans_oacc_executable_directive (gfc_code *code) { @@ -6504,6 +6508,10 @@ gfc_trans_oacc_executable_directive (gfc_code *code) case EXEC_OACC_CACHE: construct_code = OACC_CACHE; break; + case EXEC_OACC_INIT: + case EXEC_OACC_SHUTDOWN: + case EXEC_OACC_SET: + goto builtin_oacc_exec_directive; default: gcc_unreachable (); } @@ -6515,6 +6523,67 @@ gfc_trans_oacc_executable_directive (gfc_code *code) oacc_clauses); gfc_add_expr_to_block (&block, stmt); return gfc_finish_block (&block); + +builtin_oacc_exec_directive: + + enum built_in_function builtin_code; + + switch (code->op) + { + case EXEC_OACC_INIT: + builtin_code = BUILT_IN_GOACC_INIT; + break; + case EXEC_OACC_SHUTDOWN: + builtin_code = BUILT_IN_GOACC_SHUTDOWN; + break; + case EXEC_OACC_SET: + builtin_code = BUILT_IN_GOACC_SET_DEVICE; + break; + default: + gcc_unreachable (); + } + + location_t loc = input_location; + gfc_omp_clauses *clauses = code->ext.omp_clauses; + + gfc_start_block (&block); + + tree n_device; + if (clauses->device_num_expr) + n_device = gfc_convert_expr_to_tree (&block, clauses->device_num_expr); + else + /* no 'device_num' clause specified by + the user, we don't modify the value of ICV + 'acc-current-device-num-var' or we do not + take any action in init and shutdown directive + using -1 value. */ + n_device = build_int_cst (integer_type_node, -1); + + /* GOMP_DEVICE_NONE is used to make the operation + in all the devices. + + GOMP_DEVICE_DEFAULT is used in set directive + to do nothing if the clause do not appear. */ + int device_type = code->op == EXEC_OACC_SET ? + GOMP_DEVICE_DEFAULT : + GOMP_DEVICE_NONE; + if (clauses->oacc_device_type_present) + device_type = clauses->oacc_device_type; + + tree d_type = build_int_cst (integer_type_node, device_type); + + stmt = builtin_decl_explicit (builtin_code); + + stmt = build_call_expr_loc (loc, stmt, 2, n_device, d_type); + + if (clauses->if_expr) + stmt = build3_loc (input_location, COND_EXPR, void_type_node, + gfc_convert_expr_to_tree (&block, clauses->if_expr), + stmt, NULL_TREE); + + gfc_add_expr_to_block (&block, stmt); + + return gfc_finish_block (&block); } static tree @@ -9893,6 +9962,9 @@ gfc_trans_oacc_directive (gfc_code *code) case EXEC_OACC_CACHE: case EXEC_OACC_ENTER_DATA: case EXEC_OACC_EXIT_DATA: + case EXEC_OACC_INIT: + case EXEC_OACC_SHUTDOWN: + case EXEC_OACC_SET: return gfc_trans_oacc_executable_directive (code); case EXEC_OACC_WAIT: return gfc_trans_oacc_wait_directive (code); diff --git a/gcc/fortran/trans.cc b/gcc/fortran/trans.cc index 7418b811a72..cf37261673c 100644 --- a/gcc/fortran/trans.cc +++ b/gcc/fortran/trans.cc @@ -2685,6 +2685,9 @@ trans_code (gfc_code * code, tree cond) case EXEC_OACC_EXIT_DATA: case EXEC_OACC_ATOMIC: case EXEC_OACC_DECLARE: + case EXEC_OACC_INIT: + case EXEC_OACC_SHUTDOWN: + case EXEC_OACC_SET: res = gfc_trans_oacc_directive (code); break; diff --git a/gcc/fortran/types.def b/gcc/fortran/types.def index eb253d8970e..73a1e0cd734 100644 --- a/gcc/fortran/types.def +++ b/gcc/fortran/types.def @@ -125,6 +125,7 @@ DEF_FUNCTION_TYPE_2 (BT_FN_VOID_CONST_PTR_SIZE, BT_VOID, BT_CONST_PTR, BT_SIZE) DEF_FUNCTION_TYPE_2 (BT_FN_PTR_CONST_PTR_INT, BT_PTR, BT_CONST_PTR, BT_INT) DEF_FUNCTION_TYPE_2 (BT_FN_VOID_ULONGLONG_ULONGLONG, BT_VOID, BT_ULONGLONG, BT_ULONGLONG) +DEF_FUNCTION_TYPE_2 (BT_FN_VOID_INT_INT, BT_VOID, BT_INT, BT_INT) DEF_POINTER_TYPE (BT_PTR_FN_VOID_PTR_PTR, BT_FN_VOID_PTR_PTR) diff --git a/gcc/omp-builtins.def b/gcc/omp-builtins.def index 8e6b6fb3acf..500cc32ab4d 100644 --- a/gcc/omp-builtins.def +++ b/gcc/omp-builtins.def @@ -51,6 +51,12 @@ DEF_GOACC_BUILTIN (BUILT_IN_GOACC_WAIT, "GOACC_wait", ATTR_NOTHROW_LIST) DEF_GOACC_BUILTIN (BUILT_IN_GOACC_DECLARE, "GOACC_declare", BT_FN_VOID_INT_SIZE_PTR_PTR_PTR, ATTR_NOTHROW_LIST) +DEF_GOACC_BUILTIN (BUILT_IN_GOACC_INIT, "GOACC_init", + BT_FN_VOID_INT_INT, ATTR_NOTHROW_LIST) +DEF_GOACC_BUILTIN (BUILT_IN_GOACC_SHUTDOWN, "GOACC_shutdown", + BT_FN_VOID_INT_INT, ATTR_NOTHROW_LIST) +DEF_GOACC_BUILTIN (BUILT_IN_GOACC_SET_DEVICE, "GOACC_set_device", + BT_FN_VOID_INT_INT, ATTR_NOTHROW_LIST) DEF_GOACC_BUILTIN_COMPILER (BUILT_IN_ACC_ON_DEVICE, "acc_on_device", BT_FN_INT_INT, ATTR_CONST_NOTHROW_LEAF_LIST) diff --git a/gcc/testsuite/gfortran.dg/goacc/acc-init-1.f90 b/gcc/testsuite/gfortran.dg/goacc/acc-init-1.f90 new file mode 100644 index 00000000000..931cce7a924 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/goacc/acc-init-1.f90 @@ -0,0 +1,47 @@ +! Test parsing and lowering of the OpenACC init directive. + +! { dg-do compile } +! { dg-additional-options "-fdump-tree-original" } + +subroutine init0 + implicit none + !$acc init +end subroutine init0 + +subroutine init1 + implicit none + !$acc init device_type(host) +end subroutine init1 + +subroutine init2 + implicit none + !$acc init device_type(nvidia) +end subroutine init2 + +subroutine init3 + implicit none + !$acc init device_num(0) +end subroutine init3 + +subroutine init4 + implicit none + !$acc init device_type(host) device_num(0) +end subroutine init4 + +subroutine init5 + implicit none + !$acc init if(.false.) +end subroutine init5 + +subroutine init6(l) + implicit none + logical, value :: l + !$acc init if(l) device_type(radeon) device_num(1) +end subroutine init6 + +! { dg-final { scan-tree-dump-times "__builtin_GOACC_init \\(-1, 0\\)" 2 "original" } } +! { dg-final { scan-tree-dump-times "__builtin_GOACC_init \\(-1, 2\\)" 1 "original" } } +! { dg-final { scan-tree-dump-times "__builtin_GOACC_init \\(-1, 5\\)" 1 "original" } } +! { dg-final { scan-tree-dump-times "__builtin_GOACC_init \\(0, 0\\)" 1 "original" } } +! { dg-final { scan-tree-dump-times "__builtin_GOACC_init \\(0, 2\\)" 1 "original" } } +! { dg-final { scan-tree-dump-times "__builtin_GOACC_init \\(1, 8\\)" 1 "original" } } diff --git a/gcc/testsuite/gfortran.dg/goacc/acc-init-clauses-1.f90 b/gcc/testsuite/gfortran.dg/goacc/acc-init-clauses-1.f90 new file mode 100644 index 00000000000..30c86a798ee --- /dev/null +++ b/gcc/testsuite/gfortran.dg/goacc/acc-init-clauses-1.f90 @@ -0,0 +1,28 @@ +! Test invalid clauses on the OpenACC init directive. + +! { dg-do compile } + +subroutine bad1 + implicit none + !$acc init device_type(doesnt_exist) ! { dg-error "Expected host, radeon, nvidia or \\\* as argument" } +end subroutine bad1 + +subroutine bad2 + implicit none + !$acc init device_type(nvidia, host) ! { dg-error "OpenACC 'DEVICE_TYPE' clause only accepts one argument" } +end subroutine bad2 + +subroutine bad3 + implicit none + !$acc init if_present ! { dg-error "Failed to match clause" } +end subroutine bad3 + +subroutine bad4 + implicit none + !$acc init async ! { dg-error "Failed to match clause" } +end subroutine bad4 + +subroutine bad5 + implicit none + !$acc init wait ! { dg-error "Failed to match clause" } +end subroutine bad5 diff --git a/gcc/testsuite/gfortran.dg/goacc/acc-set-1.f90 b/gcc/testsuite/gfortran.dg/goacc/acc-set-1.f90 new file mode 100644 index 00000000000..013c301c775 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/goacc/acc-set-1.f90 @@ -0,0 +1,36 @@ +! Test parsing and lowering of the OpenACC set directive. + +! { dg-do compile } +! { dg-additional-options "-fdump-tree-original" } + +subroutine set0 + implicit none + !$acc set device_type(host) +end subroutine set0 + +subroutine set1 + implicit none + !$acc set device_type(nvidia) +end subroutine set1 + +subroutine set2 + implicit none + !$acc set device_num(0) +end subroutine set2 + +subroutine set3 + implicit none + !$acc set device_type(host) device_num(0) +end subroutine set3 + +subroutine set4(l) + implicit none + logical, value :: l + !$acc set if(l) device_type(radeon) device_num(1) +end subroutine set4 + +! { dg-final { scan-tree-dump-times "__builtin_GOACC_set_device \\(-1, 2\\)" 1 "original" } } +! { dg-final { scan-tree-dump-times "__builtin_GOACC_set_device \\(-1, 5\\)" 1 "original" } } +! { dg-final { scan-tree-dump-times "__builtin_GOACC_set_device \\(0, 1\\)" 1 "original" } } +! { dg-final { scan-tree-dump-times "__builtin_GOACC_set_device \\(0, 2\\)" 1 "original" } } +! { dg-final { scan-tree-dump-times "__builtin_GOACC_set_device \\(1, 8\\)" 1 "original" } } diff --git a/gcc/testsuite/gfortran.dg/goacc/acc-set-clauses-1.f90 b/gcc/testsuite/gfortran.dg/goacc/acc-set-clauses-1.f90 new file mode 100644 index 00000000000..9ed31a0fea2 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/goacc/acc-set-clauses-1.f90 @@ -0,0 +1,58 @@ +! Test invalid clauses on the OpenACC set directive. + +! { dg-do compile } + +subroutine bad1 + implicit none + !$acc set device_type(doesnt_exist) ! { dg-error "Expected host, radeon, nvidia or \\* as argument" } +end subroutine bad1 + +subroutine bad2 + implicit none + !$acc set device_type(nvidia, host) ! { dg-error "OpenACC 'DEVICE_TYPE' clause only accepts one argument" } +end subroutine bad2 + +subroutine bad3 + implicit none + !$acc set ! { dg-error "At least one of the clauses 'DEVICE_TYPE' and 'DEVICE_NUM' should be present in 'SET' directive" } +end subroutine bad3 + +subroutine bad4 + implicit none + !$acc set if(.true.) ! { dg-error "At least one of the clauses 'DEVICE_TYPE' and 'DEVICE_NUM' should be present in 'SET' directive" } +end subroutine bad4 + +subroutine bad5 + implicit none + !$acc set default_async(0) ! { dg-error "Failed to match clause" } +end subroutine bad5 + +subroutine bad6 + implicit none + !$acc set if_present ! { dg-error "Failed to match clause" } +end subroutine bad6 + +subroutine bad7 + implicit none + !$acc set async ! { dg-error "Failed to match clause" } +end subroutine bad7 + +subroutine bad8 + implicit none + !$acc set wait ! { dg-error "Failed to match clause" } +end subroutine bad8 + +subroutine bad9 + implicit none + !$acc set device_type(host) device_type(nvidia) ! { dg-error "Duplicated 'device_type' clause" } +end subroutine bad9 + +subroutine bad10 + implicit none + !$acc set device_num(0) device_num(1) ! { dg-error "Duplicated 'device_num' clause" } +end subroutine bad10 + +subroutine bad11 + implicit none + !$acc set if(.false.) if(.true.) ! { dg-error "Duplicated 'if' clause" } +end subroutine bad11 diff --git a/gcc/testsuite/gfortran.dg/goacc/acc-shutdown-1.f90 b/gcc/testsuite/gfortran.dg/goacc/acc-shutdown-1.f90 new file mode 100644 index 00000000000..72db24750f1 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/goacc/acc-shutdown-1.f90 @@ -0,0 +1,47 @@ +! Test parsing and lowering of the OpenACC shutdown directive. + +! { dg-do compile } +! { dg-additional-options "-fdump-tree-original" } + +subroutine shutdown0 + implicit none + !$acc shutdown +end subroutine shutdown0 + +subroutine shutdown1 + implicit none + !$acc shutdown device_type(host) +end subroutine shutdown1 + +subroutine shutdown2 + implicit none + !$acc shutdown device_type(nvidia) +end subroutine shutdown2 + +subroutine shutdown3 + implicit none + !$acc shutdown device_num(0) +end subroutine shutdown3 + +subroutine shutdown4 + implicit none + !$acc shutdown device_type(host) device_num(0) +end subroutine shutdown4 + +subroutine shutdown5 + implicit none + !$acc shutdown if(.false.) +end subroutine shutdown5 + +subroutine shutdown6(l) + implicit none + logical, value :: l + !$acc shutdown if(l) device_type(radeon) device_num(1) +end subroutine shutdown6 + +! { dg-final { scan-tree-dump-times "__builtin_GOACC_shutdown \\(-1, 0\\)" 2 "original" } } +! { dg-final { scan-tree-dump-times "__builtin_GOACC_shutdown \\(-1, 2\\)" 1 "original" } } +! { dg-final { scan-tree-dump-times "__builtin_GOACC_shutdown \\(-1, 5\\)" 1 "original" } } +! { dg-final { scan-tree-dump-times "__builtin_GOACC_shutdown \\(0, 0\\)" 1 "original" } } +! { dg-final { scan-tree-dump-times "__builtin_GOACC_shutdown \\(0, 2\\)" 1 "original" } } +! { dg-final { scan-tree-dump-times "__builtin_GOACC_shutdown \\(1, 8\\)" 1 "original" } } diff --git a/gcc/testsuite/gfortran.dg/goacc/acc-shutdown-clauses-1.f90 b/gcc/testsuite/gfortran.dg/goacc/acc-shutdown-clauses-1.f90 new file mode 100644 index 00000000000..242d05a5e67 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/goacc/acc-shutdown-clauses-1.f90 @@ -0,0 +1,43 @@ +! Test invalid clauses on the OpenACC shutdown directive. + +! { dg-do compile } + +subroutine bad1 + implicit none + !$acc shutdown device_type(doesnt_exist) ! { dg-error "Expected host, radeon, nvidia or \\* as argument" } +end subroutine bad1 + +subroutine bad2 + implicit none + !$acc shutdown device_type(nvidia, host) ! { dg-error "OpenACC 'DEVICE_TYPE' clause only accepts one argument" } +end subroutine bad2 + +subroutine bad3 + implicit none + !$acc shutdown if_present ! { dg-error "Failed to match clause" } +end subroutine bad3 + +subroutine bad4 + implicit none + !$acc shutdown async ! { dg-error "Failed to match clause" } +end subroutine bad4 + +subroutine bad5 + implicit none + !$acc shutdown wait ! { dg-error "Failed to match clause" } +end subroutine bad5 + +subroutine bad6 + implicit none + !$acc shutdown device_type(host) device_type(nvidia) ! { dg-error "Duplicated 'device_type' clause" } +end subroutine bad6 + +subroutine bad7 + implicit none + !$acc shutdown device_num(0) device_num(1) ! { dg-error "Duplicated 'device_num' clause" } +end subroutine bad7 + +subroutine bad8 + implicit none + !$acc shutdown if(.false.) if(.true.) ! { dg-error "Duplicated 'if' clause" } +end subroutine bad8 diff --git a/gcc/testsuite/gfortran.dg/goacc/uninit-if-clause.f95 b/gcc/testsuite/gfortran.dg/goacc/uninit-if-clause.f95 index 940fe841c20..89301af4785 100644 --- a/gcc/testsuite/gfortran.dg/goacc/uninit-if-clause.f95 +++ b/gcc/testsuite/gfortran.dg/goacc/uninit-if-clause.f95 @@ -3,12 +3,13 @@ program test implicit none - logical :: b, b2, bs, b3, b4 + logical :: b, b2, bs, b3, b4, b5 ! { dg-note {'b' was declared here} {} { target *-*-* } .-1 } ! { dg-note {'b2' was declared here} {} { target *-*-* } .-2 } ! { dg-note {'bs' was declared here} {} { target *-*-* } .-3 } ! { dg-note {'b3' was declared here} {} { target *-*-* } .-4 } ! { dg-note {'b4' was declared here} {} { target *-*-* } .-5 } + ! { dg-note {'b5' was declared here} {} { target *-*-* } .-6 } integer :: data, data2 !$acc parallel if(b) ! { dg-warning "is used uninitialized" } @@ -25,4 +26,6 @@ program test !$acc update if(b4) self(data2) ! { dg-warning "is used uninitialized" } + !$acc init if(b5) ! { dg-warning "is used uninitialized" } + end program test diff --git a/gcc/testsuite/gfortran.dg/goacc/update-if_present-2.f90 b/gcc/testsuite/gfortran.dg/goacc/update-if_present-2.f90 index 41c2657b536..9a350a8c845 100644 --- a/gcc/testsuite/gfortran.dg/goacc/update-if_present-2.f90 +++ b/gcc/testsuite/gfortran.dg/goacc/update-if_present-2.f90 @@ -20,8 +20,8 @@ subroutine t1 !$acc declare link(a) if_present ! { dg-error "Unexpected junk after" } - !$acc init if_present ! { dg-error "Unclassifiable OpenACC directive" } - !$acc shutdown if_present ! { dg-error "Unclassifiable OpenACC directive" } + !$acc init if_present ! { dg-error "Failed to match clause" } + !$acc shutdown if_present ! { dg-error "Failed to match clause" } !$acc update self(a) device_type(nvidia) device(b) if_present ! { dg-error "Failed to match clause" } end subroutine t1 diff --git a/libgomp/libgomp.map b/libgomp/libgomp.map index 8a59d4965b3..00e47d65d4c 100644 --- a/libgomp/libgomp.map +++ b/libgomp/libgomp.map @@ -691,6 +691,13 @@ GOACC_2.0.2 { GOACC_exit_data; } GOACC_2.0.1; +GOACC_2.5 { + global: + GOACC_init; + GOACC_shutdown; + GOACC_set_device; +} GOACC_2.0.2; + GOMP_PLUGIN_1.0 { global: GOMP_PLUGIN_malloc; diff --git a/libgomp/libgomp_g.h b/libgomp/libgomp_g.h index f5f1d8e677b..9caf9c3571b 100644 --- a/libgomp/libgomp_g.h +++ b/libgomp/libgomp_g.h @@ -413,6 +413,12 @@ extern void GOMP_error (const char *, size_t); extern void GOACC_wait (int, int, ...); +/* oacc-init.c */ + +extern void GOACC_init (int, int); +extern void GOACC_shutdown (int, int); +extern void GOACC_set_device (int, int); + /* oacc-mem.c */ extern void GOACC_enter_exit_data (int, size_t, void **, size_t *, diff --git a/libgomp/oacc-init.c b/libgomp/oacc-init.c index bfd50bf39a5..b9e6d405b0b 100644 --- a/libgomp/oacc-init.c +++ b/libgomp/oacc-init.c @@ -69,6 +69,10 @@ static gomp_mutex_t goacc_thread_lock; grouped by device in target.c:devices). */ static struct gomp_device_descr *dispatchers[_ACC_device_hwm] = { 0 }; +/* Device types for init and shutdown directives to check all devices. */ +#define GOACC_DIRECTIVE_DEVICE_MASK \ + ((1 << acc_device_host) | (1 << acc_device_nvidia) | (1 << acc_device_radeon)) + attribute_hidden void goacc_register (struct gomp_device_descr *disp) { @@ -231,7 +235,8 @@ acc_dev_num_out_of_range (acc_device_t d, int ord, int ndevs) held before calling this function. */ static struct gomp_device_descr * -acc_init_1 (acc_device_t d, acc_construct_t parent_construct, int implicit) +acc_init_1 (acc_device_t d, acc_construct_t parent_construct, int implicit, + int dev_num) { gomp_mutex_lock (&acc_init_state_lock); acc_init_state = initializing; @@ -304,10 +309,12 @@ acc_init_1 (acc_device_t d, acc_construct_t parent_construct, int implicit) ndevs = base_dev->get_num_devices_func (); - if (ndevs <= 0 || goacc_device_num >= ndevs) - acc_dev_num_out_of_range (d, goacc_device_num, ndevs); + dev_num = (dev_num == -1 ? goacc_device_num : dev_num); - acc_dev = &base_dev[goacc_device_num]; + if (ndevs <= 0 || dev_num >= ndevs) + acc_dev_num_out_of_range (d, dev_num, ndevs); + + acc_dev = &base_dev[dev_num]; gomp_mutex_lock (&acc_dev->lock); if (acc_dev->state == GOMP_DEVICE_INITIALIZED) @@ -341,7 +348,7 @@ acc_init_1 (acc_device_t d, acc_construct_t parent_construct, int implicit) /* ACC_DEVICE_LOCK must be held before calling this function. */ static void -acc_shutdown_1 (acc_device_t d) +acc_shutdown_1 (acc_device_t d, int dev_num) { struct gomp_device_descr *base_dev; struct goacc_thread *walk; @@ -353,21 +360,42 @@ acc_shutdown_1 (acc_device_t d) ndevs = base_dev->get_num_devices_func (); - /* Unload all the devices of this type that have been opened. */ - for (i = 0; i < ndevs; i++) - { - struct gomp_device_descr *acc_dev = &base_dev[i]; + if (dev_num != -1 && ndevs <= dev_num) + acc_dev_num_out_of_range (d, dev_num, ndevs); + if (dev_num != -1) + { + struct gomp_device_descr *acc_dev = &base_dev[dev_num]; gomp_mutex_lock (&acc_dev->lock); gomp_unload_device (acc_dev); gomp_mutex_unlock (&acc_dev->lock); } - + else + { + /* Unload all the devices of this type that have been opened. */ + for (i = 0; i < ndevs; i++) + { + struct gomp_device_descr *acc_dev = &base_dev[i]; + + gomp_mutex_lock (&acc_dev->lock); + gomp_unload_device (acc_dev); + gomp_mutex_unlock (&acc_dev->lock); + } + } + gomp_mutex_lock (&goacc_thread_lock); /* Free target-specific TLS data and close all devices. */ for (walk = goacc_threads; walk != NULL; walk = walk->next) { + /* These checks are necessary since init supports + * multiples devices. */ + if (walk->base_dev != base_dev) + continue; + + if (dev_num != -1 && walk->dev != &base_dev[dev_num]) + continue; + if (walk->target_tls) base_dev->openacc.destroy_thread_data_func (walk->target_tls); @@ -409,20 +437,38 @@ acc_shutdown_1 (acc_device_t d) gomp_mutex_unlock (&goacc_thread_lock); - /* Close all the devices of this type that have been opened. */ bool ret = true; - for (i = 0; i < ndevs; i++) + + if (dev_num != -1) { - struct gomp_device_descr *acc_dev = &base_dev[i]; + struct gomp_device_descr *acc_dev = &base_dev[dev_num]; gomp_mutex_lock (&acc_dev->lock); + if (acc_dev->state == GOMP_DEVICE_INITIALIZED) - { + { devices_active = true; ret &= gomp_fini_device (acc_dev); acc_dev->state = GOMP_DEVICE_UNINITIALIZED; } + gomp_mutex_unlock (&acc_dev->lock); } + else + { + /* Close all the devices of this type that have been opened. */ + for (i = 0; i < ndevs; i++) + { + struct gomp_device_descr *acc_dev = &base_dev[i]; + gomp_mutex_lock (&acc_dev->lock); + if (acc_dev->state == GOMP_DEVICE_INITIALIZED) + { + devices_active = true; + ret &= gomp_fini_device (acc_dev); + acc_dev->state = GOMP_DEVICE_UNINITIALIZED; + } + gomp_mutex_unlock (&acc_dev->lock); + } + } if (!ret) gomp_fatal ("device finalization failed"); @@ -541,6 +587,109 @@ goacc_attach_host_thread_to_device (int ord) = acc_dev->openacc.create_thread_data_func (ord); } +void +GOACC_init (int n_device, int d) +{ + /* The OpenACC spec says that if the n_device isn't specified + then all the devices available are initializated, but + the current acc_init_1 implementation initialize just the + goacc_device_num device number. acc_init_1 it's keeped + because the profiling dispatch code. */ + + gomp_init_targets_once (); + /* All the device types. */ + if ((acc_device_t) d == acc_device_none) + { + int i; + for (i = 0; i < _ACC_device_hwm; i++) + { + if (!(GOACC_DIRECTIVE_DEVICE_MASK & (1 << i))) + continue; + gomp_mutex_lock (&acc_device_lock); + + struct gomp_device_descr *dev + = resolve_device ((acc_device_t) i, false); + if (!dev || dev->get_num_devices_func () <= 0) + { + gomp_debug (0, + "init directive: Device type %s isn't available or " + "does not have devices.\n", + name_of_acc_device_t ((acc_device_t) i)); + /* if isn't available, just continue. */ + gomp_mutex_unlock (&acc_device_lock); + continue; + } + + gomp_debug (0, + "init directive: Initializing device type %s and device " + "number %d. \n", + name_of_acc_device_t ((acc_device_t) i), n_device); + cached_base_dev + = acc_init_1 ((acc_device_t) i, acc_construct_init, 0, n_device); + gomp_mutex_unlock (&acc_device_lock); + } + } + else + { + gomp_debug ( + 0, "init directive: Initializing device type %s and device number %d\n", + name_of_acc_device_t ((acc_device_t) d), n_device); + + gomp_mutex_lock (&acc_device_lock); + cached_base_dev + = acc_init_1 ((acc_device_t) d, acc_construct_init, 0, n_device); + gomp_mutex_unlock (&acc_device_lock); + + goacc_attach_host_thread_to_device (-1); + } +} + +void +GOACC_shutdown (int n_device, int d) +{ + gomp_init_targets_once (); + + if ((acc_device_t) d == acc_device_none) + { + int i; + for (i = 0; i < _ACC_device_hwm; i++) + { + if (!(GOACC_DIRECTIVE_DEVICE_MASK & (1 << i))) + continue; + + gomp_mutex_lock (&acc_device_lock); + + struct gomp_device_descr *dev + = resolve_device ((acc_device_t) i, false); + + if (!dev || dev->get_num_devices_func () <= 0) + { + gomp_mutex_unlock (&acc_device_lock); + continue; + } + + acc_shutdown_1 ((acc_device_t) i, n_device); + + gomp_mutex_unlock (&acc_device_lock); + } + } + else + { + gomp_mutex_lock (&acc_device_lock); + + acc_shutdown_1 ((acc_device_t) d, n_device); + + gomp_mutex_unlock (&acc_device_lock); + } +} + +void +GOACC_set_device (int n_device, int d) +{ + acc_set_device_type ((acc_device_t) d); + acc_set_device_num (n_device, (acc_device_t) d); +} + /* OpenACC 2.0a (3.2.12, 3.2.13) doesn't specify whether the serialization of init/shutdown is per-process or per-thread. We choose per-process. */ @@ -553,7 +702,7 @@ acc_init (acc_device_t d) gomp_init_targets_once (); gomp_mutex_lock (&acc_device_lock); - cached_base_dev = acc_init_1 (d, acc_construct_runtime_api, 0); + cached_base_dev = acc_init_1 (d, acc_construct_runtime_api, 0, -1); gomp_mutex_unlock (&acc_device_lock); goacc_attach_host_thread_to_device (-1); @@ -569,7 +718,7 @@ acc_shutdown (acc_device_t d) gomp_mutex_lock (&acc_device_lock); - acc_shutdown_1 (d); + acc_shutdown_1 (d, -1); gomp_mutex_unlock (&acc_device_lock); } @@ -926,8 +1075,8 @@ goacc_lazy_initialize (void) gomp_mutex_lock (&acc_device_lock); if (!cached_base_dev) - cached_base_dev = acc_init_1 (acc_device_default, - acc_construct_parallel, 1); + cached_base_dev + = acc_init_1 (acc_device_default, acc_construct_parallel, 1, -1); gomp_mutex_unlock (&acc_device_lock); goacc_attach_host_thread_to_device (-1); diff --git a/libgomp/testsuite/libgomp.oacc-fortran/init-1.f90 b/libgomp/testsuite/libgomp.oacc-fortran/init-1.f90 new file mode 100644 index 00000000000..e33c4cb30ea --- /dev/null +++ b/libgomp/testsuite/libgomp.oacc-fortran/init-1.f90 @@ -0,0 +1,59 @@ +! { dg-do run } +! +! Test the OpenACC init directive at run time. + +use openacc + +implicit none + +logical :: l +integer :: n + +if (acc_get_num_devices (acc_device_host) .ne. 1) stop 1 + +!$acc init +!$acc shutdown + +!$acc init device_type(host) + +if (acc_get_device_type () .ne. acc_device_host) stop 2 +if (acc_get_device_num (acc_device_host) .ne. 0) stop 3 + +!$acc shutdown device_type(host) + +!$acc init device_type(host) device_num(0) + +if (acc_get_device_type () .ne. acc_device_host) stop 4 +if (acc_get_device_num (acc_device_host) .ne. 0) stop 5 + +!$acc shutdown device_type(host) + +l = .true. +!$acc init if (l) device_type(host) + +if (acc_get_device_type () .ne. acc_device_host) stop 6 + +!$acc shutdown device_type(host) + +n = acc_get_num_devices (acc_device_default) +!$acc init if (.false.) device_num(n) + +if (acc_get_num_devices (acc_device_nvidia) .ne. 0) then + l = .true. + !$acc init if (l) device_type(nvidia) + l = .false. + !$acc init if (l) device_type(host) + if (acc_get_device_type () .ne. acc_device_nvidia) stop 7 + !$acc shutdown device_type(nvidia) +end if + +if (acc_get_num_devices (acc_device_radeon) .ne. 0) then + l = .true. + !$acc init if (l) device_type(radeon) + l = .false. + !$acc init if (l) device_type(host) + if (acc_get_device_type () .ne. acc_device_radeon) stop 8 + !$acc shutdown device_type(radeon) +end if + +end diff --git a/libgomp/testsuite/libgomp.oacc-fortran/lib-1-directives.f90 b/libgomp/testsuite/libgomp.oacc-fortran/lib-1-directives.f90 new file mode 100644 index 00000000000..182b238f844 --- /dev/null +++ b/libgomp/testsuite/libgomp.oacc-fortran/lib-1-directives.f90 @@ -0,0 +1,17 @@ +! { dg-do run } +! +! Port of lib-1.f90 replacing applicable runtime calls with directives. + +use openacc + +if (acc_get_num_devices (acc_device_host) .ne. 1) STOP 1 +!$acc set device_type(host) +if (acc_get_device_type () .ne. acc_device_host) STOP 2 +!$acc set device_type(host) device_num(0) +if (acc_get_device_num (acc_device_host) .ne. 0) STOP 3 +!$acc shutdown device_type(host) + +!$acc init device_type(host) +!$acc shutdown device_type(host) + +end diff --git a/libgomp/testsuite/libgomp.oacc-fortran/lib-4-directives.f90 b/libgomp/testsuite/libgomp.oacc-fortran/lib-4-directives.f90 new file mode 100644 index 00000000000..b4e8a6e7a54 --- /dev/null +++ b/libgomp/testsuite/libgomp.oacc-fortran/lib-4-directives.f90 @@ -0,0 +1,37 @@ +! { dg-do run } +! +! Port of lib-4.f90 replacing applicable runtime calls with directives. + +program main + use openacc + implicit none + + integer n + + if (acc_get_num_devices (acc_device_host) .ne. 1) STOP 1 + + if (acc_get_num_devices (acc_device_none) .ne. 0) STOP 2 + + !$acc init device_type(host) + + if (acc_get_device_type () .ne. acc_device_host) STOP 3 + + !$acc set device_type(host) + + if (acc_get_device_type () .ne. acc_device_host) STOP 4 + + n = 0 + + !$acc set device_type(host) device_num(n) + + if (acc_get_device_num (acc_device_host) .ne. 0) STOP 5 + + if (.NOT. acc_async_test (n) ) STOP 6 + + call acc_wait (n) + + call acc_wait_all () + + !$acc shutdown device_type(host) + +end program diff --git a/libgomp/testsuite/libgomp.oacc-fortran/lib-5-directives.f90 b/libgomp/testsuite/libgomp.oacc-fortran/lib-5-directives.f90 new file mode 100644 index 00000000000..dde01c28852 --- /dev/null +++ b/libgomp/testsuite/libgomp.oacc-fortran/lib-5-directives.f90 @@ -0,0 +1,59 @@ +! { dg-do run } +! +! Port of lib-5.f90 replacing applicable runtime calls with directives. + +program main + use openacc + implicit none + + integer n + + if (acc_get_num_devices (acc_device_nvidia) .ne. 0) then + + !$acc init device_type(nvidia) + + n = 0 + + !$acc set device_type(nvidia) device_num(n) + + if (acc_get_device_num (acc_device_nvidia) .ne. 0) stop 11 + + if (acc_get_num_devices (acc_device_nvidia) .gt. 1) then + + n = 1 + + !$acc set device_type(nvidia) device_num(n) + + if (acc_get_device_num (acc_device_nvidia) .ne. 1) stop 12 + + end if + + !$acc shutdown device_type(nvidia) + + end if + + if (acc_get_num_devices (acc_device_radeon) .ne. 0) then + + !$acc init device_type(radeon) + + n = 0 + + !$acc set device_type(radeon) device_num(n) + + if (acc_get_device_num (acc_device_radeon) .ne. 0) stop 21 + + if (acc_get_num_devices (acc_device_radeon) .gt. 1) then + + n = 1 + + !$acc set device_type(radeon) device_num(n) + + if (acc_get_device_num (acc_device_radeon) .ne. 1) stop 22 + + end if + + !$acc shutdown device_type(radeon) + + end if + +end program diff --git a/libgomp/testsuite/libgomp.oacc-fortran/lib-5-init.f90 b/libgomp/testsuite/libgomp.oacc-fortran/lib-5-init.f90 new file mode 100644 index 00000000000..3c50508e733 --- /dev/null +++ b/libgomp/testsuite/libgomp.oacc-fortran/lib-5-init.f90 @@ -0,0 +1,59 @@ +! { dg-do run } +! +! Port of lib-5.f90 using !$acc init instead of call acc_init. + +program main + use openacc + implicit none + + integer n + + if (acc_get_num_devices (acc_device_nvidia) .ne. 0) then + + !$acc init device_type(nvidia) + + n = 0 + + call acc_set_device_num (n, acc_device_nvidia) + + if (acc_get_device_num (acc_device_nvidia) .ne. 0) stop 11 + + if (acc_get_num_devices (acc_device_nvidia) .gt. 1) then + + n = 1 + + call acc_set_device_num (n, acc_device_nvidia) + + if (acc_get_device_num (acc_device_nvidia) .ne. 1) stop 12 + + end if + + call acc_shutdown (acc_device_nvidia) + + end if + + if (acc_get_num_devices (acc_device_radeon) .ne. 0) then + + !$acc init device_type(radeon) + + n = 0 + + call acc_set_device_num (n, acc_device_radeon) + + if (acc_get_device_num (acc_device_radeon) .ne. 0) stop 21 + + if (acc_get_num_devices (acc_device_radeon) .gt. 1) then + + n = 1 + + call acc_set_device_num (n, acc_device_radeon) + + if (acc_get_device_num (acc_device_radeon) .ne. 1) stop 22 + + end if + + call acc_shutdown (acc_device_radeon) + + end if + +end program diff --git a/libgomp/testsuite/libgomp.oacc-fortran/set-1.f90 b/libgomp/testsuite/libgomp.oacc-fortran/set-1.f90 new file mode 100644 index 00000000000..440c43e1638 --- /dev/null +++ b/libgomp/testsuite/libgomp.oacc-fortran/set-1.f90 @@ -0,0 +1,82 @@ +! { dg-do run } +! +! Test the OpenACC set directive at run time. + +use openacc + +implicit none + +logical :: l +integer :: n + +if (acc_get_num_devices (acc_device_host) .ne. 1) stop 1 + +call acc_init (acc_device_host) + +!$acc set device_type(host) + +if (acc_get_device_type () .ne. acc_device_host) stop 2 + + +! This set device_num(0) call init all the devices, +! so we can skip the init call later + +!$acc set device_num(0) + +if (acc_get_device_num (acc_device_host) .ne. 0) stop 3 + +!$acc set device_type(host) device_num(0) + +if (acc_get_device_type () .ne. acc_device_host) stop 4 +if (acc_get_device_num (acc_device_host) .ne. 0) stop 5 + +l = .true. +!$acc set if (l) device_type(host) + +if (acc_get_device_type () .ne. acc_device_host) stop 6 + +l = .false. +n = 1 +!$acc set if (l) device_num(n) + +if (acc_get_device_num (acc_device_host) .ne. 0) stop 7 + +call acc_shutdown (acc_device_host) + +if (acc_get_num_devices (acc_device_nvidia) .ne. 0) then + + !$acc set device_type(nvidia) + + if (acc_get_device_type () .ne. acc_device_nvidia) stop 11 + + n = 0 + !$acc set device_type(nvidia) device_num(n) + + if (acc_get_device_num (acc_device_nvidia) .ne. 0) stop 12 + + l = .false. + !$acc set if (l) device_type(host) + if (acc_get_device_type () .ne. acc_device_nvidia) stop 13 + + call acc_shutdown (acc_device_nvidia) +end if + +if (acc_get_num_devices (acc_device_radeon) .ne. 0) then + + !$acc set device_type(radeon) + + if (acc_get_device_type () .ne. acc_device_radeon) stop 21 + + n = 0 + !$acc set device_type(radeon) device_num(n) + + if (acc_get_device_num (acc_device_radeon) .ne. 0) stop 22 + + l = .false. + !$acc set if (l) device_type(host) + if (acc_get_device_type () .ne. acc_device_radeon) stop 23 + + call acc_shutdown (acc_device_radeon) +end if + +end diff --git a/libgomp/testsuite/libgomp.oacc-fortran/shutdown-1.f90 b/libgomp/testsuite/libgomp.oacc-fortran/shutdown-1.f90 new file mode 100644 index 00000000000..6cf06571f2c --- /dev/null +++ b/libgomp/testsuite/libgomp.oacc-fortran/shutdown-1.f90 @@ -0,0 +1,53 @@ +! { dg-do run } +! +! Test the OpenACC shutdown directive at run time. + +use openacc + +implicit none + +logical :: l +integer :: n + +if (acc_get_num_devices (acc_device_host) .ne. 1) stop 1 + +!$acc init device_type(host) + +if (acc_get_device_type () .ne. acc_device_host) stop 2 +if (acc_get_device_num (acc_device_host) .ne. 0) stop 3 + +!$acc shutdown device_type(host) + +!$acc init device_type(host) device_num(0) + +!$acc shutdown device_type(host) device_num(0) + +l = .true. +!$acc init if (l) device_type(host) + +if (acc_get_device_type () .ne. acc_device_host) stop 4 + +!$acc shutdown if (l) device_type(host) + +n = acc_get_num_devices (acc_device_default) +!$acc shutdown if (.false.) device_num(n) + +if (acc_get_num_devices (acc_device_nvidia) .ne. 0) then + l = .true. + !$acc init if (l) device_type(nvidia) + if (acc_get_device_type () .ne. acc_device_nvidia) stop 5 + l = .false. + !$acc shutdown if (l) device_type(host) + !$acc shutdown device_type(nvidia) +end if + +if (acc_get_num_devices (acc_device_radeon) .ne. 0) then + l = .true. + !$acc init if (l) device_type(radeon) + if (acc_get_device_type () .ne. acc_device_radeon) stop 6 + l = .false. + !$acc shutdown if (l) device_type(host) + !$acc shutdown device_type(radeon) +end if + +end -- 2.53.0