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. Signed-off-by: Sebastian Galindo <[email protected]> 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): New builtin for set directive gcc/fortran/ChangeLog: * gfortran.h (enum gfc_statement): Add directives statements (gfc_get_device_type_list): New function to allocate device type list (enum gfc_exec_op): Add directives operations (gfc_free_device_type_list): New function to free memory of device_type list * match.h (gfc_match_oacc_init): New function to match init directive (gfc_match_oacc_shutdown): New function to match shutdown directive (gfc_match_oacc_set): New function to match set directive * openmp.cc (gfc_free_omp_clauses): Add deallocation of new fields in clauses (gfc_free_device_type_list): New function to free memory of device_type list (match_oacc_device_type_kind): New function to match device_type options (match_oacc_device_type_list): New function to match device_type arguments list (enum omp_mask2): Add OMP_CLAUSE_DEVICE_NUM (gfc_match_omp_clauses): Add device_type and device_num matching (OACC_INIT_CLAUSES): Add clauses bitmask for init directive (OACC_SHUTDOWN_CLAUSES): Add clauses bitmask for shutdown directive (OACC_SET_CLAUSES): Add clauses bitmask for set directive (gfc_match_oacc_init): New function to match init directive (gfc_match_oacc_shutdown): New function to match shutdown directive (gfc_match_oacc_set): New function to match set directive (resolve_omp_clauses): Add resolve integer expresion in device_num clause (gfc_resolve_oacc_directive): Add directives cases * parse.cc (decode_oacc_directive): Add matching for the directives (next_statement): Add directives statements enum (gfc_ascii_statement): Add representation of the new directives. (is_oacc): Add the new directives * resolve.cc: Add the new directives * st.cc (gfc_free_statement): Add the new directives * trans-openmp.cc (gfc_trans_oacc_set_directive): Add translation to set directive (gfc_trans_oacc_shutdown_directive): Add translation to shutdown directive (gfc_trans_oacc_init_directive): Add translation to init directive (gfc_trans_oacc_directive): Add the new directives to translation * trans.cc (trans_code): Add the new directives * types.def (BT_FN_VOID_INT_INT): Add builtin function type for libgomp libgomp/ChangeLog: * libgomp.map: Add builtins implemented * libgomp_g.h (GOACC_init): Init directive builtin (GOACC_shutdown): Shutdown directive builtin (GOACC_set): Set directive builtin * oacc-init.c (GOACC_DIRECTIVE_DEVICE_MASK): Add accepted devices (acc_init_1): Add specific device number init (acc_shutdown_1): Add specific device number shutdown (goacc_attach_host_thread_to_device): Formatting (ignore) (GOACC_init): Add Init builtin implementation (GOACC_shutdown): Add shutdown builtin implementation (GOACC_set): Add set builtin implementation (acc_init): Add device number modification (acc_shutdown): Add device number modification (acc_set_device_num): Formatting (ignore) (goacc_restore_bind): Formatting (ignore) (goacc_lazy_initialize): Add device number modification * testsuite/libgomp.oacc-fortran/init-1.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/uninit-if-clause.f95: * gfortran.dg/goacc/update-if_present-2.f90: * 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. --- gcc/builtin-types.def | 1 + gcc/fortran/gfortran.h | 15 + gcc/fortran/match.h | 3 + gcc/fortran/openmp.cc | 279 ++++++++++++++++-- gcc/fortran/parse.cc | 20 +- gcc/fortran/resolve.cc | 3 + gcc/fortran/st.cc | 3 + gcc/fortran/trans-openmp.cc | 110 +++++++ gcc/fortran/trans.cc | 3 + gcc/fortran/types.def | 1 + gcc/omp-builtins.def | 10 + .../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 | 3 + libgomp/libgomp_g.h | 8 +- libgomp/oacc-init.c | 207 +++++++++++-- .../testsuite/libgomp.oacc-fortran/init-1.f90 | 30 ++ .../testsuite/libgomp.oacc-fortran/set-1.f90 | 37 +++ .../libgomp.oacc-fortran/shutdown-1.f90 | 32 ++ 25 files changed, 982 insertions(+), 51 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/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 365badca2aa..9c1146d3d8d 100644 --- a/gcc/builtin-types.def +++ b/gcc/builtin-types.def @@ -689,6 +689,7 @@ DEF_FUNCTION_TYPE_2 (BT_FN_INT_CONST_FEXCEPT_T_PTR_INT, BT_INT, BT_CONST_FEXCEPT_T_PTR, BT_INT) 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_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/gfortran.h b/gcc/fortran/gfortran.h index 801dd856e1b..99e6d6034d5 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, @@ -1360,6 +1361,16 @@ gfc_expr_list; #define gfc_get_expr_list() XCNEW (gfc_expr_list) +/* Likewise to gfc_expr_list, but contains OpenACC device types */ +typedef struct gfc_device_type_list +{ + int device; + struct gfc_device_type_list* next; +} +gfc_device_type_list; + +#define gfc_get_device_type_list() XCNEW (gfc_device_type_list) + enum gfc_omp_reduction_op { OMP_REDUCTION_NONE = -1, @@ -1760,8 +1771,10 @@ 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; + gfc_device_type_list *device_type_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; @@ -3275,6 +3288,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, @@ -4059,6 +4073,7 @@ void gfc_resolve_omp_udrs (gfc_symtree *); void gfc_resolve_omp_udms (gfc_symtree *); void gfc_omp_save_and_clear_state (struct gfc_omp_saved_state *); void gfc_omp_restore_state (struct gfc_omp_saved_state *); +void gfc_free_device_type_list (gfc_device_type_list *); void gfc_free_expr_list (gfc_expr_list *); void gfc_resolve_oacc_directive (gfc_code *, gfc_namespace *); void gfc_resolve_oacc_declare (gfc_namespace *); 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 4f5e0a8e344..e477601db1a 100644 --- a/gcc/fortran/openmp.cc +++ b/gcc/fortran/openmp.cc @@ -213,12 +213,14 @@ 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); gfc_free_expr_list (c->wait_list); gfc_free_expr_list (c->tile_list); gfc_free_expr_list (c->sizes_list); + gfc_free_device_type_list (c->device_type_list); free (const_cast<char *> (c->critical_name)); if (c->assume) { @@ -249,6 +251,18 @@ gfc_free_oacc_declare_clauses (struct gfc_oacc_declare *oc) while (decl); } +/* Free device_type list */ +void +gfc_free_device_type_list (gfc_device_type_list *list) +{ + gfc_device_type_list *n; + for (; list; list = n) + { + n = list->next; + free (list); + } +} + /* Free expression list. */ void gfc_free_expr_list (gfc_expr_list *list) @@ -833,6 +847,89 @@ cleanup: return MATCH_ERROR; } +static int +match_oacc_device_type_kind (void) +{ + if (gfc_match (" nvidia") == MATCH_YES) + return GOMP_DEVICE_NVIDIA_PTX; + if (gfc_match (" radeon") == MATCH_YES) + return GOMP_DEVICE_GCN; + if (gfc_match (" host") == MATCH_YES) + return GOMP_DEVICE_HOST; + if (gfc_match (" *") == MATCH_YES) + return GOMP_DEVICE_GCN + 1; // means all + return -1; +} + +static match +match_oacc_device_type_list (const char *str, gfc_device_type_list **list) +{ + gfc_device_type_list *head = NULL, *tail = NULL, *p = NULL; + locus old_loc = gfc_current_locus; + + if (gfc_match (str) != MATCH_YES) + return MATCH_NO; + + int device_n = 0, device_exist = 0, asterisk_bit = GOMP_DEVICE_GCN + 1; + + for (;;) + { + int device = match_oacc_device_type_kind (); + if (device < 0) + { + gfc_error ("Unknown device at %C, expecting one of the following: " + "nvidia, radeon, host, *"); + goto cleanup; + } + + if (device_exist & (1 << (device))) + { + gfc_error ("Duplicate device_type parameter at %C"); + goto cleanup; + } + + device_exist |= (1 << device); + device_n++; + if ((device_exist & (1 << asterisk_bit)) && device_n > 1) + { + gfc_error ( + "Asterisk must be the unique parameter in device_type at %C"); + goto cleanup; + } + p = gfc_get_device_type_list (); + p->device = device; + + if (head == NULL) + { + head = tail = p; + } + else + { + tail->next = p; + tail = tail->next; + } + + if (gfc_match_char (')') == MATCH_YES) + break; + if (gfc_match_char (',') != MATCH_YES) + goto sintax; + } + + while (*list) + list = &(*list)->next; + + *list = head; + + return MATCH_YES; + +sintax: + gfc_error ("Syntax error in OpenACC device_type list at %C"); +cleanup: + gfc_free_device_type_list (head); + 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) @@ -1168,22 +1265,23 @@ enum omp_mask2 OMP_CLAUSE_ATTACH, OMP_CLAUSE_NOHOST, OMP_CLAUSE_HAS_DEVICE_ADDR, /* OpenMP 5.1 */ - OMP_CLAUSE_ENTER, /* OpenMP 5.2 */ - OMP_CLAUSE_DOACROSS, /* OpenMP 5.2 */ - OMP_CLAUSE_ASSUMPTIONS, /* OpenMP 5.1. */ - OMP_CLAUSE_USES_ALLOCATORS, /* OpenMP 5.0 */ - OMP_CLAUSE_INDIRECT, /* OpenMP 5.1 */ - OMP_CLAUSE_FULL, /* OpenMP 5.1. */ - OMP_CLAUSE_PARTIAL, /* OpenMP 5.1. */ - OMP_CLAUSE_SIZES, /* OpenMP 5.1. */ - OMP_CLAUSE_INIT, /* OpenMP 5.1. */ - OMP_CLAUSE_DESTROY, /* OpenMP 5.1. */ - OMP_CLAUSE_USE, /* OpenMP 5.1. */ - OMP_CLAUSE_NOVARIANTS, /* OpenMP 5.1 */ - OMP_CLAUSE_NOCONTEXT, /* OpenMP 5.1 */ - OMP_CLAUSE_INTEROP, /* OpenMP 5.1 */ - OMP_CLAUSE_LOCAL, /* OpenMP 6.0 */ + OMP_CLAUSE_ENTER, /* OpenMP 5.2 */ + OMP_CLAUSE_DOACROSS, /* OpenMP 5.2 */ + OMP_CLAUSE_ASSUMPTIONS, /* OpenMP 5.1. */ + OMP_CLAUSE_USES_ALLOCATORS, /* OpenMP 5.0 */ + OMP_CLAUSE_INDIRECT, /* OpenMP 5.1 */ + OMP_CLAUSE_FULL, /* OpenMP 5.1. */ + OMP_CLAUSE_PARTIAL, /* OpenMP 5.1. */ + OMP_CLAUSE_SIZES, /* OpenMP 5.1. */ + OMP_CLAUSE_INIT, /* OpenMP 5.1. */ + OMP_CLAUSE_DESTROY, /* OpenMP 5.1. */ + OMP_CLAUSE_USE, /* OpenMP 5.1. */ + OMP_CLAUSE_NOVARIANTS, /* OpenMP 5.1 */ + OMP_CLAUSE_NOCONTEXT, /* OpenMP 5.1 */ + OMP_CLAUSE_INTEROP, /* OpenMP 5.1 */ + OMP_CLAUSE_LOCAL, /* OpenMP 6.0 */ OMP_CLAUSE_DYN_GROUPPRIVATE, /* OpenMP 6.1 */ + OMP_CLAUSE_DEVICE_NUM, /* OpenACC 3.4 */ /* This must come last. */ OMP_MASK2_LAST }; @@ -3158,9 +3256,21 @@ 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->device_type_list, "device_type", + false) + == MATCH_YES + && match_oacc_device_type_list (" (", &c->device_type_list) + == 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) + "device_type", true) + == MATCH_YES) { if (gfc_match ("host") == MATCH_YES) c->device_type = OMP_DEVICE_TYPE_HOST; @@ -3281,6 +3391,17 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, goto error; continue; } + + if ((mask & OMP_CLAUSE_DEVICE_NUM) && openacc + && (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; + } break; case 'e': if ((mask & OMP_CLAUSE_ENTER)) @@ -4780,7 +4901,14 @@ 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 match_acc (gfc_exec_op op, const omp_mask mask) @@ -5074,6 +5202,118 @@ gfc_match_oacc_cache (void) return MATCH_YES; } +match +gfc_match_oacc_init (void) +{ + gfc_omp_clauses *c; + if (gfc_match_omp_clauses (&c, OACC_INIT_CLAUSES, false, false, true) + != MATCH_YES) + return MATCH_ERROR; + + int device_n = 0; + gfc_device_type_list *n, *list = c->device_type_list; + + for (; list; list = n) + { + n = list->next; + if (list->device == GOMP_DEVICE_GCN + 1) + { + gfc_error ( + "OpenACC init directive does not accept * argument in device_type at %C"); + return MATCH_ERROR; + } + device_n++; + } + + if (device_n > 1) + { + gfc_error ( + "OpenACC init directive only accepts one argument in device_type at %C"); + return MATCH_ERROR; + } + + new_st.op = EXEC_OACC_INIT; + new_st.ext.omp_clauses = c; + return MATCH_YES; +} + +match +gfc_match_oacc_shutdown (void) +{ + gfc_omp_clauses *c; + if (gfc_match_omp_clauses (&c, OACC_SHUTDOWN_CLAUSES, false, false, true) + != MATCH_YES) + return MATCH_ERROR; + + int device_n = 0; + gfc_device_type_list *n, *list = c->device_type_list; + + for (; list; list = n) + { + n = list->next; + if (list->device == GOMP_DEVICE_GCN + 1) + { + gfc_error ( + "OpenACC shutdown directive does not accept * argument in device_type at %C"); + return MATCH_ERROR; + } + device_n++; + } + + if (device_n > 1) + { + gfc_error ( + "OpenACC shutdown directive only accepts one argument in device_type at %C"); + return MATCH_ERROR; + } + + new_st.op = EXEC_OACC_SHUTDOWN; + new_st.ext.omp_clauses = c; + return MATCH_YES; +} + +match +gfc_match_oacc_set (void) +{ + gfc_omp_clauses *c; + if (gfc_match_omp_clauses (&c, OACC_SET_CLAUSES, false, false, true) + != MATCH_YES) + return MATCH_ERROR; + + int device_n = 0; + gfc_device_type_list *n, *list = c->device_type_list; + + for (; list; list = n) + { + n = list->next; + if (list->device == GOMP_DEVICE_GCN + 1) + { + gfc_error ( + "OpenACC set directive does not accept * argument in device_type at %C"); + return MATCH_ERROR; + } + device_n++; + } + + if (device_n > 1) + { + gfc_error ( + "OpenACC set directive only accepts one argument in device_type at %C"); + return MATCH_ERROR; + } + + if (!c->device_type_list && !c->device_num_expr) + { + gfc_error ( + "OpenACC set diretive needs at least one clause besides the if clause at %C"); + return MATCH_ERROR; + } + + new_st.op = EXEC_OACC_SET; + new_st.ext.omp_clauses = c; + return MATCH_YES; +} + /* Determine the OpenACC 'routine' directive's level of parallelism. */ static oacc_routine_lop @@ -11113,6 +11353,8 @@ 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 (omp_clauses->num_gangs_expr) resolve_positive_int_expr (omp_clauses->num_gangs_expr, "NUM_GANGS"); if (omp_clauses->num_workers_expr) @@ -13698,6 +13940,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_SET: + case EXEC_OACC_SHUTDOWN: 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..70dadd35f83 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); @@ -804,8 +807,10 @@ decode_oacc_directive (void) matcha ("loop", gfc_match_oacc_loop, ST_OACC_LOOP); break; case 's': + matcha ("set", gfc_match_oacc_set, ST_OACC_SET); matcha ("serial loop", gfc_match_oacc_serial_loop, ST_OACC_SERIAL_LOOP); matcha ("serial", gfc_match_oacc_serial, ST_OACC_SERIAL); + 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_INIT: case ST_OACC_ENTER_DATA: case ST_OACC_EXIT_DATA: \ + 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 57561e8686f..6ec03526283 100644 --- a/gcc/fortran/resolve.cc +++ b/gcc/fortran/resolve.cc @@ -14800,6 +14800,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..b4917f6a2a8 100644 --- a/gcc/fortran/st.cc +++ b/gcc/fortran/st.cc @@ -291,6 +291,9 @@ gfc_free_statement (gfc_code *p) case EXEC_OMP_TILE: case EXEC_OMP_UNROLL: case EXEC_OMP_WORKSHARE: + case EXEC_OACC_INIT: + case EXEC_OACC_SHUTDOWN: + case EXEC_OACC_SET: gfc_free_omp_clauses (p->ext.omp_clauses); break; diff --git a/gcc/fortran/trans-openmp.cc b/gcc/fortran/trans-openmp.cc index 84f9ffb5129..2df1a60f0e5 100644 --- a/gcc/fortran/trans-openmp.cc +++ b/gcc/fortran/trans-openmp.cc @@ -9746,6 +9746,110 @@ gfc_trans_oacc_declare (gfc_code *code) return gfc_finish_block (&block); } +tree +gfc_trans_oacc_set_directive (gfc_code *code) +{ + stmtblock_t block; + tree stmt; + location_t loc = input_location; + gfc_omp_clauses *clauses = code->ext.omp_clauses; + + gfc_start_block (&block); + + tree n_device = build_int_cst (integer_type_node, -1); + if (clauses->device_num_expr) + n_device = gfc_convert_expr_to_tree (&block, clauses->device_num_expr); + + int device_type = GOMP_DEVICE_DEFAULT; + if (clauses->device_type_list) + device_type = clauses->device_type_list->device; + + tree d_type = build_int_cst (integer_type_node, device_type); + + stmt = builtin_decl_explicit (BUILT_IN_GOACC_SET); + + stmt = build_call_expr_loc (loc, stmt, 2, d_type, n_device); + + 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); +} + +tree +gfc_trans_oacc_shutdown_directive (gfc_code *code) +{ + stmtblock_t block; + tree stmt; + location_t loc = input_location; + gfc_omp_clauses *clauses = code->ext.omp_clauses; + + gfc_start_block (&block); + + tree n_device = build_int_cst (integer_type_node, -1); + if (clauses->device_num_expr) + n_device = gfc_convert_expr_to_tree (&block, clauses->device_num_expr); + + // All by default according the OpenACC spec + int device_type = GOMP_DEVICE_GCN + 1; + if (clauses->device_type_list) + device_type = clauses->device_type_list->device; + + tree d_type = build_int_cst (integer_type_node, device_type); + + stmt = builtin_decl_explicit (BUILT_IN_GOACC_SHUTDOWN); + + stmt = build_call_expr_loc (loc, stmt, 2, d_type, n_device); + + 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); +} + +tree +gfc_trans_oacc_init_directive (gfc_code *code) +{ + stmtblock_t block; + tree stmt; + location_t loc = input_location; + gfc_omp_clauses *clauses = code->ext.omp_clauses; + + gfc_start_block (&block); + + tree n_device = build_int_cst (integer_type_node, -1); + if (clauses->device_num_expr) + n_device = gfc_convert_expr_to_tree (&block, clauses->device_num_expr); + + // All by default according the OpenACC spec + int device_type = GOMP_DEVICE_GCN + 1; + if (clauses->device_type_list) + device_type = clauses->device_type_list->device; + + tree d_type = build_int_cst (integer_type_node, device_type); + + stmt = builtin_decl_explicit (BUILT_IN_GOACC_INIT); + + stmt = build_call_expr_loc (loc, stmt, 2, d_type, n_device); + + 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); +} + tree gfc_trans_oacc_directive (gfc_code *code) { @@ -9775,6 +9879,12 @@ gfc_trans_oacc_directive (gfc_code *code) return gfc_trans_omp_atomic (code); case EXEC_OACC_DECLARE: return gfc_trans_oacc_declare (code); + case EXEC_OACC_INIT: + return gfc_trans_oacc_init_directive (code); + case EXEC_OACC_SHUTDOWN: + return gfc_trans_oacc_shutdown_directive (code); + case EXEC_OACC_SET: + return gfc_trans_oacc_set_directive (code); default: gcc_unreachable (); } diff --git a/gcc/fortran/trans.cc b/gcc/fortran/trans.cc index adf392cec6f..9095f847a5e 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 32c533bc04f..b6415ddef7e 100644 --- a/gcc/fortran/types.def +++ b/gcc/fortran/types.def @@ -120,6 +120,7 @@ DEF_FUNCTION_TYPE_2 (BT_FN_VOID_PTR_PTRMODE, BT_VOID, BT_PTR, BT_PTRMODE) 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_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 f5b16c5d29e..460b01034f4 100644 --- a/gcc/omp-builtins.def +++ b/gcc/omp-builtins.def @@ -49,6 +49,16 @@ DEF_GOACC_BUILTIN (BUILT_IN_GOACC_UPDATE, "GOACC_update", DEF_GOACC_BUILTIN (BUILT_IN_GOACC_WAIT, "GOACC_wait", BT_FN_VOID_INT_INT_VAR, 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, "GOACC_set", + BT_FN_VOID_INT_INT, ATTR_NOTHROW_LIST) + DEF_GOACC_BUILTIN (BUILT_IN_GOACC_DECLARE, "GOACC_declare", BT_FN_VOID_INT_SIZE_PTR_PTR_PTR, ATTR_NOTHROW_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..6957256a956 --- /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 \\(9, -1\\)" 2 "original" } } +! { dg-final { scan-tree-dump-times "__builtin_GOACC_init \\(2, -1\\)" 1 "original" } } +! { dg-final { scan-tree-dump-times "__builtin_GOACC_init \\(5, -1\\)" 1 "original" } } +! { dg-final { scan-tree-dump-times "__builtin_GOACC_init \\(9, 0\\)" 1 "original" } } +! { dg-final { scan-tree-dump-times "__builtin_GOACC_init \\(2, 0\\)" 1 "original" } } +! { dg-final { scan-tree-dump-times "__builtin_GOACC_init \\(8, 1\\)" 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..9b5c8b1b8b8 --- /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(*) ! { dg-error "OpenACC init directive does not accept \\* argument in device_type" } +end subroutine bad1 + +subroutine bad2 + implicit none + !$acc init device_type(nvidia, host) ! { dg-error "OpenACC init directive only accepts one argument in device_type" } +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..e207886fb77 --- /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 \\(2, -1\\)" 1 "original" } } +! { dg-final { scan-tree-dump-times "__builtin_GOACC_set \\(5, -1\\)" 1 "original" } } +! { dg-final { scan-tree-dump-times "__builtin_GOACC_set \\(1, -1\\)" 1 "original" } } +! { dg-final { scan-tree-dump-times "__builtin_GOACC_set \\(2, 0\\)" 1 "original" } } +! { dg-final { scan-tree-dump-times "__builtin_GOACC_set \\(8, 1\\)" 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..5c4d05cdcbd --- /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(*) ! { dg-error "OpenACC set directive does not accept \\* argument in device_type" } +end subroutine bad1 + +subroutine bad2 + implicit none + !$acc set device_type(nvidia, host) ! { dg-error "OpenACC set directive only accepts one argument in device_type" } +end subroutine bad2 + +subroutine bad3 + implicit none + !$acc set ! { dg-error "OpenACC set diretive needs at least one clause besides the if clause" } +end subroutine bad3 + +subroutine bad4 + implicit none + !$acc set if(.true.) ! { dg-error "OpenACC set diretive needs at least one clause besides the if clause" } +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..0ed8ccef779 --- /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 \\(9, -1\\)" 2 "original" } } +! { dg-final { scan-tree-dump-times "__builtin_GOACC_shutdown \\(2, -1\\)" 1 "original" } } +! { dg-final { scan-tree-dump-times "__builtin_GOACC_shutdown \\(5, -1\\)" 1 "original" } } +! { dg-final { scan-tree-dump-times "__builtin_GOACC_shutdown \\(9, 0\\)" 1 "original" } } +! { dg-final { scan-tree-dump-times "__builtin_GOACC_shutdown \\(2, 0\\)" 1 "original" } } +! { dg-final { scan-tree-dump-times "__builtin_GOACC_shutdown \\(8, 1\\)" 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..622bb970c5b --- /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(*) ! { dg-error "OpenACC shutdown directive does not accept \\* argument in device_type" } +end subroutine bad1 + +subroutine bad2 + implicit none + !$acc shutdown device_type(nvidia, host) ! { dg-error "OpenACC shutdown directive only accepts one argument in device_type" } +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 06db9040e96..969c2dbaba4 100644 --- a/libgomp/libgomp.map +++ b/libgomp/libgomp.map @@ -650,6 +650,9 @@ GOACC_2.0.2 { global: GOACC_enter_data; GOACC_exit_data; + GOACC_init; + GOACC_shutdown; + GOACC_set; } GOACC_2.0.1; GOMP_PLUGIN_1.0 { diff --git a/libgomp/libgomp_g.h b/libgomp/libgomp_g.h index 6890547bfa7..19b95ec73e8 100644 --- a/libgomp/libgomp_g.h +++ b/libgomp/libgomp_g.h @@ -26,7 +26,7 @@ /* This file contains prototypes of functions in the external ABI. This file is included by files in the testsuite. */ -#ifndef LIBGOMP_G_H +#ifndef LIBGOMP_G_H #define LIBGOMP_G_H 1 #include <stdbool.h> @@ -385,6 +385,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 (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 570100e5bb7..aea9c678a39 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 (0); - 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 (0); - /* 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. */ + /* Free target-specific TLS data and close 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"); @@ -502,13 +548,13 @@ goacc_attach_host_thread_to_device (int ord) struct goacc_thread *thr = goacc_thread (); struct gomp_device_descr *acc_dev = NULL, *base_dev = NULL; int num_devices; - + if (thr && thr->dev && (thr->dev->target_id == ord || ord < 0)) return; - + if (ord < 0) ord = goacc_device_num; - + /* Decide which type of device to use. If the current thread has a device type already (e.g. set by acc_set_device_type), use that, else use the global default. */ @@ -519,15 +565,15 @@ goacc_attach_host_thread_to_device (int ord) assert (cached_base_dev); base_dev = cached_base_dev; } - + num_devices = base_dev->get_num_devices_func (0); if (num_devices <= 0 || ord >= num_devices) acc_dev_num_out_of_range (acc_device_type (base_dev->type), ord, num_devices); - + if (!thr) thr = goacc_new_thread (); - + thr->base_dev = base_dev; thr->dev = acc_dev = &base_dev[ord]; thr->saved_bound_dev = NULL; @@ -540,10 +586,113 @@ goacc_attach_host_thread_to_device (int ord) thr->target_tls = acc_dev->openacc.create_thread_data_func (ord); } +void +GOACC_init (int d, int n_device) +{ + /* 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_hwm) + { + int i; + for (i = 0; i < d; 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) <= 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 d, int n_device) +{ + gomp_init_targets_once (); + + if ((acc_device_t) d == _ACC_device_hwm) + { + 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) <= 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 (int d, int n_device) +{ + if ((acc_device_t) d != acc_device_default) + 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. */ - void acc_init (acc_device_t d) { @@ -553,9 +702,9 @@ 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); } @@ -571,7 +720,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); } @@ -795,7 +944,7 @@ acc_set_device_num (int ord, acc_device_t d) goacc_attach_host_thread_to_device (ord); } - + goacc_device_num = ord; } @@ -931,7 +1080,7 @@ goacc_restore_bind (void) } /* This is called from any OpenACC support function that may need to implicitly - initialize the libgomp runtime, either globally or from a new host thread. + initialize the libgomp runtime, either globally or from a new host thread. On exit "goacc_thread" will return a valid & populated thread block. */ attribute_hidden void @@ -946,8 +1095,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..3359c32c76e --- /dev/null +++ b/libgomp/testsuite/libgomp.oacc-fortran/init-1.f90 @@ -0,0 +1,30 @@ +! { dg-do run } +! +! Test the OpenACC init directive at run time. + +use openacc + +implicit none + +logical :: l + +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 + +call acc_shutdown (acc_device_host) + +l = .true. +!$acc init if (l) device_type(host) + +if (acc_get_device_type () .ne. acc_device_host) stop 4 + +call acc_shutdown (acc_device_host) + +l = .false. +!$acc init if (l) device_type(host) + +end 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..3cdbe3b4c5b --- /dev/null +++ b/libgomp/testsuite/libgomp.oacc-fortran/set-1.f90 @@ -0,0 +1,37 @@ +! { 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 + +!$acc set device_num(0) + +if (acc_get_device_num (acc_device_host) .ne. 0) stop 3 + +l = .true. +!$acc set if (l) device_type(host) + +if (acc_get_device_type () .ne. acc_device_host) stop 4 + +l = .false. +n = 1 +!$acc set if (l) device_num(n) + +if (acc_get_device_num (acc_device_host) .ne. 0) stop 5 + +call acc_shutdown (acc_device_host) + +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..1dbf6209ead --- /dev/null +++ b/libgomp/testsuite/libgomp.oacc-fortran/shutdown-1.f90 @@ -0,0 +1,32 @@ +! { dg-do run } +! +! Test the OpenACC shutdown directive at run time. + +use openacc + +implicit none + +logical :: l + +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) + +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) + +l = .false. +!$acc shutdown if (l) device_type(host) + +!$acc shutdown + +end -- 2.54.0
