From 9316ad3b4354cbf2980f86902e54884e918c472a Mon Sep 17 00:00:00 2001 From: Julian Brown Date: Tue, 6 Dec 2022 12:18:33 +0000 Subject: OpenMP/Fortran: Combined directives with map/firstprivate of same symbol This patch fixes a case where a combined directive (e.g. "!$omp target parallel ...") contains both a map and a firstprivate clause for the same variable. When the combined directive is split into two nested directives, the outer "target" gets the "map" clause, and the inner "parallel" gets the "firstprivate" clause, like so: !$omp target parallel map(x) firstprivate(x) --> !$omp target map(x) !$omp parallel firstprivate(x) ... When there is no map of the same variable, the firstprivate is distributed to both directives, e.g. for 'y' in: !$omp target parallel map(x) firstprivate(y) --> !$omp target map(x) firstprivate(y) !$omp parallel firstprivate(y) ... This is not a recent regression, but appear to fix a long-standing ICE. (The included testcase is based on one by Tobias.) 2022-12-06 Julian Brown gcc/fortran/ * trans-openmp.cc (gfc_add_firstprivate_if_unmapped): New function. (gfc_split_omp_clauses): Call above. libgomp/ * testsuite/libgomp.fortran/combined-directive-splitting-1.f90: New test. --- gcc/fortran/trans-openmp.cc | 37 +++++++++++++++++++++++++++++++++++-- 1 file changed, 35 insertions(+), 2 deletions(-) (limited to 'gcc/fortran') diff --git a/gcc/fortran/trans-openmp.cc b/gcc/fortran/trans-openmp.cc index 7a4a339..395bcc9 100644 --- a/gcc/fortran/trans-openmp.cc +++ b/gcc/fortran/trans-openmp.cc @@ -5968,6 +5968,39 @@ gfc_add_clause_implicitly (gfc_omp_clauses *clauses_out, } } +/* Kind of opposite to above, add firstprivate to CLAUSES_OUT if it is mapped + in CLAUSES_IN's FIRSTPRIVATE list but not its MAP list. */ + +static void +gfc_add_firstprivate_if_unmapped (gfc_omp_clauses *clauses_out, + gfc_omp_clauses *clauses_in) +{ + gfc_omp_namelist *n = clauses_in->lists[OMP_LIST_FIRSTPRIVATE]; + gfc_omp_namelist **tail = NULL; + + for (; n != NULL; n = n->next) + { + gfc_omp_namelist *n2 = clauses_out->lists[OMP_LIST_MAP]; + for (; n2 != NULL; n2 = n2->next) + if (n->sym == n2->sym) + break; + if (n2 == NULL) + { + gfc_omp_namelist *dup = gfc_get_omp_namelist (); + *dup = *n; + dup->next = NULL; + if (!tail) + { + tail = &clauses_out->lists[OMP_LIST_FIRSTPRIVATE]; + while (*tail && (*tail)->next) + tail = &(*tail)->next; + } + *tail = dup; + tail = &(*tail)->next; + } + } +} + static void gfc_free_split_omp_clauses (gfc_code *code, gfc_omp_clauses *clausesa) { @@ -6351,8 +6384,8 @@ gfc_split_omp_clauses (gfc_code *code, simd and masked/master. Put it on the outermost of those and duplicate on parallel and teams. */ if (mask & GFC_OMP_MASK_TARGET) - clausesa[GFC_OMP_SPLIT_TARGET].lists[OMP_LIST_FIRSTPRIVATE] - = code->ext.omp_clauses->lists[OMP_LIST_FIRSTPRIVATE]; + gfc_add_firstprivate_if_unmapped (&clausesa[GFC_OMP_SPLIT_TARGET], + code->ext.omp_clauses); if (mask & GFC_OMP_MASK_TEAMS) clausesa[GFC_OMP_SPLIT_TEAMS].lists[OMP_LIST_FIRSTPRIVATE] = code->ext.omp_clauses->lists[OMP_LIST_FIRSTPRIVATE]; -- cgit v1.1 From 330b9a8d87dd73e10539da618496ad4964fee26d Mon Sep 17 00:00:00 2001 From: Julian Brown Date: Tue, 6 Dec 2022 23:10:58 +0000 Subject: OpenMP: Duplicate checking for map clauses in Fortran (PR107214) This patch adds duplicate checking for OpenMP "map" clauses, taking some cues from the implementation for C in c-typeck.cc:c_finish_omp_clauses (and similar for C++). In addition to the existing use of the "mark" and "comp_mark" bitfields in the gfc_symbol structure, the patch adds several new bits handling duplicate checking within various categories of clause types. If "mark" is being used for map clauses, we need to use different bits for other clauses for cases where "map" and some other clause can refer to the same symbol (e.g. "map(n) shared(n)"). 2022-12-06 Julian Brown gcc/fortran/ PR fortran/107214 * gfortran.h (gfc_symbol): Add data_mark, dev_mark, gen_mark and reduc_mark bitfields. * openmp.cc (resolve_omp_clauses): Use above bitfields to improve duplicate clause detection. gcc/testsuite/ PR fortran/107214 * gfortran.dg/gomp/pr107214.f90: New test. * gfortran.dg/gomp/pr107214-2.f90: New test. * gfortran.dg/gomp/pr107214-3.f90: New test. * gfortran.dg/gomp/pr107214-4.f90: New test. * gfortran.dg/gomp/pr107214-5.f90: New test. * gfortran.dg/gomp/pr107214-6.f90: New test. * gfortran.dg/gomp/pr107214-7.f90: New test. * gfortran.dg/gomp/pr107214-8.f90: New test. --- gcc/fortran/gfortran.h | 30 ++++++++++---- gcc/fortran/openmp.cc | 109 +++++++++++++++++++++++++++++++++++++++++-------- 2 files changed, 113 insertions(+), 26 deletions(-) (limited to 'gcc/fortran') diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 5f8a81a..219ef8c 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -1871,22 +1871,34 @@ typedef struct gfc_symbol gfc_namelist *namelist, *namelist_tail; + /* The tlink field is used in the front end to carry the module + declaration of separate module procedures so that the characteristics + can be compared with the corresponding declaration in a submodule. In + translation this field carries a linked list of symbols that require + deferred initialization. */ + struct gfc_symbol *tlink; + /* Change management fields. Symbols that might be modified by the current statement have the mark member nonzero. Of these symbols, symbols with old_symbol equal to NULL are symbols created within the current statement. Otherwise, old_symbol points to a copy of the old symbol. gfc_new is used in symbol.cc to flag new symbols. comp_mark is used to indicate variables which have component accesses - in OpenMP/OpenACC directive clauses. */ + in OpenMP/OpenACC directive clauses (cf. c-typeck.cc:c_finish_omp_clauses, + map_field_head). + data_mark is used to check duplicate mappings for OpenMP data-sharing + clauses (see firstprivate_head/lastprivate_head in the above function). + dev_mark is used to check duplicate mappings for OpenMP + is_device_ptr/has_device_addr clauses (see is_on_device_head in above + function). + gen_mark is used to check duplicate mappings for OpenMP + use_device_ptr/use_device_addr/private/shared clauses (see generic_head in + above functon). + reduc_mark is used to check duplicate mappings for OpenMP reduction + clauses. */ struct gfc_symbol *old_symbol; - unsigned mark:1, comp_mark:1, gfc_new:1; - - /* The tlink field is used in the front end to carry the module - declaration of separate module procedures so that the characteristics - can be compared with the corresponding declaration in a submodule. In - translation this field carries a linked list of symbols that require - deferred initialization. */ - struct gfc_symbol *tlink; + unsigned mark:1, comp_mark:1, data_mark:1, dev_mark:1, gen_mark:1; + unsigned reduc_mark:1, gfc_new:1; /* Nonzero if all equivalences associated with this symbol have been processed. */ diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc index 686f924..b71ee46 100644 --- a/gcc/fortran/openmp.cc +++ b/gcc/fortran/openmp.cc @@ -7150,6 +7150,10 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, continue; n->sym->mark = 0; n->sym->comp_mark = 0; + n->sym->data_mark = 0; + n->sym->dev_mark = 0; + n->sym->gen_mark = 0; + n->sym->reduc_mark = 0; if (n->sym->attr.flavor == FL_VARIABLE || n->sym->attr.proc_pointer || (!code && (!n->sym->attr.dummy || n->sym->ns != ns))) @@ -7218,14 +7222,9 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, && list != OMP_LIST_LASTPRIVATE && list != OMP_LIST_ALIGNED && list != OMP_LIST_DEPEND - && (list != OMP_LIST_MAP || openacc) && list != OMP_LIST_FROM && list != OMP_LIST_TO && (list != OMP_LIST_REDUCTION || !openacc) - && list != OMP_LIST_REDUCTION_INSCAN - && list != OMP_LIST_REDUCTION_TASK - && list != OMP_LIST_IN_REDUCTION - && list != OMP_LIST_TASK_REDUCTION && list != OMP_LIST_ALLOCATE) for (n = omp_clauses->lists[list]; n; n = n->next) { @@ -7237,10 +7236,58 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, for (gfc_ref *ref = n->expr->ref; ref; ref = ref->next) if (ref->type == REF_COMPONENT) component_ref_p = true; - if ((!component_ref_p && n->sym->comp_mark) - || (component_ref_p && n->sym->mark)) - gfc_error ("Symbol %qs has mixed component and non-component " - "accesses at %L", n->sym->name, &n->where); + if ((list == OMP_LIST_IS_DEVICE_PTR + || list == OMP_LIST_HAS_DEVICE_ADDR) + && !component_ref_p) + { + if (n->sym->gen_mark + || n->sym->dev_mark + || n->sym->reduc_mark + || n->sym->mark) + gfc_error ("Symbol %qs present on multiple clauses at %L", + n->sym->name, &n->where); + else + n->sym->dev_mark = 1; + } + else if ((list == OMP_LIST_USE_DEVICE_PTR + || list == OMP_LIST_USE_DEVICE_ADDR + || list == OMP_LIST_PRIVATE + || list == OMP_LIST_SHARED) + && !component_ref_p) + { + if (n->sym->gen_mark || n->sym->dev_mark || n->sym->reduc_mark) + gfc_error ("Symbol %qs present on multiple clauses at %L", + n->sym->name, &n->where); + else + { + n->sym->gen_mark = 1; + /* Set both generic and device bits if we have + use_device_*(x) or shared(x). This allows us to diagnose + "map(x) private(x)" below. */ + if (list != OMP_LIST_PRIVATE) + n->sym->dev_mark = 1; + } + } + else if ((list == OMP_LIST_REDUCTION + || list == OMP_LIST_REDUCTION_TASK + || list == OMP_LIST_REDUCTION_INSCAN + || list == OMP_LIST_IN_REDUCTION + || list == OMP_LIST_TASK_REDUCTION) + && !component_ref_p) + { + /* Attempts to mix reduction types are diagnosed below. */ + if (n->sym->gen_mark || n->sym->dev_mark) + gfc_error ("Symbol %qs present on multiple clauses at %L", + n->sym->name, &n->where); + n->sym->reduc_mark = 1; + } + else if ((!component_ref_p && n->sym->comp_mark) + || (component_ref_p && n->sym->mark)) + { + if (openacc) + gfc_error ("Symbol %qs has mixed component and non-component " + "accesses at %L", n->sym->name, &n->where); + } else if (n->sym->mark) gfc_error ("Symbol %qs present on multiple clauses at %L", n->sym->name, &n->where); @@ -7253,34 +7300,62 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, } } + /* Detect specifically the case where we have "map(x) private(x)" and raise + an error. If we have "...simd" combined directives though, the "private" + applies to the simd part, so this is permitted though. */ + for (n = omp_clauses->lists[OMP_LIST_PRIVATE]; n; n = n->next) + if (n->sym->mark + && n->sym->gen_mark + && !n->sym->dev_mark + && !n->sym->reduc_mark + && code->op != EXEC_OMP_TARGET_SIMD + && code->op != EXEC_OMP_TARGET_PARALLEL_DO_SIMD + && code->op != EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD + && code->op != EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD) + gfc_error ("Symbol %qs present on multiple clauses at %L", + n->sym->name, &n->where); + gcc_assert (OMP_LIST_LASTPRIVATE == OMP_LIST_FIRSTPRIVATE + 1); for (list = OMP_LIST_FIRSTPRIVATE; list <= OMP_LIST_LASTPRIVATE; list++) for (n = omp_clauses->lists[list]; n; n = n->next) - if (n->sym->mark) + if (n->sym->data_mark || n->sym->gen_mark || n->sym->dev_mark) { gfc_error ("Symbol %qs present on multiple clauses at %L", n->sym->name, &n->where); - n->sym->mark = 0; - } + n->sym->data_mark = n->sym->gen_mark = n->sym->dev_mark = 0; + } + else if (n->sym->mark + && code->op != EXEC_OMP_TARGET_TEAMS + && code->op != EXEC_OMP_TARGET_TEAMS_DISTRIBUTE + && code->op != EXEC_OMP_TARGET_TEAMS_LOOP + && code->op != EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD + && code->op != EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO + && code->op != EXEC_OMP_TARGET_PARALLEL + && code->op != EXEC_OMP_TARGET_PARALLEL_DO + && code->op != EXEC_OMP_TARGET_PARALLEL_LOOP + && code->op != EXEC_OMP_TARGET_PARALLEL_DO_SIMD + && code->op != EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD) + gfc_error ("Symbol %qs present on both data and map clauses " + "at %L", n->sym->name, &n->where); for (n = omp_clauses->lists[OMP_LIST_FIRSTPRIVATE]; n; n = n->next) { - if (n->sym->mark) + if (n->sym->data_mark || n->sym->gen_mark || n->sym->dev_mark) gfc_error ("Symbol %qs present on multiple clauses at %L", n->sym->name, &n->where); else - n->sym->mark = 1; + n->sym->data_mark = 1; } for (n = omp_clauses->lists[OMP_LIST_LASTPRIVATE]; n; n = n->next) - n->sym->mark = 0; + n->sym->data_mark = 0; for (n = omp_clauses->lists[OMP_LIST_LASTPRIVATE]; n; n = n->next) { - if (n->sym->mark) + if (n->sym->data_mark || n->sym->gen_mark || n->sym->dev_mark) gfc_error ("Symbol %qs present on multiple clauses at %L", n->sym->name, &n->where); else - n->sym->mark = 1; + n->sym->data_mark = 1; } for (n = omp_clauses->lists[OMP_LIST_ALIGNED]; n; n = n->next) -- cgit v1.1 From 26f4aefaebc056acacc2a842f5b092ed9e671ef0 Mon Sep 17 00:00:00 2001 From: GCC Administrator Date: Thu, 15 Dec 2022 00:17:29 +0000 Subject: Daily bump. --- gcc/fortran/ChangeLog | 13 +++++++++++++ 1 file changed, 13 insertions(+) (limited to 'gcc/fortran') diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index cbb0ecf..ed728eb 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,16 @@ +2022-12-14 Julian Brown + + PR fortran/107214 + * gfortran.h (gfc_symbol): Add data_mark, dev_mark, gen_mark and + reduc_mark bitfields. + * openmp.cc (resolve_omp_clauses): Use above bitfields to improve + duplicate clause detection. + +2022-12-14 Julian Brown + + * trans-openmp.cc (gfc_add_firstprivate_if_unmapped): New function. + (gfc_split_omp_clauses): Call above. + 2022-12-13 Steve Kargl PR fortran/107423 -- cgit v1.1