[gcc r17-2816] Fortran support for init, set, shutdown OpenACC directives
Thomas Schwinge via Gcc-cvs <[email protected]> Thu, 30 Jul 2026 08:22:15 +0000 (GMT)
| Newsgroups | gmane.comp.gcc.cvs |
|---|---|
| Message-ID | <[email protected]> |
https://gcc.gnu.org/g:0dbe46aeaf5c06cbd3deaa833e5ae2150fe67c56 commit r17-2816-g0dbe46aeaf5c06cbd3deaa833e5ae2150fe67c56 Author: Sebastian Galindo <[email protected]> Date: Tue Jul 21 23:51:55 2026 -0400 Fortran support for init,set,shutdown OpenACC directives 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]> Diff: --- 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 + gcc/testsuite/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 +++++++ gcc/testsuite/gfortran.dg/goacc/acc-shutdown-1.f90 | 47 ++++++ .../gfortran.dg/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 +++++++++++++++++++-- libgomp/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 +++++++ .../testsuite/libgomp.oacc-fortran/lib-5-init.f90 | 59 +++++++ libgomp/testsuite/libgomp.oacc-fortran/set-1.f90 | 82 +++++++++ .../testsuite/libgomp.oacc-fortran/shutdown-1.f90 | 53 ++++++ 31 files changed, 1094 insertions(+), 24 deletions(-) diff --git a/gcc/builtin-types.def b/gcc/builtin-types.def index 23bfa76eaa4b..19da735791e2 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 8d13acd8656d..da185baecec7 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 9bf5d40b9cc4..8abe07e8f59f 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 48ddd9a72d5e..a5b2e035c847 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 0641e5a434c9..43cc804225c6 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 3613dc8bd451..e559a2db0db9 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 7b6cf525a804..eeb988655131 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 036da9a939ee..389a74516197 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 39711e326208..4c7e274b72a5 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 31a84d51f168..3e4375f6d601 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 7418b811a72b..cf37261673cf 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 eb253d8970e2..73a1e0cd7344 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 8e6b6fb3acf6..500cc32ab4d4 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 000000000000..931cce7a9240 --- /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 000000000000..30c86a798ee3 --- /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 000000000000..013c301c775f --- /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 000000000000..9ed31a0fea20 --- /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 000000000000..72db24750f1c --- /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 000000000000..242d05a5e671 --- /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 940fe841c200..89301af4785d 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 41c2657b5360..9a350a8c845e 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 8a59d4965b39..00e47d65d4c6 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 f5f1d8e677b5..9caf9c3571bf 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 bfd50bf39a59..b9e6d405b0b6 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 000000000000..e33c4cb30ea9 --- /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 000000000000..182b238f8445 --- /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 000000000000..b4e8a6e7a544 --- /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 000000000000..dde01c288529 --- /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 000000000000..3c50508e7338 --- /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 000000000000..440c43e16386 --- /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 000000000000..6cf06571f2cc --- /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