From 269322ece17202632bc354e9c510e4a5bd6ad84b Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Wed, 29 Jul 2020 10:37:44 +0200 Subject: [PATCH] OpenMP: Add 'omp requires' to Fortran (mostly parsing) gcc/fortran/ChangeLog: * gfortran.h (enum gfc_statement): Add ST_OMP_REQUIRES. (enum gfc_omp_requires_kind): New. (enum gfc_omp_atomic_op): Add GFC_OMP_ATOMIC_ACQ_REL. (struct gfc_namespace): Add omp_requires and omp_target_seen. (gfc_omp_requires_add_clause, (gfc_check_omp_requires): New. * match.h (gfc_match_omp_requires): New. * module.c (enum ab_attribute, attr_bits): Add omp requires clauses. (mio_symbol_attribute): Read/write them. * openmp.c (gfc_check_omp_requires, (gfc_omp_requires_add_clause, gfc_match_omp_requires): New. (gfc_match_omp_oacc_atomic): Use requires's default mem-order. * parse.c (decode_omp_directive): Match requires, set omp_target_seen. (gfc_ascii_statement): Handle ST_OMP_REQUIRES. * trans-openmp.c (gfc_trans_omp_atomic): Handle GFC_OMP_ATOMIC_ACQ_REL. gcc/testsuite/ChangeLog: * gfortran.dg/gomp/requires-1.f90: New test. * gfortran.dg/gomp/requires-2.f90: New test. * gfortran.dg/gomp/requires-3.f90: New test. * gfortran.dg/gomp/requires-4.f90: New test. * gfortran.dg/gomp/requires-5.f90: New test. * gfortran.dg/gomp/requires-6.f90: New test. * gfortran.dg/gomp/requires-7.f90: New test. * gfortran.dg/gomp/requires-8.f90: New test. * gfortran.dg/gomp/requires-9.f90: New test. --- gcc/fortran/gfortran.h | 30 +++- gcc/fortran/match.h | 1 + gcc/fortran/module.c | 73 +++++++- gcc/fortran/openmp.c | 244 ++++++++++++++++++++++++++ gcc/fortran/parse.c | 53 +++++- gcc/fortran/trans-openmp.c | 10 +- gcc/testsuite/gfortran.dg/gomp/requires-1.f90 | 13 ++ gcc/testsuite/gfortran.dg/gomp/requires-2.f90 | 14 ++ gcc/testsuite/gfortran.dg/gomp/requires-3.f90 | 4 + gcc/testsuite/gfortran.dg/gomp/requires-4.f90 | 36 ++++ gcc/testsuite/gfortran.dg/gomp/requires-5.f90 | 16 ++ gcc/testsuite/gfortran.dg/gomp/requires-6.f90 | 16 ++ gcc/testsuite/gfortran.dg/gomp/requires-7.f90 | 41 +++++ gcc/testsuite/gfortran.dg/gomp/requires-8.f90 | 22 +++ gcc/testsuite/gfortran.dg/gomp/requires-9.f90 | 85 +++++++++ 15 files changed, 648 insertions(+), 10 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/gomp/requires-1.f90 create mode 100644 gcc/testsuite/gfortran.dg/gomp/requires-2.f90 create mode 100644 gcc/testsuite/gfortran.dg/gomp/requires-3.f90 create mode 100644 gcc/testsuite/gfortran.dg/gomp/requires-4.f90 create mode 100644 gcc/testsuite/gfortran.dg/gomp/requires-5.f90 create mode 100644 gcc/testsuite/gfortran.dg/gomp/requires-6.f90 create mode 100644 gcc/testsuite/gfortran.dg/gomp/requires-7.f90 create mode 100644 gcc/testsuite/gfortran.dg/gomp/requires-8.f90 create mode 100644 gcc/testsuite/gfortran.dg/gomp/requires-9.f90 diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 5fa86aa..20cce5c 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -263,7 +263,7 @@ enum gfc_statement ST_OMP_TARGET_SIMD, ST_OMP_END_TARGET_SIMD, ST_OMP_TASKLOOP, ST_OMP_END_TASKLOOP, ST_OMP_TASKLOOP_SIMD, ST_OMP_END_TASKLOOP_SIMD, ST_OMP_ORDERED_DEPEND, - ST_PROCEDURE, ST_GENERIC, ST_CRITICAL, ST_END_CRITICAL, + ST_OMP_REQUIRES, ST_PROCEDURE, ST_GENERIC, ST_CRITICAL, ST_END_CRITICAL, ST_GET_FCN_CHARACTERISTICS, ST_LOCK, ST_UNLOCK, ST_EVENT_POST, ST_EVENT_WAIT, ST_FAIL_IMAGE, ST_FORM_TEAM, ST_CHANGE_TEAM, ST_END_TEAM, ST_SYNC_TEAM, ST_NONE @@ -1334,6 +1334,24 @@ enum gfc_omp_if_kind OMP_IF_LAST }; +enum gfc_omp_requires_kind +{ + /* Keep in sync with gfc_namespace, esp. with omp_req_mem_order. */ + OMP_REQ_ATOMIC_MEM_ORDER_SEQ_CST = 1, /* 01 */ + OMP_REQ_ATOMIC_MEM_ORDER_ACQ_REL = 2, /* 10 */ + OMP_REQ_ATOMIC_MEM_ORDER_RELAXED = 3, /* 11 */ + OMP_REQ_REVERSE_OFFLOAD = (1 << 2), + OMP_REQ_UNIFIED_ADDRESS = (1 << 3), + OMP_REQ_UNIFIED_SHARED_MEMORY = (1 << 4), + OMP_REQ_DYNAMIC_ALLOCATORS = (1 << 5), + OMP_REQ_TARGET_MASK = (OMP_REQ_REVERSE_OFFLOAD + | OMP_REQ_UNIFIED_ADDRESS + | OMP_REQ_UNIFIED_SHARED_MEMORY), + OMP_REQ_ATOMIC_MEM_ORDER_MASK = (OMP_REQ_ATOMIC_MEM_ORDER_SEQ_CST + | OMP_REQ_ATOMIC_MEM_ORDER_ACQ_REL + | OMP_REQ_ATOMIC_MEM_ORDER_RELAXED) +}; + typedef struct gfc_omp_clauses { struct gfc_expr *if_expr; @@ -1915,6 +1933,10 @@ typedef struct gfc_namespace /* Set to 1 if there are any calls to procedures with implicit interface. */ unsigned implicit_interface_calls:1; + + /* OpenMP requires. */ + unsigned omp_requires:6; + unsigned omp_target_seen:1; } gfc_namespace; @@ -2645,7 +2667,8 @@ enum gfc_omp_atomic_op GFC_OMP_ATOMIC_CAPTURE = 3, GFC_OMP_ATOMIC_MASK = 3, GFC_OMP_ATOMIC_SEQ_CST = 4, - GFC_OMP_ATOMIC_SWAP = 8 + GFC_OMP_ATOMIC_ACQ_REL = 8, + GFC_OMP_ATOMIC_SWAP = 16 }; typedef struct gfc_code @@ -3270,6 +3293,9 @@ gfc_expr *gfc_get_parentheses (gfc_expr *); /* openmp.c */ struct gfc_omp_saved_state { void *ptrs[2]; int ints[1]; }; +bool gfc_omp_requires_add_clause (gfc_omp_requires_kind, const char *, + locus *, const char *); +void gfc_check_omp_requires (gfc_namespace *, int); void gfc_free_omp_clauses (gfc_omp_clauses *); void gfc_free_oacc_declare_clauses (struct gfc_oacc_declare *); void gfc_free_omp_declare_simd (gfc_omp_declare_simd *); diff --git a/gcc/fortran/match.h b/gcc/fortran/match.h index b3fb703..7bf70d7 100644 --- a/gcc/fortran/match.h +++ b/gcc/fortran/match.h @@ -177,6 +177,7 @@ match gfc_match_omp_parallel_do (void); match gfc_match_omp_parallel_do_simd (void); match gfc_match_omp_parallel_sections (void); match gfc_match_omp_parallel_workshare (void); +match gfc_match_omp_requires (void); match gfc_match_omp_sections (void); match gfc_match_omp_simd (void); match gfc_match_omp_single (void); diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c index eccf92b..384d0ae 100644 --- a/gcc/fortran/module.c +++ b/gcc/fortran/module.c @@ -2047,7 +2047,11 @@ enum ab_attribute AB_OMP_DECLARE_TARGET_LINK, AB_PDT_KIND, AB_PDT_LEN, AB_PDT_TYPE, AB_PDT_TEMPLATE, AB_PDT_ARRAY, AB_PDT_STRING, AB_OACC_ROUTINE_LOP_GANG, AB_OACC_ROUTINE_LOP_WORKER, - AB_OACC_ROUTINE_LOP_VECTOR, AB_OACC_ROUTINE_LOP_SEQ + AB_OACC_ROUTINE_LOP_VECTOR, AB_OACC_ROUTINE_LOP_SEQ, + AB_OMP_REQ_REVERSE_OFFLOAD, AB_OMP_REQ_UNIFIED_ADDRESS, + AB_OMP_REQ_UNIFIED_SHARED_MEMORY, AB_OMP_REQ_DYNAMIC_ALLOCATORS, + AB_OMP_REQ_MEM_ORDER_SEQ_CST, AB_OMP_REQ_MEM_ORDER_ACQ_REL, + AB_OMP_REQ_MEM_ORDER_RELAXED }; static const mstring attr_bits[] = @@ -2121,6 +2125,13 @@ static const mstring attr_bits[] = minit ("OACC_ROUTINE_LOP_WORKER", AB_OACC_ROUTINE_LOP_WORKER), minit ("OACC_ROUTINE_LOP_VECTOR", AB_OACC_ROUTINE_LOP_VECTOR), minit ("OACC_ROUTINE_LOP_SEQ", AB_OACC_ROUTINE_LOP_SEQ), + minit ("OMP_REQ_REVERSE_OFFLOAD", AB_OMP_REQ_REVERSE_OFFLOAD), + minit ("OMP_REQ_UNIFIED_ADDRESS", AB_OMP_REQ_UNIFIED_ADDRESS), + minit ("OMP_REQ_UNIFIED_SHARED_MEMORY", AB_OMP_REQ_UNIFIED_SHARED_MEMORY), + minit ("OMP_REQ_DYNAMIC_ALLOCATORS", AB_OMP_REQ_DYNAMIC_ALLOCATORS), + minit ("OMP_REQ_MEM_ORDER_SEQ_CST", AB_OMP_REQ_MEM_ORDER_SEQ_CST), + minit ("OMP_REQ_MEM_ORDER_ACQ_REL", AB_OMP_REQ_MEM_ORDER_ACQ_REL), + minit ("OMP_REQ_MEM_ORDER_RELAXED", AB_OMP_REQ_MEM_ORDER_RELAXED), minit (NULL, -1) }; @@ -2366,8 +2377,27 @@ mio_symbol_attribute (symbol_attribute *attr) gcc_unreachable (); } + if (attr->flavor == FL_MODULE && gfc_current_ns->omp_requires) + { + if (gfc_current_ns->omp_requires & OMP_REQ_REVERSE_OFFLOAD) + MIO_NAME (ab_attribute) (AB_OMP_REQ_REVERSE_OFFLOAD, attr_bits); + if (gfc_current_ns->omp_requires & OMP_REQ_UNIFIED_ADDRESS) + MIO_NAME (ab_attribute) (AB_OMP_REQ_UNIFIED_ADDRESS, attr_bits); + if (gfc_current_ns->omp_requires & OMP_REQ_UNIFIED_SHARED_MEMORY) + MIO_NAME (ab_attribute) (AB_OMP_REQ_UNIFIED_SHARED_MEMORY, attr_bits); + if (gfc_current_ns->omp_requires & OMP_REQ_DYNAMIC_ALLOCATORS) + MIO_NAME (ab_attribute) (AB_OMP_REQ_DYNAMIC_ALLOCATORS, attr_bits); + if ((gfc_current_ns->omp_requires & OMP_REQ_ATOMIC_MEM_ORDER_MASK) + == OMP_REQ_ATOMIC_MEM_ORDER_SEQ_CST) + MIO_NAME (ab_attribute) (AB_OMP_REQ_MEM_ORDER_SEQ_CST, attr_bits); + if ((gfc_current_ns->omp_requires & OMP_REQ_ATOMIC_MEM_ORDER_MASK) + == OMP_REQ_ATOMIC_MEM_ORDER_ACQ_REL) + MIO_NAME (ab_attribute) (AB_OMP_REQ_MEM_ORDER_ACQ_REL, attr_bits); + if ((gfc_current_ns->omp_requires & OMP_REQ_ATOMIC_MEM_ORDER_MASK) + == OMP_REQ_ATOMIC_MEM_ORDER_RELAXED) + MIO_NAME (ab_attribute) (AB_OMP_REQ_MEM_ORDER_RELAXED, attr_bits); + } mio_rparen (); - } else { @@ -2592,6 +2622,45 @@ mio_symbol_attribute (symbol_attribute *attr) verify_OACC_ROUTINE_LOP_NONE (attr->oacc_routine_lop); attr->oacc_routine_lop = OACC_ROUTINE_LOP_SEQ; break; + case AB_OMP_REQ_REVERSE_OFFLOAD: + gfc_omp_requires_add_clause (OMP_REQ_REVERSE_OFFLOAD, + "reverse_offload", + &gfc_current_locus, + module_name); + break; + case AB_OMP_REQ_UNIFIED_ADDRESS: + gfc_omp_requires_add_clause (OMP_REQ_UNIFIED_ADDRESS, + "unified_address", + &gfc_current_locus, + module_name); + break; + case AB_OMP_REQ_UNIFIED_SHARED_MEMORY: + gfc_omp_requires_add_clause (OMP_REQ_UNIFIED_SHARED_MEMORY, + "unified_shared_memory", + &gfc_current_locus, + module_name); + break; + case AB_OMP_REQ_DYNAMIC_ALLOCATORS: + gfc_omp_requires_add_clause (OMP_REQ_DYNAMIC_ALLOCATORS, + "dynamic_allocators", + &gfc_current_locus, + module_name); + break; + case AB_OMP_REQ_MEM_ORDER_SEQ_CST: + gfc_omp_requires_add_clause (OMP_REQ_ATOMIC_MEM_ORDER_SEQ_CST, + "seq_cst", &gfc_current_locus, + module_name); + break; + case AB_OMP_REQ_MEM_ORDER_ACQ_REL: + gfc_omp_requires_add_clause (OMP_REQ_ATOMIC_MEM_ORDER_ACQ_REL, + "acq_rel", &gfc_current_locus, + module_name); + break; + case AB_OMP_REQ_MEM_ORDER_RELAXED: + gfc_omp_requires_add_clause (OMP_REQ_ATOMIC_MEM_ORDER_RELAXED, + "relaxed", &gfc_current_locus, + module_name); + break; } } } diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c index 4a0466f..0fd9988 100644 --- a/gcc/fortran/openmp.c +++ b/gcc/fortran/openmp.c @@ -3424,6 +3424,230 @@ gfc_match_omp_parallel_workshare (void) return match_omp (EXEC_OMP_PARALLEL_WORKSHARE, OMP_PARALLEL_CLAUSES); } +void +gfc_check_omp_requires (gfc_namespace *ns, int ref_omp_requires) +{ + if (ns->omp_target_seen + && (ns->omp_requires & OMP_REQ_TARGET_MASK) + != (ref_omp_requires & OMP_REQ_TARGET_MASK)) + { + gcc_assert (ns->proc_name); + if ((ref_omp_requires & OMP_REQ_REVERSE_OFFLOAD) + && !(ns->omp_requires & OMP_REQ_REVERSE_OFFLOAD)) + gfc_error ("Program unit at %L has OpenMP device constructs/routines " + "but does not set !$OMP REQUIRES REVERSE_OFFSET but other " + "program units do", &ns->proc_name->declared_at); + if ((ref_omp_requires & OMP_REQ_UNIFIED_ADDRESS) + && !(ns->omp_requires & OMP_REQ_UNIFIED_ADDRESS)) + gfc_error ("Program unit at %L has OpenMP device constructs/routines " + "but does not set !$OMP REQUIRES UNIFIED_ADDRESS but other " + "program units do", &ns->proc_name->declared_at); + if ((ref_omp_requires & OMP_REQ_UNIFIED_SHARED_MEMORY) + && !(ns->omp_requires & OMP_REQ_UNIFIED_SHARED_MEMORY)) + gfc_error ("Program unit at %L has OpenMP device constructs/routines " + "but does not set !$OMP REQUIRES UNIFIED_SHARED_MEMORY but " + "other program units do", &ns->proc_name->declared_at); + } +} + +bool +gfc_omp_requires_add_clause (gfc_omp_requires_kind clause, + const char *clause_name, locus *loc, + const char *module_name) +{ + gfc_namespace *prog_unit = gfc_current_ns; + while (prog_unit->parent) + { + if (gfc_state_stack->previous + && gfc_state_stack->previous->state == COMP_INTERFACE) + break; + prog_unit = prog_unit->parent; + } + + /* Requires added after use. */ + if (prog_unit->omp_target_seen + && (clause & OMP_REQ_TARGET_MASK) + && !(prog_unit->omp_requires & clause)) + { + if (module_name) + gfc_error ("!$OMP REQUIRES clause %qs specified via module %qs use " + "at %L comes after using a device construct/routine", + clause_name, module_name, loc); + else + gfc_error ("!$OMP REQUIRES clause %qs specified at %L comes after " + "using a device construct/routine", clause_name, loc); + return false; + } + + /* Overriding atomic_default_mem_order clause value. */ + if ((clause & OMP_REQ_ATOMIC_MEM_ORDER_MASK) + && (prog_unit->omp_requires & OMP_REQ_ATOMIC_MEM_ORDER_MASK) + && (prog_unit->omp_requires & OMP_REQ_ATOMIC_MEM_ORDER_MASK) + != (int) clause) + { + const char *other; + if (prog_unit->omp_requires & OMP_REQ_ATOMIC_MEM_ORDER_SEQ_CST) + other = "seq_cst"; + else if (prog_unit->omp_requires & OMP_REQ_ATOMIC_MEM_ORDER_ACQ_REL) + other = "acq_rel"; + else if (prog_unit->omp_requires & OMP_REQ_ATOMIC_MEM_ORDER_RELAXED) + other = "relaxed"; + else + gcc_unreachable (); + + if (module_name) + gfc_error ("!$OMP REQUIRES clause % " + "specified via module %qs use at %L overrides a previous " + "% (which might be through " + "using a module)", clause_name, module_name, loc, other); + else + gfc_error ("!$OMP REQUIRES clause % " + "specified at %L overrides a previous " + "% (which might be through " + "using a module)", clause_name, loc, other); + return false; + } + + /* Requires via module not at program-unit level and not repeating clause. */ + if (prog_unit != gfc_current_ns && !(prog_unit->omp_requires & clause)) + { + if (clause & OMP_REQ_ATOMIC_MEM_ORDER_MASK) + gfc_error ("!$OMP REQUIRES clause % " + "specified via module %qs use at %L but same clause is " + "not set at for the program unit", clause_name, module_name, + loc); + else + gfc_error ("!$OMP REQUIRES clause %qs specified via module %qs use at " + "%L but same clause is not set at for the program unit", + clause_name, module_name, loc); + return false; + } + + if (!gfc_state_stack->previous + || gfc_state_stack->previous->state != COMP_INTERFACE) + prog_unit->omp_requires |= clause; + return true; +} + +match +gfc_match_omp_requires (void) +{ + static const char *clauses[] = {"reverse_offload", + "unified_address", + "unified_shared_memory", + "dynamic_allocators", + "atomic_default"}; + const char *clause = NULL; + int requires_clauses = 0; + bool first = true; + locus old_loc; + + if (gfc_current_ns->parent + && (!gfc_state_stack->previous + || gfc_state_stack->previous->state != COMP_INTERFACE)) + { + gfc_error ("!$OMP REQUIRES at %C must appear in the specification part " + "of a program unit"); + return MATCH_ERROR; + } + + while (true) + { + old_loc = gfc_current_locus; + gfc_omp_requires_kind requires_clause; + if ((first || gfc_match_char (',') != MATCH_YES) + && (first && gfc_match_space () != MATCH_YES)) + goto error; + first = false; + gfc_gobble_whitespace (); + old_loc = gfc_current_locus; + + if (gfc_match_omp_eos () != MATCH_NO) + break; + if (gfc_match (clauses[0]) == MATCH_YES) + { + clause = clauses[0]; + requires_clause = OMP_REQ_REVERSE_OFFLOAD; + if (requires_clauses & OMP_REQ_REVERSE_OFFLOAD) + goto duplicate_clause; + } + else if (gfc_match (clauses[1]) == MATCH_YES) + { + clause = clauses[1]; + requires_clause = OMP_REQ_UNIFIED_ADDRESS; + if (requires_clauses & OMP_REQ_UNIFIED_ADDRESS) + goto duplicate_clause; + } + else if (gfc_match (clauses[2]) == MATCH_YES) + { + clause = clauses[2]; + requires_clause = OMP_REQ_UNIFIED_SHARED_MEMORY; + if (requires_clauses & OMP_REQ_UNIFIED_SHARED_MEMORY) + goto duplicate_clause; + } + else if (gfc_match (clauses[3]) == MATCH_YES) + { + clause = clauses[3]; + requires_clause = OMP_REQ_DYNAMIC_ALLOCATORS; + if (requires_clauses & OMP_REQ_DYNAMIC_ALLOCATORS) + goto duplicate_clause; + } + else if (gfc_match ("atomic_default_mem_order (") == MATCH_YES) + { + clause = clauses[4]; + if (requires_clauses & OMP_REQ_ATOMIC_MEM_ORDER_MASK) + goto duplicate_clause; + if (gfc_match (" seq_cst )") == MATCH_YES) + { + clause = "seq_cst"; + requires_clause = OMP_REQ_ATOMIC_MEM_ORDER_SEQ_CST; + } + else if (gfc_match (" acq_rel )") == MATCH_YES) + { + clause = "acq_rel"; + requires_clause = OMP_REQ_ATOMIC_MEM_ORDER_ACQ_REL; + } + else if (gfc_match (" relaxed )") == MATCH_YES) + { + clause = "relaxed"; + requires_clause = OMP_REQ_ATOMIC_MEM_ORDER_RELAXED; + } + else + { + gfc_error ("Expected SEQ_CST, ACQ_REL or RELAXED for " + "ATOMIC_DEFAULT_MEM_ORDER clause at %C"); + goto error; + } + } + else + goto error; + + if (requires_clause & ~OMP_REQ_ATOMIC_MEM_ORDER_MASK) + gfc_error_now ("Sorry, %qs clause at %L on REQUIRES directive is not " + "yet supported", clause, &old_loc); + if (!gfc_omp_requires_add_clause (requires_clause, clause, &old_loc, NULL)) + goto error; + requires_clauses |= requires_clause; + } + + if (requires_clauses == 0) + { + if (!gfc_error_flag_test ()) + gfc_error ("Clause expected at %C"); + goto error; + } + return MATCH_YES; + +duplicate_clause: + gfc_error ("%qs clause at %L specified more than once", clause, &old_loc); +error: + if (!gfc_error_flag_test ()) + gfc_error ("Expected UNIFIED_ADDRESS, UNIFIED_SHARED_MEMORY, " + "DYNAMIC_ALLOCATORS, REVERSE_OFFLOAD, or " + "ATOMIC_DEFAULT_MEM_ORDER clause at %L", &old_loc); + return MATCH_ERROR; +} + match gfc_match_omp_sections (void) @@ -3745,6 +3969,26 @@ gfc_match_omp_oacc_atomic (bool omp_p) new_st.op = (omp_p ? EXEC_OMP_ATOMIC : EXEC_OACC_ATOMIC); if (seq_cst) op = (gfc_omp_atomic_op) (op | GFC_OMP_ATOMIC_SEQ_CST); + else if (omp_p) + { + gfc_namespace *prog_unit = gfc_current_ns; + while (prog_unit->parent) + prog_unit = prog_unit->parent; + switch (prog_unit->omp_requires & OMP_REQ_ATOMIC_MEM_ORDER_MASK) + { + case 0: + case OMP_REQ_ATOMIC_MEM_ORDER_RELAXED: + break; + case OMP_REQ_ATOMIC_MEM_ORDER_SEQ_CST: + op = (gfc_omp_atomic_op) (op | GFC_OMP_ATOMIC_SEQ_CST); + break; + case OMP_REQ_ATOMIC_MEM_ORDER_ACQ_REL: + op = (gfc_omp_atomic_op) (op | GFC_OMP_ATOMIC_ACQ_REL); + break; + default: + gcc_unreachable (); + } + } new_st.ext.omp_atomic = op; return MATCH_YES; } diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c index 96fd4aa..6669621 100644 --- a/gcc/fortran/parse.c +++ b/gcc/fortran/parse.c @@ -995,6 +995,9 @@ decode_omp_directive (void) ST_OMP_PARALLEL_WORKSHARE); matcho ("parallel", gfc_match_omp_parallel, ST_OMP_PARALLEL); break; + case 'r': + matcho ("requires", gfc_match_omp_requires, ST_OMP_REQUIRES); + break; case 's': matcho ("sections", gfc_match_omp_sections, ST_OMP_SECTIONS); matcho ("section", gfc_match_omp_eos_error, ST_OMP_SECTION); @@ -1086,6 +1089,38 @@ decode_omp_directive (void) return ST_NONE; } } + switch (ret) + { + case ST_OMP_DECLARE_TARGET: + case ST_OMP_TARGET: + case ST_OMP_TARGET_DATA: + case ST_OMP_TARGET_ENTER_DATA: + case ST_OMP_TARGET_EXIT_DATA: + case ST_OMP_TARGET_TEAMS: + case ST_OMP_TARGET_TEAMS_DISTRIBUTE: + case ST_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD: + case ST_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO: + case ST_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: + case ST_OMP_TARGET_PARALLEL: + case ST_OMP_TARGET_PARALLEL_DO: + case ST_OMP_TARGET_PARALLEL_DO_SIMD: + case ST_OMP_TARGET_SIMD: + case ST_OMP_TARGET_UPDATE: + { + gfc_namespace *prog_unit = gfc_current_ns; + while (prog_unit->parent) + { + if (gfc_state_stack->previous + && gfc_state_stack->previous->state == COMP_INTERFACE) + break; + prog_unit = prog_unit->parent; + } + prog_unit->omp_target_seen = true; + break; + } + default: + break; + } return ret; do_spec_only: @@ -1604,7 +1639,8 @@ next_statement (void) /* OpenMP declaration statements. */ #define case_omp_decl case ST_OMP_THREADPRIVATE: case ST_OMP_DECLARE_SIMD: \ - case ST_OMP_DECLARE_TARGET: case ST_OMP_DECLARE_REDUCTION + case ST_OMP_DECLARE_TARGET: case ST_OMP_DECLARE_REDUCTION: \ + case ST_OMP_REQUIRES /* Block end statements. Errors associated with interchanging these are detected in gfc_match_end(). */ @@ -2407,6 +2443,9 @@ gfc_ascii_statement (gfc_statement st) case ST_OMP_PARALLEL_WORKSHARE: p = "!$OMP PARALLEL WORKSHARE"; break; + case ST_OMP_REQUIRES: + p = "!$OMP REQUIRES"; + break; case ST_OMP_SECTIONS: p = "!$OMP SECTIONS"; break; @@ -6516,10 +6555,18 @@ done: } while (changed); - /* Fixup for external procedures. */ + /* Fixup for external procedures and resolve 'omp requires'. */ + int omp_requires; + omp_requires = 0; + for (gfc_current_ns = gfc_global_ns_list; gfc_current_ns; + gfc_current_ns = gfc_current_ns->sibling) + { + omp_requires |= gfc_current_ns->omp_requires; + gfc_check_externals (gfc_current_ns); + } for (gfc_current_ns = gfc_global_ns_list; gfc_current_ns; gfc_current_ns = gfc_current_ns->sibling) - gfc_check_externals (gfc_current_ns); + gfc_check_omp_requires (gfc_current_ns, omp_requires); /* Do the parse tree dump. */ gfc_current_ns = flag_dump_fortran_original ? gfc_global_ns_list : NULL; diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c index d12d7fb..f6a39ed 100644 --- a/gcc/fortran/trans-openmp.c +++ b/gcc/fortran/trans-openmp.c @@ -3932,9 +3932,13 @@ gfc_trans_omp_atomic (gfc_code *code) enum tree_code op = ERROR_MARK; enum tree_code aop = OMP_ATOMIC; bool var_on_left = false; - enum omp_memory_order mo - = ((atomic_code->ext.omp_atomic & GFC_OMP_ATOMIC_SEQ_CST) - ? OMP_MEMORY_ORDER_SEQ_CST : OMP_MEMORY_ORDER_RELAXED); + enum omp_memory_order mo; + if (atomic_code->ext.omp_atomic & GFC_OMP_ATOMIC_SEQ_CST) + mo = OMP_MEMORY_ORDER_SEQ_CST; + else if (atomic_code->ext.omp_atomic & GFC_OMP_ATOMIC_ACQ_REL) + mo = OMP_MEMORY_ORDER_ACQ_REL; + else + mo = OMP_MEMORY_ORDER_RELAXED; code = code->block->next; gcc_assert (code->op == EXEC_ASSIGN); diff --git a/gcc/testsuite/gfortran.dg/gomp/requires-1.f90 b/gcc/testsuite/gfortran.dg/gomp/requires-1.f90 new file mode 100644 index 0000000..b115a65 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/requires-1.f90 @@ -0,0 +1,13 @@ +subroutine foo +!$omp requires unified_address +!$omp requires unified_shared_memory +!$omp requires unified_shared_memory unified_address +!$omp requires dynamic_allocators,reverse_offload +end + +subroutine bar +!$omp requires unified_shared_memory unified_address +!$omp requires atomic_default_mem_order(seq_cst) +end + +! { dg-prune-output "not yet supported" } diff --git a/gcc/testsuite/gfortran.dg/gomp/requires-2.f90 b/gcc/testsuite/gfortran.dg/gomp/requires-2.f90 new file mode 100644 index 0000000..7b63d4a --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/requires-2.f90 @@ -0,0 +1,14 @@ +!$omp requires ! { dg-error "Clause expected" } +!$omp requires unified_shared_memory,unified_shared_memory ! { dg-error "specified more than once" } +!$omp requires unified_address unified_address ! { dg-error "specified more than once" } +!$omp requires reverse_offload reverse_offload ! { dg-error "specified more than once" } +!$omp requires foobarbaz ! { dg-error "Expected UNIFIED_ADDRESS, UNIFIED_SHARED_MEMORY, DYNAMIC_ALLOCATORS, REVERSE_OFFLOAD, or ATOMIC_DEFAULT_MEM_ORDER clause" } +!$omp requires dynamic_allocators , dynamic_allocators ! { dg-error "specified more than once" } +!$omp requires atomic_default_mem_order(seq_cst) atomic_default_mem_order(seq_cst) ! { dg-error "specified more than once" } +!$omp requires atomic_default_mem_order (seq_cst) +!$omp requires atomic_default_mem_order (seq_cst) +!$omp requires atomic_default_mem_order (acq_rel) ! { dg-error "overrides a previous 'atomic_default_mem_order\\(seq_cst\\)'" } +!$omp requires atomic_default_mem_order (foo) ! { dg-error "Expected SEQ_CST, ACQ_REL or RELAXED for ATOMIC_DEFAULT_MEM_ORDER clause" } +end + +! { dg-prune-output "not yet supported" } diff --git a/gcc/testsuite/gfortran.dg/gomp/requires-3.f90 b/gcc/testsuite/gfortran.dg/gomp/requires-3.f90 new file mode 100644 index 0000000..4429aab --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/requires-3.f90 @@ -0,0 +1,4 @@ +!$omp requires atomic_default_mem_order(acquire) ! { dg-error "Expected SEQ_CST, ACQ_REL or RELAXED for ATOMIC_DEFAULT_MEM_ORDER clause" } +!$omp requires atomic_default_mem_order(release) ! { dg-error "Expected SEQ_CST, ACQ_REL or RELAXED for ATOMIC_DEFAULT_MEM_ORDER clause" } +!$omp requires atomic_default_mem_order(foobar) ! { dg-error "Expected SEQ_CST, ACQ_REL or RELAXED for ATOMIC_DEFAULT_MEM_ORDER clause" } +end diff --git a/gcc/testsuite/gfortran.dg/gomp/requires-4.f90 b/gcc/testsuite/gfortran.dg/gomp/requires-4.f90 new file mode 100644 index 0000000..e0eb4db --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/requires-4.f90 @@ -0,0 +1,36 @@ +subroutine bar +!$omp requires unified_shared_memory,unified_address,reverse_offload +end + +module m +!$omp requires unified_shared_memory,unified_address,reverse_offload +end module m + +subroutine foo + !$omp target + !$omp end target +! { dg-error "OpenMP device constructs/routines but does not set !.OMP REQUIRES REVERSE_OFFSET but other program units do" "" { target *-*-* } 9 } +! { dg-error "OpenMP device constructs/routines but does not set !.OMP REQUIRES UNIFIED_ADDRESS but other program units do" "" { target *-*-* } 9 } +! { dg-error "OpenMP device constructs/routines but does not set !.OMP REQUIRES UNIFIED_SHARED_MEMORY but other program units do" "" { target *-*-* } 9 } +end + +subroutine foobar +i = 5 ! < execution statement +!$omp requires atomic_default_mem_order(seq_cst) ! { dg-error "Unexpected ..OMP REQUIRES statement" } +end + +program main +!$omp requires dynamic_allocators ! OK +!$omp requires unified_shared_memory +!$omp requires unified_address +!$omp requires reverse_offload +contains + subroutine foo + !$target + !$end target + end subroutine + subroutine bar + !$omp requires unified_addres ! { dg-error "must appear in the specification part of a program unit" } + end subroutine bar +end +! { dg-prune-output "not yet supported" } diff --git a/gcc/testsuite/gfortran.dg/gomp/requires-5.f90 b/gcc/testsuite/gfortran.dg/gomp/requires-5.f90 new file mode 100644 index 0000000..ade2a36 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/requires-5.f90 @@ -0,0 +1,16 @@ +subroutine bar +!$omp requires atomic_default_mem_order(seq_cst) +!$omp requires unified_shared_memory +end + +subroutine foo +!$omp requires unified_shared_memory +!$omp requires unified_shared_memory +!$omp requires atomic_default_mem_order(relaxed) +!$omp requires atomic_default_mem_order(relaxed) +!$omp requires atomic_default_mem_order(seq_cst) ! { dg-error "overrides a previous 'atomic_default_mem_order\\(seq_cst\\)'" } + !$omp target + !$omp end target +end + +! { dg-prune-output "not yet supported" } diff --git a/gcc/testsuite/gfortran.dg/gomp/requires-6.f90 b/gcc/testsuite/gfortran.dg/gomp/requires-6.f90 new file mode 100644 index 0000000..cabd3d9 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/requires-6.f90 @@ -0,0 +1,16 @@ +subroutine bar +!$omp atomic + i = i + 5 +end + +subroutine foo +!$omp requires atomic_default_mem_order(seq_cst) +end + +subroutine foobar +!$omp atomic + i = i + 5 +!$omp requires atomic_default_mem_order(acq_rel) ! { dg-error "Unexpected !.OMP REQUIRES statement" } +end + +! { dg-prune-output "not yet supported" } diff --git a/gcc/testsuite/gfortran.dg/gomp/requires-7.f90 b/gcc/testsuite/gfortran.dg/gomp/requires-7.f90 new file mode 100644 index 0000000..3d75b89 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/requires-7.f90 @@ -0,0 +1,41 @@ +subroutine bar2 + block + !$omp requires unified_shared_memory ! { dg-error "must appear in the specification part of a program unit" } + end block +end + +subroutine bar +contains + subroutine foo + !$omp requires unified_shared_memory ! { dg-error "must appear in the specification part of a program unit" } + end +end + +module m +contains + subroutine foo + !$omp requires unified_shared_memory ! { dg-error "must appear in the specification part of a program unit" } + end +end + +module m2 + interface + module subroutine foo() + end + end interface +end + +submodule (m2) m2_sub + !$omp requires unified_shared_memory +contains + module procedure foo + end +end + +program main +contains + subroutine foo + !$omp requires unified_shared_memory ! { dg-error "must appear in the specification part of a program unit" } + end +end +! { dg-prune-output "not yet supported" } diff --git a/gcc/testsuite/gfortran.dg/gomp/requires-8.f90 b/gcc/testsuite/gfortran.dg/gomp/requires-8.f90 new file mode 100644 index 0000000..3c32ae9 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/requires-8.f90 @@ -0,0 +1,22 @@ +module m ! { dg-error "has OpenMP device constructs/routines but does not set !.OMP REQUIRES UNIFIED_SHARED_MEMORY but other program units do" } + !$omp requires reverse_offload +contains + subroutine foo + interface + subroutine bar2 + !$!omp requires dynamic_allocators + end subroutine + end interface + !$omp target + call bar2() + !$omp end target + end subroutine foo +end module m + +subroutine bar ! { dg-error "has OpenMP device constructs/routines but does not set !.OMP REQUIRES REVERSE_OFFSET but other program units do" } + !use m + !$omp requires unified_shared_memory + !$omp declare target +end subroutine bar + +! { dg-prune-output "not yet supported" } diff --git a/gcc/testsuite/gfortran.dg/gomp/requires-9.f90 b/gcc/testsuite/gfortran.dg/gomp/requires-9.f90 new file mode 100644 index 0000000..a2b0f50 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/requires-9.f90 @@ -0,0 +1,85 @@ +! { dg-additional-options "-fdump-tree-original" } + +module relaxed + !$omp requires atomic_default_mem_order(relaxed) +end module relaxed + +module seq + !$omp requires atomic_default_mem_order(seq_cst) +end module seq + +module acq + !$omp requires atomic_default_mem_order(acq_rel) +end module acq + +subroutine sub1 + !$omp atomic ! <= relaxed + i1 = i1 + 5 +end subroutine + +subroutine sub2 + !$omp atomic seq_cst + i2 = i2 + 5 +end subroutine + +subroutine sub3 + use relaxed + !$omp atomic + i3 = i3 + 5 +end subroutine + +subroutine sub4 + use relaxed + !$omp atomic seq_cst + i4 = i4 + 5 +end subroutine + +subroutine sub5 + use seq + !$omp atomic + i5 = i5 + 5 +contains + subroutine bar + block + !$omp atomic + i5b = i5b + 5 + end block + end +end subroutine + +subroutine sub6 + use seq + !$omp atomic seq_cst + i6 = i6 + 5 +end subroutine + +subroutine sub7 + use acq + !$omp atomic + i7 = i7 + 5 +contains + subroutine foobar + block + !$omp atomic + i7b = i7b + 5 + end block + end +end subroutine + +subroutine sub8 + use acq + !$omp atomic seq_cst + i8 = i8 + 5 +end subroutine + +! { dg-final { scan-tree-dump-times "#pragma omp atomic relaxed\[\n\r]\[^\n\r]*&i1 =" 1 "original" } } +! { dg-final { scan-tree-dump-times "#pragma omp atomic seq_cst\[\n\r]\[^\n\r]*&i2 =" 1 "original" } } +! { dg-final { scan-tree-dump-times "#pragma omp atomic relaxed\[\n\r]\[^\n\r]*&i3 =" 1 "original" } } +! { dg-final { scan-tree-dump-times "#pragma omp atomic seq_cst\[\n\r]\[^\n\r]*&i4 =" 1 "original" } } +! { dg-final { scan-tree-dump-times "#pragma omp atomic seq_cst\[\n\r]\[^\n\r]*&i5 =" 1 "original" } } +! { dg-final { scan-tree-dump-times "#pragma omp atomic seq_cst\[\n\r]\[^\n\r]*&i5 =" 1 "original" } } +! { dg-final { scan-tree-dump-times "#pragma omp atomic seq_cst\[\n\r]\[^\n\r]*&i5b =" 1 "original" } } +! { dg-final { scan-tree-dump-times "#pragma omp atomic seq_cst\[\n\r]\[^\n\r]*&i6 =" 1 "original" } } +! { dg-final { scan-tree-dump-times "#pragma omp atomic acq_rel\[\n\r]\[^\n\r]*&i7 =" 1 "original" } } +! { dg-final { scan-tree-dump-times "#pragma omp atomic acq_rel\[\n\r]\[^\n\r]*&i7b =" 1 "original" } } +! { dg-final { scan-tree-dump-times "#pragma omp atomic seq_cst\[\n\r]\[^\n\r]*&i8 =" 1 "original" } } -- 2.7.4