* [PATCH 00/12] OpenMP: Metadirective support + "declare variant" improvements
@ 2024-05-04 21:21 Sandra Loosemore
2024-05-04 21:21 ` [PATCH 01/12] OpenMP: metadirective tree data structures and front-end interfaces Sandra Loosemore
` (11 more replies)
0 siblings, 12 replies; 13+ messages in thread
From: Sandra Loosemore @ 2024-05-04 21:21 UTC (permalink / raw)
To: gcc-patches; +Cc: jakub, tburnus
This series of patches is a revised and extended version of the metadirective
patches I previously posted in January:
https://gcc.gnu.org/pipermail/gcc-patches/2024-January/642005.html
Those in turn were based on work by Kwok originally implemented on the
devel/omp/gcc-11 branch in 2021 and previously submitted for mainline 3+
years ago.
The current set comprises 12 parts. Parts 1-7 are fairly close to the
January patch set, but incorporating a number of bug fixes and
revisions for the review comments from Tobias. Part 3, in particular,
has a lot of changes to address both a buggy interface between the
compiler and libgomp, and Tobias's comments about bit-rotten target
support.
Parts 8-11 are new. Part 9 is a big patch that merges the dynamic selector
support to "declare variant", revises internal interfaces, and also fixes
PR114596 and other bugs relating to matching and scoring. The other pieces
are more self-contained fixes and improvements.
Part 12 is an updated patch for the implementation status table in the
libgomp manual.
As a general overview of what has changed here relative to the January patch
set:
* The dynamic selector support added for metadirective has been
integrated with declare variant; both directives now use common data
structures and scoring/sorting code. In particular, for calls to
"declare variant" functions that cannot be resolved during
gimplification, it now creates the same gimple structure used by
metadirective instead of using a magic placeholder symbol, and all
the support code used to track and process the placeholders has been
removed.
* Along the way, I found/fixed a serious bug in the resolution code in
the previously-posted metadirective patches; it was not saving
information about the OpenMP context needed to match/score construct
selectors during gimplification for use in late resolution, and
instead incorrectly calling the function dependent on being invoked
during gimplification during late resolution. It was also failing
to account for "declare simd"'s effect on scoring.
* I also found/fixed a serious bug in the existing mainline "declare
variant" scoring code that also affected the previous version of the
metadirective patches (PR 114596).
* Overall I tried to improve the software engineering aspect of the
scoring and matching code, making it better-documented and easier to
follow and correlate to the OpenMP specification.
* In the Fortran front end, I moved the filtering-out of metadirective
variants that can't possibly match from the parsing phase to the
translation phase, following Tobias's recommendation.
* I've updated the logic for when "declare target" adds a target
construct selector to the OpenMP context to follow recent versions
of the spec (the implementation now on mainline was for the language
in the 5.0 spec).
* For both metadirective and declare variant, when the gimplifier
processes metadirectives/calls that can't be resolved at that time,
it now filters out the variants that can't possibly match instead of
preserving all of them for late resolution, which might produce
better optimization opportunities. (The front ends already do this
once at parse time, but additional info is available during
gimplification that may allow additional variants to be discarded.)
* I fixed some bit-rot in the libgomp support for the target_device
selector, and adjusted the interface between the compiler and libgomp
to correctly handle selectors with multiple properties (previously it
was only handling the first one).
* I also added a diagnostic for requirement from the spec that
kind(any) cannot be used with any other properties. It turns out
there were multiple testcases that incorrectly did this.
In terms of what remains to be done:
* There is one test regression in libgomp, declare-variant-1.f90 hangs
during execution at -O0 only. I looked at this briefly but didn't make
any progress on debugging it.
* I haven't solved the issues discussed in issue PR113904 about the
scoping of expressions in "declare variant" dynamic selectors. For
C and C++, I have a good idea of how to implement the provisions in
the spec that allow references to argument variables of the variant
function. For now it diagnoses this with a "sorry"; meanwhile it
*does* parse the argument variables in the correct scope, and
correctly handles other symbols in scope, including class members
and "this" in C++. For Fortran, I'm unsure of the semantics, and
for "declare variant" it currently rejects non-constant expressions
in dynamic selectors.
I think both of those issues could be addressed with follow-up
patches. This is already a large and complicated patch set, and I
hope that by submitting it for review early in stage 1 it will be
possible to get at least some parts of it committed in a timely manner
and reduce the burden of maintaining these patches out of tree.
-Sandra
Sandra Loosemore (12):
OpenMP: metadirective tree data structures and front-end interfaces
OpenMP: middle-end support for metadirectives
libgomp: runtime support for target_device selector
OpenMP: C front end support for metadirectives
OpenMP: C++ front-end support for metadirectives
OpenMP: common c/c++ testcases for metadirectives
OpenMP: Fortran front-end support for metadirectives.
OpenMP: Reject other properties with kind(any)
OpenMP: Extend dynamic selector support to declare variant
OpenMP: Remove dead code from declare variant reimplementation
OpenMP: Update "declare target"/OpenMP context interaction
OpenMP: Update documentation of metadirective implementation status.
gcc/Makefile.in | 2 +-
gcc/builtin-types.def | 2 +
gcc/c-family/c-attribs.cc | 2 -
gcc/c-family/c-common.h | 4 +-
gcc/c-family/c-gimplify.cc | 27 +
gcc/c-family/c-omp.cc | 60 +-
gcc/c-family/c-pragma.cc | 1 +
gcc/c-family/c-pragma.h | 1 +
gcc/c/c-decl.cc | 8 +-
gcc/c/c-parser.cc | 473 +++-
gcc/cgraph.cc | 2 -
gcc/cgraph.h | 12 +-
gcc/cgraphclones.cc | 2 +-
gcc/cp/cp-tree.h | 2 +
gcc/cp/decl.cc | 2 +-
gcc/cp/decl2.cc | 9 +-
gcc/cp/parser.cc | 526 ++++-
gcc/cp/parser.h | 7 +
gcc/cp/pt.cc | 120 +
gcc/cp/semantics.cc | 3 +-
gcc/doc/generic.texi | 32 +
gcc/doc/gimple.texi | 6 +
gcc/fortran/decl.cc | 29 +
gcc/fortran/dump-parse-tree.cc | 21 +
gcc/fortran/gfortran.h | 20 +-
gcc/fortran/io.cc | 2 +-
gcc/fortran/match.h | 2 +
gcc/fortran/openmp.cc | 294 ++-
gcc/fortran/parse.cc | 571 +++--
gcc/fortran/parse.h | 8 +-
gcc/fortran/resolve.cc | 6 +
gcc/fortran/st.cc | 4 +
gcc/fortran/symbol.cc | 25 +-
gcc/fortran/trans-decl.cc | 5 +-
gcc/fortran/trans-openmp.cc | 238 +-
gcc/fortran/trans-stmt.h | 1 +
gcc/fortran/trans.cc | 1 +
gcc/fortran/types.def | 2 +
gcc/gimple-low.cc | 36 +
gcc/gimple-pretty-print.cc | 64 +
gcc/gimple-streamer-in.cc | 13 +
gcc/gimple-streamer-out.cc | 10 +
gcc/gimple-walk.cc | 28 +
gcc/gimple.cc | 36 +
gcc/gimple.def | 8 +
gcc/gimple.h | 122 +-
gcc/gimplify.cc | 574 +++--
gcc/gimplify.h | 2 +-
gcc/gsstruct.def | 2 +
gcc/ipa-free-lang-data.cc | 2 +-
gcc/ipa.cc | 3 -
gcc/lto-cgraph.cc | 12 +-
gcc/lto-streamer-out.cc | 3 +-
gcc/lto-streamer.h | 6 -
gcc/lto/lto-partition.cc | 5 +-
gcc/omp-builtins.def | 3 +
gcc/omp-expand.cc | 32 +-
gcc/omp-general.cc | 2033 +++++++++--------
gcc/omp-general.h | 50 +-
gcc/omp-low.cc | 83 +
gcc/omp-offload.cc | 117 +-
gcc/omp-simd-clone.cc | 3 +-
gcc/passes.cc | 3 +-
gcc/symtab.cc | 2 +-
.../gomp/declare-target-indirect-2.c | 10 +-
.../c-c++-common/gomp/declare-variant-10.c | 4 +-
.../c-c++-common/gomp/declare-variant-12.c | 14 +-
.../c-c++-common/gomp/declare-variant-13.c | 6 +-
.../c-c++-common/gomp/declare-variant-2.c | 4 +-
.../c-c++-common/gomp/declare-variant-3.c | 10 +-
.../c-c++-common/gomp/declare-variant-8.c | 4 +-
.../c-c++-common/gomp/declare-variant-9.c | 4 +-
.../c-c++-common/gomp/declare-variant-any.c | 10 +
.../gomp/declare-variant-arg-exprs.c | 29 +
.../gomp/declare-variant-dynamic-1.c | 26 +
.../gomp/declare-variant-dynamic-2.c | 30 +
.../c-c++-common/gomp/metadirective-1.c | 52 +
.../c-c++-common/gomp/metadirective-2.c | 74 +
.../c-c++-common/gomp/metadirective-3.c | 21 +
.../c-c++-common/gomp/metadirective-4.c | 40 +
.../c-c++-common/gomp/metadirective-5.c | 24 +
.../c-c++-common/gomp/metadirective-6.c | 31 +
.../c-c++-common/gomp/metadirective-7.c | 31 +
.../c-c++-common/gomp/metadirective-8.c | 16 +
.../gomp/metadirective-construct.c | 177 ++
.../c-c++-common/gomp/metadirective-device.c | 147 ++
.../gomp/metadirective-no-score.c | 95 +
.../gomp/metadirective-target-device.c | 147 ++
.../c-c++-common/gomp/reverse-offload-1.c | 2 +-
.../g++.dg/gomp/attrs-metadirective-1.C | 40 +
.../g++.dg/gomp/attrs-metadirective-2.C | 74 +
.../g++.dg/gomp/attrs-metadirective-3.C | 19 +
.../g++.dg/gomp/attrs-metadirective-4.C | 41 +
.../g++.dg/gomp/attrs-metadirective-5.C | 24 +
.../g++.dg/gomp/attrs-metadirective-6.C | 31 +
.../g++.dg/gomp/attrs-metadirective-7.C | 31 +
.../g++.dg/gomp/attrs-metadirective-8.C | 16 +
.../g++.dg/gomp/declare-variant-class-1.C | 32 +
.../g++.dg/gomp/declare-variant-class-2.C | 37 +
gcc/testsuite/gcc.dg/gomp/metadirective-1.c | 15 +
.../gfortran.dg/gomp/declare-variant-10.f90 | 4 +-
.../gfortran.dg/gomp/declare-variant-12.f90 | 14 +-
.../gfortran.dg/gomp/declare-variant-13.f90 | 28 +-
.../gfortran.dg/gomp/declare-variant-3.f90 | 12 +-
.../gfortran.dg/gomp/declare-variant-8.f90 | 12 +-
.../gfortran.dg/gomp/declare-variant-9.f90 | 2 +-
.../gfortran.dg/gomp/declare-variant-any.f90 | 28 +
.../gfortran.dg/gomp/metadirective-1.f90 | 73 +
.../gfortran.dg/gomp/metadirective-10.f90 | 40 +
.../gfortran.dg/gomp/metadirective-11.f90 | 33 +
.../gfortran.dg/gomp/metadirective-2.f90 | 62 +
.../gfortran.dg/gomp/metadirective-3.f90 | 24 +
.../gfortran.dg/gomp/metadirective-4.f90 | 39 +
.../gfortran.dg/gomp/metadirective-5.f90 | 30 +
.../gfortran.dg/gomp/metadirective-6.f90 | 31 +
.../gfortran.dg/gomp/metadirective-7.f90 | 36 +
.../gfortran.dg/gomp/metadirective-8.f90 | 22 +
.../gfortran.dg/gomp/metadirective-9.f90 | 30 +
.../gomp/metadirective-construct.f90 | 260 +++
.../gomp/metadirective-no-score.f90 | 122 +
gcc/testsuite/gfortran.dg/gomp/pure-1.f90 | 7 +
gcc/testsuite/gfortran.dg/gomp/pure-2.f90 | 8 -
gcc/tree-cfg.cc | 24 +
gcc/tree-inline.cc | 45 +-
gcc/tree-pretty-print.cc | 36 +-
gcc/tree-pretty-print.h | 2 +
gcc/tree-ssa-operands.cc | 17 +
gcc/tree.def | 6 +
gcc/tree.h | 3 +
include/cuda/cuda.h | 2 +
libgomp/Makefile.am | 2 +-
libgomp/Makefile.in | 5 +-
libgomp/config/gcn/selector.c | 102 +
libgomp/config/linux/selector.c | 65 +
libgomp/config/linux/x86/selector.c | 406 ++++
libgomp/config/nvptx/selector.c | 77 +
libgomp/libgomp-plugin.h | 2 +
libgomp/libgomp.h | 1 +
libgomp/libgomp.map | 5 +
libgomp/libgomp.texi | 39 +-
libgomp/libgomp_g.h | 8 +
libgomp/oacc-host.c | 11 +
libgomp/plugin/plugin-gcn.c | 52 +
libgomp/plugin/plugin-nvptx.c | 82 +
libgomp/selector.c | 64 +
libgomp/target.c | 40 +
.../libgomp.c++/metadirective-template-1.C | 37 +
.../libgomp.c++/metadirective-template-2.C | 41 +
.../libgomp.c++/metadirective-template-3.C | 41 +
.../libgomp.c-c++-common/metadirective-1.c | 35 +
.../libgomp.c-c++-common/metadirective-2.c | 41 +
.../libgomp.c-c++-common/metadirective-3.c | 34 +
.../libgomp.c-c++-common/metadirective-4.c | 52 +
.../libgomp.c-c++-common/metadirective-5.c | 46 +
.../libgomp.fortran/metadirective-1.f90 | 61 +
.../libgomp.fortran/metadirective-2.f90 | 40 +
.../libgomp.fortran/metadirective-3.f90 | 29 +
.../libgomp.fortran/metadirective-4.f90 | 46 +
.../libgomp.fortran/metadirective-5.f90 | 44 +
.../libgomp.fortran/metadirective-6.f90 | 58 +
160 files changed, 8115 insertions(+), 1655 deletions(-)
create mode 100644 gcc/testsuite/c-c++-common/gomp/declare-variant-any.c
create mode 100644 gcc/testsuite/c-c++-common/gomp/declare-variant-arg-exprs.c
create mode 100644 gcc/testsuite/c-c++-common/gomp/declare-variant-dynamic-1.c
create mode 100644 gcc/testsuite/c-c++-common/gomp/declare-variant-dynamic-2.c
create mode 100644 gcc/testsuite/c-c++-common/gomp/metadirective-1.c
create mode 100644 gcc/testsuite/c-c++-common/gomp/metadirective-2.c
create mode 100644 gcc/testsuite/c-c++-common/gomp/metadirective-3.c
create mode 100644 gcc/testsuite/c-c++-common/gomp/metadirective-4.c
create mode 100644 gcc/testsuite/c-c++-common/gomp/metadirective-5.c
create mode 100644 gcc/testsuite/c-c++-common/gomp/metadirective-6.c
create mode 100644 gcc/testsuite/c-c++-common/gomp/metadirective-7.c
create mode 100644 gcc/testsuite/c-c++-common/gomp/metadirective-8.c
create mode 100644 gcc/testsuite/c-c++-common/gomp/metadirective-construct.c
create mode 100644 gcc/testsuite/c-c++-common/gomp/metadirective-device.c
create mode 100644 gcc/testsuite/c-c++-common/gomp/metadirective-no-score.c
create mode 100644 gcc/testsuite/c-c++-common/gomp/metadirective-target-device.c
create mode 100644 gcc/testsuite/g++.dg/gomp/attrs-metadirective-1.C
create mode 100644 gcc/testsuite/g++.dg/gomp/attrs-metadirective-2.C
create mode 100644 gcc/testsuite/g++.dg/gomp/attrs-metadirective-3.C
create mode 100644 gcc/testsuite/g++.dg/gomp/attrs-metadirective-4.C
create mode 100644 gcc/testsuite/g++.dg/gomp/attrs-metadirective-5.C
create mode 100644 gcc/testsuite/g++.dg/gomp/attrs-metadirective-6.C
create mode 100644 gcc/testsuite/g++.dg/gomp/attrs-metadirective-7.C
create mode 100644 gcc/testsuite/g++.dg/gomp/attrs-metadirective-8.C
create mode 100644 gcc/testsuite/g++.dg/gomp/declare-variant-class-1.C
create mode 100644 gcc/testsuite/g++.dg/gomp/declare-variant-class-2.C
create mode 100644 gcc/testsuite/gcc.dg/gomp/metadirective-1.c
create mode 100644 gcc/testsuite/gfortran.dg/gomp/declare-variant-any.f90
create mode 100644 gcc/testsuite/gfortran.dg/gomp/metadirective-1.f90
create mode 100644 gcc/testsuite/gfortran.dg/gomp/metadirective-10.f90
create mode 100644 gcc/testsuite/gfortran.dg/gomp/metadirective-11.f90
create mode 100644 gcc/testsuite/gfortran.dg/gomp/metadirective-2.f90
create mode 100644 gcc/testsuite/gfortran.dg/gomp/metadirective-3.f90
create mode 100644 gcc/testsuite/gfortran.dg/gomp/metadirective-4.f90
create mode 100644 gcc/testsuite/gfortran.dg/gomp/metadirective-5.f90
create mode 100644 gcc/testsuite/gfortran.dg/gomp/metadirective-6.f90
create mode 100644 gcc/testsuite/gfortran.dg/gomp/metadirective-7.f90
create mode 100644 gcc/testsuite/gfortran.dg/gomp/metadirective-8.f90
create mode 100644 gcc/testsuite/gfortran.dg/gomp/metadirective-9.f90
create mode 100644 gcc/testsuite/gfortran.dg/gomp/metadirective-construct.f90
create mode 100644 gcc/testsuite/gfortran.dg/gomp/metadirective-no-score.f90
create mode 100644 libgomp/config/gcn/selector.c
create mode 100644 libgomp/config/linux/selector.c
create mode 100644 libgomp/config/linux/x86/selector.c
create mode 100644 libgomp/config/nvptx/selector.c
create mode 100644 libgomp/selector.c
create mode 100644 libgomp/testsuite/libgomp.c++/metadirective-template-1.C
create mode 100644 libgomp/testsuite/libgomp.c++/metadirective-template-2.C
create mode 100644 libgomp/testsuite/libgomp.c++/metadirective-template-3.C
create mode 100644 libgomp/testsuite/libgomp.c-c++-common/metadirective-1.c
create mode 100644 libgomp/testsuite/libgomp.c-c++-common/metadirective-2.c
create mode 100644 libgomp/testsuite/libgomp.c-c++-common/metadirective-3.c
create mode 100644 libgomp/testsuite/libgomp.c-c++-common/metadirective-4.c
create mode 100644 libgomp/testsuite/libgomp.c-c++-common/metadirective-5.c
create mode 100644 libgomp/testsuite/libgomp.fortran/metadirective-1.f90
create mode 100644 libgomp/testsuite/libgomp.fortran/metadirective-2.f90
create mode 100644 libgomp/testsuite/libgomp.fortran/metadirective-3.f90
create mode 100644 libgomp/testsuite/libgomp.fortran/metadirective-4.f90
create mode 100644 libgomp/testsuite/libgomp.fortran/metadirective-5.f90
create mode 100644 libgomp/testsuite/libgomp.fortran/metadirective-6.f90
--
2.25.1
^ permalink raw reply [flat|nested] 13+ messages in thread
* [PATCH 01/12] OpenMP: metadirective tree data structures and front-end interfaces
2024-05-04 21:21 [PATCH 00/12] OpenMP: Metadirective support + "declare variant" improvements Sandra Loosemore
@ 2024-05-04 21:21 ` Sandra Loosemore
2024-05-04 21:21 ` [PATCH 02/12] OpenMP: middle-end support for metadirectives Sandra Loosemore
` (10 subsequent siblings)
11 siblings, 0 replies; 13+ messages in thread
From: Sandra Loosemore @ 2024-05-04 21:21 UTC (permalink / raw)
To: gcc-patches; +Cc: jakub, tburnus
This patch adds the OMP_METADIRECTIVE tree node and shared tree-level
support for manipulating metadirectives. It defines/exposes
interfaces that will be used in subsequent patches that add front-end
and middle-end support, but nothing generates these nodes yet.
This patch also adds compile-time support for dynamic context
selectors (the target_device selector set and the condition selector
of the user selector set) for metadirectives only. The "declare
variant" directive still supports only static selectors.
gcc/ChangeLog
* Makefile.in (GTFILES): Move omp-general.h earlier in the list.
* builtin-types.def (BT_FN_BOOL_INT_CONST_PTR_CONST_PTR_CONST_PTR):
New.
* doc/generic.texi (OpenMP): Document OMP_METADIRECTIVE and
context selector interfaces.
* omp-builtins.def (BUILT_IN_GOMP_EVALUATE_TARGET_DEVICE): New.
* omp-general.cc (omp_check_context_selector): Add metadirective_p
parameter, use it to conditionalize target_device support.
(make_omp_metadirective_variant): New.
(omp_context_selector_matches): Add metadirective_p and delay_p
parameters, use them to control things that can only be matched
late. Handle OMP_TRAIT_SET_TARGET_DEVICE.
(score_wide_int): Move definition to omp-general.h.
(omp_encode_kind_arch_isa_props): New.
(omp_dynamic_cond): New.
(omp_context_compute_score): Handle OMP_TRAIT_SET_TARGET_DEVICE.
(omp_resolve_late_declare_variant, omp_resolve_declare_variant):
Adjust calls to omp_context_selector_matches.
(sort_variant): New.
(omp_get_dynamic_candidates): New.
(omp_early_resolve_metadirective): New.
* omp-general.h (score_wide_int): Moved here from omp-general.cc.
(struct omp_variant): New.
(OMP_METADIRECTIVE_VARIANT_SELECTOR): New.
(OMP_METADIRECTIVE_VARIANT_DIRECTIVE): New.
(OMP_METADIRECTIVE_VARIANT_BODY): New.
(make_omp_metadirective_variant): Declare.
(omp_check_context_selector): Adjust to match definition.
(omp_context_selector_matches): Likewise.
(omp_early_resolve_metadirective): New.
* tree-pretty-print.cc (dump_omp_context_selector): Remove
static qualifier.
(dump_generic_node): Handle OMP_METADIRECTIVE.
* tree-pretty-print.h (dump_omp_context_selector): Declare.
* tree.def (OMP_METADIRECTIVE): New.
* tree.h (OMP_METADIRECTIVE_VARIANTS): New.
gcc/c/ChangeLog
* c-parser.cc (c_finish_omp_declare_variant): Update calls to
omp_check_context_selector and omp_context_selector_matches.
gcc/cp/ChangeLog
* decl.cc (omp_declare_variant_finalize_one): Update call to
omp_context_selector_matches to pass additional arguments.
* parser.cc (cp_finish_omp_declare_variant): Likewise for
omp_check_context_selector.
gcc/fortran/ChangeLog
* trans-openmp.cc (gfc_trans_omp_declare_variant): Update calls to
omp_check_context_selector and omp_context_selector_matches.
* types.def (BT_FN_BOOL_INT_CONST_PTR_CONST_PTR_CONST_PTR): New.
Co-Authored-By: Kwok Cheung Yeung <kcy@codesourcery.com>
Co-Authored-By: Sandra Loosemore <sandra@codesourcery.com>
---
gcc/Makefile.in | 2 +-
gcc/builtin-types.def | 2 +
gcc/c/c-parser.cc | 4 +-
gcc/cp/decl.cc | 2 +-
gcc/cp/parser.cc | 2 +-
gcc/doc/generic.texi | 32 ++++
gcc/fortran/trans-openmp.cc | 4 +-
gcc/fortran/types.def | 2 +
gcc/omp-builtins.def | 3 +
gcc/omp-general.cc | 357 ++++++++++++++++++++++++++++++++++--
gcc/omp-general.h | 31 +++-
gcc/tree-pretty-print.cc | 36 +++-
gcc/tree-pretty-print.h | 2 +
gcc/tree.def | 6 +
gcc/tree.h | 3 +
15 files changed, 461 insertions(+), 27 deletions(-)
diff --git a/gcc/Makefile.in b/gcc/Makefile.in
index a74761b7ab3..65638c7b5d6 100644
--- a/gcc/Makefile.in
+++ b/gcc/Makefile.in
@@ -2868,6 +2868,7 @@ GTFILES = $(CPPLIB_H) $(srcdir)/input.h $(srcdir)/coretypes.h \
$(srcdir)/tree-ssa-operands.h \
$(srcdir)/tree-profile.cc $(srcdir)/tree-nested.cc \
$(srcdir)/omp-offload.h \
+ $(srcdir)/omp-general.h \
$(srcdir)/omp-general.cc \
$(srcdir)/omp-low.cc \
$(srcdir)/targhooks.cc $(out_file) $(srcdir)/passes.cc \
@@ -2894,7 +2895,6 @@ GTFILES = $(CPPLIB_H) $(srcdir)/input.h $(srcdir)/coretypes.h \
$(srcdir)/ipa-strub.cc \
$(srcdir)/internal-fn.h \
$(srcdir)/calls.cc \
- $(srcdir)/omp-general.h \
$(srcdir)/analyzer/analyzer-language.cc \
@all_gtfiles@
diff --git a/gcc/builtin-types.def b/gcc/builtin-types.def
index c97d6bad1de..605a38ab84d 100644
--- a/gcc/builtin-types.def
+++ b/gcc/builtin-types.def
@@ -878,6 +878,8 @@ DEF_FUNCTION_TYPE_4 (BT_FN_VOID_UINT_PTR_INT_PTR, BT_VOID, BT_INT, BT_PTR,
BT_INT, BT_PTR)
DEF_FUNCTION_TYPE_4 (BT_FN_BOOL_UINT_UINT_UINT_BOOL,
BT_BOOL, BT_UINT, BT_UINT, BT_UINT, BT_BOOL)
+DEF_FUNCTION_TYPE_4 (BT_FN_BOOL_INT_CONST_PTR_CONST_PTR_CONST_PTR,
+ BT_BOOL, BT_INT, BT_CONST_PTR, BT_CONST_PTR, BT_CONST_PTR)
DEF_FUNCTION_TYPE_5 (BT_FN_INT_STRING_INT_SIZE_CONST_STRING_VALIST_ARG,
BT_INT, BT_STRING, BT_INT, BT_SIZE, BT_CONST_STRING,
diff --git a/gcc/c/c-parser.cc b/gcc/c/c-parser.cc
index 00f8bf4376e..41e8c923fcd 100644
--- a/gcc/c/c-parser.cc
+++ b/gcc/c/c-parser.cc
@@ -24926,7 +24926,7 @@ c_finish_omp_declare_variant (c_parser *parser, tree fndecl, tree parms)
tree ctx = c_parser_omp_context_selector_specification (parser, parms);
if (ctx == error_mark_node)
goto fail;
- ctx = omp_check_context_selector (match_loc, ctx);
+ ctx = omp_check_context_selector (match_loc, ctx, false);
if (ctx != error_mark_node && variant != error_mark_node)
{
if (TREE_CODE (variant) != FUNCTION_DECL)
@@ -24959,7 +24959,7 @@ c_finish_omp_declare_variant (c_parser *parser, tree fndecl, tree parms)
tree construct
= omp_get_context_selector_list (ctx, OMP_TRAIT_SET_CONSTRUCT);
omp_mark_declare_variant (match_loc, variant, construct);
- if (omp_context_selector_matches (ctx))
+ if (omp_context_selector_matches (ctx, false, true))
{
tree attr
= tree_cons (get_identifier ("omp declare variant base"),
diff --git a/gcc/cp/decl.cc b/gcc/cp/decl.cc
index 2af026d255d..2f989b9b869 100644
--- a/gcc/cp/decl.cc
+++ b/gcc/cp/decl.cc
@@ -8328,7 +8328,7 @@ omp_declare_variant_finalize_one (tree decl, tree attr)
tree construct
= omp_get_context_selector_list (ctx, OMP_TRAIT_SET_CONSTRUCT);
omp_mark_declare_variant (match_loc, variant, construct);
- if (!omp_context_selector_matches (ctx))
+ if (!omp_context_selector_matches (ctx, false, true))
return true;
TREE_PURPOSE (TREE_VALUE (attr)) = variant;
}
diff --git a/gcc/cp/parser.cc b/gcc/cp/parser.cc
index 598380dda08..8b819b2ebfd 100644
--- a/gcc/cp/parser.cc
+++ b/gcc/cp/parser.cc
@@ -48489,7 +48489,7 @@ cp_finish_omp_declare_variant (cp_parser *parser, cp_token *pragma_tok,
tree ctx = cp_parser_omp_context_selector_specification (parser, true);
if (ctx == error_mark_node)
goto fail;
- ctx = omp_check_context_selector (match_loc, ctx);
+ ctx = omp_check_context_selector (match_loc, ctx, false);
if (ctx != error_mark_node && variant != error_mark_node)
{
tree match_loc_node = maybe_wrap_with_location (integer_zero_node,
diff --git a/gcc/doc/generic.texi b/gcc/doc/generic.texi
index c596b7d44b2..e869203df0e 100644
--- a/gcc/doc/generic.texi
+++ b/gcc/doc/generic.texi
@@ -2335,6 +2335,7 @@ edge. Rethrowing the exception is represented using @code{RESX_EXPR}.
@tindex OMP_CONTINUE
@tindex OMP_ATOMIC
@tindex OMP_CLAUSE
+@tindex OMP_METADIRECTIVE
All the statements starting with @code{OMP_} represent directives and
clauses used by the OpenMP API @w{@uref{https://www.openmp.org}}.
@@ -2552,6 +2553,37 @@ same clause @code{C} need to be represented as multiple @code{C} clauses
chained together. This facilitates adding new clauses during
compilation.
+@item OMP_METADIRECTIVE
+
+Represents @code{#pragma omp metadirective}. This node has one field,
+accessed by the @code{OMP_METADIRECTIVE_VARIANTS (@var{node})} macro.
+
+Metadirective variants are represented internally as @code{TREE_LIST} nodes
+but you should use the interface provided in @file{omp-general.h} to
+access their components.
+
+@code{OMP_METADIRECTIVE_VARIANT_SELECTOR (@var{variant})}
+is the selector associated with the variant; this is null for the
+@samp{otherwise}/@samp{default} alternative.
+
+@code{OMP_METADIRECTIVE_VARIANT_DIRECTIVE (@var{variant})} is the
+nested directive for the variant.
+
+@code{OMP_METADIRECTIVE_VARIANT_BODY (@var{variant})} represents
+statements following a nested standalone or utility directive.
+In other cases, this field is null and the body is part of the
+nested directive instead.
+
+Metadirective context selectors (as well as context selectors for
+@code{#pragma omp declare variant}) are also represented internally using
+a @code{TREE_LIST} representation but with accessors and constructors
+declared in @file{omp-general.h}. A complete context selector is a list of
+trait-set selectors, which are in turn composed of a list of trait selectors,
+each of which may have a list of trait properties.
+Identifiers for trait-set selectors and trait selectors are enums
+defined in @file{omp-selectors.h}, while trait property identifiers are
+string constants.
+
@end table
@node OpenACC
diff --git a/gcc/fortran/trans-openmp.cc b/gcc/fortran/trans-openmp.cc
index f867e2240bf..99ec0320258 100644
--- a/gcc/fortran/trans-openmp.cc
+++ b/gcc/fortran/trans-openmp.cc
@@ -8504,7 +8504,7 @@ gfc_trans_omp_declare_variant (gfc_namespace *ns)
continue;
}
set_selectors = omp_check_context_selector
- (gfc_get_location (&odv->where), set_selectors);
+ (gfc_get_location (&odv->where), set_selectors, false);
if (set_selectors != error_mark_node)
{
if (!variant_proc_sym->attr.implicit_type
@@ -8541,7 +8541,7 @@ gfc_trans_omp_declare_variant (gfc_namespace *ns)
omp_mark_declare_variant (gfc_get_location (&odv->where),
gfc_get_symbol_decl (variant_proc_sym),
construct);
- if (omp_context_selector_matches (set_selectors))
+ if (omp_context_selector_matches (set_selectors, false, true))
{
tree id = get_identifier ("omp declare variant base");
tree variant = gfc_get_symbol_decl (variant_proc_sym);
diff --git a/gcc/fortran/types.def b/gcc/fortran/types.def
index 390cc9542f7..f1e2973e5ff 100644
--- a/gcc/fortran/types.def
+++ b/gcc/fortran/types.def
@@ -176,6 +176,8 @@ DEF_FUNCTION_TYPE_4 (BT_FN_VOID_UINT_PTR_INT_PTR, BT_VOID, BT_INT, BT_PTR,
BT_INT, BT_PTR)
DEF_FUNCTION_TYPE_4 (BT_FN_BOOL_UINT_UINT_UINT_BOOL,
BT_BOOL, BT_UINT, BT_UINT, BT_UINT, BT_BOOL)
+DEF_FUNCTION_TYPE_4 (BT_FN_BOOL_INT_CONST_PTR_CONST_PTR_CONST_PTR,
+ BT_BOOL, BT_INT, BT_CONST_PTR, BT_CONST_PTR, BT_CONST_PTR)
DEF_FUNCTION_TYPE_5 (BT_FN_VOID_OMPFN_PTR_UINT_UINT_UINT,
BT_VOID, BT_PTR_FN_VOID_PTR, BT_PTR, BT_UINT, BT_UINT,
diff --git a/gcc/omp-builtins.def b/gcc/omp-builtins.def
index 044d5d087b6..ecaace8de31 100644
--- a/gcc/omp-builtins.def
+++ b/gcc/omp-builtins.def
@@ -476,3 +476,6 @@ DEF_GOMP_BUILTIN (BUILT_IN_GOMP_WARNING, "GOMP_warning",
BT_FN_VOID_CONST_PTR_SIZE, ATTR_NOTHROW_LEAF_LIST)
DEF_GOMP_BUILTIN (BUILT_IN_GOMP_ERROR, "GOMP_error",
BT_FN_VOID_CONST_PTR_SIZE, ATTR_COLD_NORETURN_NOTHROW_LEAF_LIST)
+DEF_GOMP_BUILTIN (BUILT_IN_GOMP_EVALUATE_TARGET_DEVICE, "GOMP_evaluate_target_device",
+ BT_FN_BOOL_INT_CONST_PTR_CONST_PTR_CONST_PTR,
+ ATTR_NOTHROW_LEAF_LIST)
diff --git a/gcc/omp-general.cc b/gcc/omp-general.cc
index 2c095200d5b..e4c84d15644 100644
--- a/gcc/omp-general.cc
+++ b/gcc/omp-general.cc
@@ -1269,7 +1269,7 @@ omp_context_name_list_prop (tree prop)
it is correct or error_mark_node otherwise. */
tree
-omp_check_context_selector (location_t loc, tree ctx)
+omp_check_context_selector (location_t loc, tree ctx, bool metadirective_p)
{
bool tss_seen[OMP_TRAIT_SET_LAST], ts_seen[OMP_TRAIT_LAST];
@@ -1278,9 +1278,10 @@ omp_check_context_selector (location_t loc, tree ctx)
{
enum omp_tss_code tss_code = OMP_TSS_CODE (tss);
- /* We can parse this, but not handle it yet. */
- if (tss_code == OMP_TRAIT_SET_TARGET_DEVICE)
- sorry_at (loc, "%<target_device%> selector set is not supported yet");
+ /* FIXME: not implemented yet. */
+ if (!metadirective_p && tss_code == OMP_TRAIT_SET_TARGET_DEVICE)
+ sorry_at (loc, "%<target_device%> selector set is not supported "
+ "yet for %<declare variant%>");
/* Each trait-set-selector-name can only be specified once. */
if (tss_seen[tss_code])
@@ -1432,14 +1433,29 @@ make_trait_property (tree name, tree value, tree chain)
return tree_cons (name, value, chain);
}
+/* Constructor for metadirective variants. */
+tree
+make_omp_metadirective_variant (tree selector, tree directive, tree body)
+{
+ return build_tree_list (selector, build_tree_list (directive, body));
+}
+
+
/* Return 1 if context selector matches the current OpenMP context, 0
if it does not and -1 if it is unknown and need to be determined later.
Some properties can be checked right away during parsing (this routine),
others need to wait until the whole TU is parsed, others need to wait until
- IPA, others until vectorization. */
+ IPA, others until vectorization.
+
+ METADIRECTIVE_P is true if this is a metadirective context, and DELAY_P
+ is true if it's too early in compilation to determine whether some
+ properties match.
+
+ Dynamic properties (which are evaluated at run-time) should always
+ return 1. */
int
-omp_context_selector_matches (tree ctx)
+omp_context_selector_matches (tree ctx, bool metadirective_p, bool delay_p)
{
int ret = 1;
for (tree tss = ctx; tss; tss = TREE_CHAIN (tss))
@@ -1512,6 +1528,11 @@ omp_context_selector_matches (tree ctx)
ret = -1;
continue;
}
+ else if (set == OMP_TRAIT_SET_TARGET_DEVICE)
+ /* The target_device set is dynamic, so treat it as always
+ resolvable. */
+ continue;
+
for (tree ts = selectors; ts; ts = TREE_CHAIN (ts))
{
enum omp_ts_code sel = OMP_TS_CODE (ts);
@@ -1581,6 +1602,9 @@ omp_context_selector_matches (tree ctx)
const char *arch = omp_context_name_list_prop (p);
if (arch == NULL)
return 0;
+ if (metadirective_p && delay_p)
+ return -1;
+
int r = 0;
if (targetm.omp.device_kind_arch_isa != NULL)
r = targetm.omp.device_kind_arch_isa (omp_device_arch,
@@ -1703,6 +1727,9 @@ omp_context_selector_matches (tree ctx)
#endif
continue;
}
+ if (metadirective_p && delay_p)
+ return -1;
+
int r = 0;
if (targetm.omp.device_kind_arch_isa != NULL)
r = targetm.omp.device_kind_arch_isa (omp_device_kind,
@@ -1742,6 +1769,9 @@ omp_context_selector_matches (tree ctx)
const char *isa = omp_context_name_list_prop (p);
if (isa == NULL)
return 0;
+ if (metadirective_p && delay_p)
+ return -1;
+
int r = 0;
if (targetm.omp.device_kind_arch_isa != NULL)
r = targetm.omp.device_kind_arch_isa (omp_device_isa,
@@ -1793,6 +1823,12 @@ omp_context_selector_matches (tree ctx)
for (tree p = OMP_TS_PROPERTIES (ts); p; p = TREE_CHAIN (p))
if (OMP_TP_NAME (p) == NULL_TREE)
{
+ /* OpenMP 5.1 allows non-constant conditions for
+ metadirectives. */
+ if (metadirective_p
+ && !tree_fits_shwi_p (OMP_TP_VALUE (p)))
+ break;
+
if (integer_zerop (OMP_TP_VALUE (p)))
return 0;
if (integer_nonzerop (OMP_TP_VALUE (p)))
@@ -2191,9 +2227,107 @@ omp_lookup_ts_code (enum omp_tss_code set, const char *s)
return OMP_TRAIT_INVALID;
}
-/* Needs to be a GC-friendly widest_int variant, but precision is
- desirable to be the same on all targets. */
-typedef generic_wide_int <fixed_wide_int_storage <1024> > score_wide_int;
+/* Helper for omp_dynamic_cond: encode the kind/arch/isa property-lists
+ into strings for GOMP_evaluate_target_device. The property-list
+ strings are encoded similarly to those in omp_offload_kind_arch_isa,
+ above: each trait is passed as a string, with each property for the
+ string separated by '\0', and an extra '\0' at the end of the string. */
+static tree
+omp_encode_kind_arch_isa_props (tree props)
+{
+ if (!props)
+ return NULL_TREE;
+ size_t length = 1;
+ for (tree p = props; p; p = TREE_CHAIN (p))
+ length += strlen (omp_context_name_list_prop (p)) + 1;
+ char *buffer = (char *) alloca (length);
+ size_t n = 0;
+ for (tree p = props; p; p = TREE_CHAIN (p))
+ {
+ const char *str = omp_context_name_list_prop (p);
+ strcpy (buffer + n, str);
+ n += strlen (str) + 1;
+ }
+ *(buffer + n) = '\0';
+ return build_string_literal (length, buffer);
+}
+
+/* Return a tree expression representing the dynamic part of the context
+ selector CTX. */
+static tree
+omp_dynamic_cond (tree ctx)
+{
+ tree expr = NULL_TREE;
+
+ tree user = omp_get_context_selector (ctx, OMP_TRAIT_SET_USER,
+ OMP_TRAIT_USER_CONDITION);
+ if (user)
+ {
+ tree expr_list = OMP_TS_PROPERTIES (user);
+
+ gcc_assert (OMP_TP_NAME (expr_list) == NULL_TREE);
+
+ /* The user condition is not dynamic if it is constant. */
+ if (!tree_fits_shwi_p (TREE_VALUE (expr_list)))
+ expr = TREE_VALUE (expr_list);
+ }
+
+ tree target_device
+ = omp_get_context_selector_list (ctx, OMP_TRAIT_SET_TARGET_DEVICE);
+ if (target_device)
+ {
+ tree device_num = null_pointer_node;
+ tree kind = null_pointer_node;
+ tree arch = null_pointer_node;
+ tree isa = null_pointer_node;
+
+ tree device_num_sel
+ = omp_get_context_selector (ctx, OMP_TRAIT_SET_TARGET_DEVICE,
+ OMP_TRAIT_DEVICE_NUM);
+ if (device_num_sel)
+ device_num = OMP_TP_VALUE (OMP_TS_PROPERTIES (device_num_sel));
+ else
+ /* omp_initial_device is -1, omp_invalid_device is -4; choose
+ a value that isn't otherwise defined to indicate the default
+ device. */
+ device_num = build_int_cst (integer_type_node, -2);
+
+ tree kind_sel
+ = omp_get_context_selector (ctx, OMP_TRAIT_SET_TARGET_DEVICE,
+ OMP_TRAIT_DEVICE_KIND);
+ /* "any" is equivalent to omitting this trait selector. */
+ if (kind_sel
+ && strcmp (omp_context_name_list_prop (OMP_TS_PROPERTIES (kind_sel)),
+ "any"))
+ kind = omp_encode_kind_arch_isa_props (OMP_TS_PROPERTIES (kind_sel));
+
+
+ tree arch_sel
+ = omp_get_context_selector (ctx, OMP_TRAIT_SET_TARGET_DEVICE,
+ OMP_TRAIT_DEVICE_ARCH);
+ if (arch_sel)
+ arch = omp_encode_kind_arch_isa_props (OMP_TS_PROPERTIES (arch_sel));
+
+ tree isa_sel
+ = omp_get_context_selector (ctx, OMP_TRAIT_SET_TARGET_DEVICE,
+ OMP_TRAIT_DEVICE_ISA);
+ if (isa_sel)
+ isa = omp_encode_kind_arch_isa_props (OMP_TS_PROPERTIES (isa_sel));
+
+ /* Generate a call to GOMP_evaluate_target_device. */
+ tree builtin_fn
+ = builtin_decl_explicit (BUILT_IN_GOMP_EVALUATE_TARGET_DEVICE);
+ tree call = build_call_expr (builtin_fn, 4, device_num, kind, arch, isa);
+
+ if (expr == NULL_TREE)
+ expr = call;
+ else
+ expr = fold_build2 (TRUTH_ANDIF_EXPR, boolean_type_node, expr, call);
+ }
+
+ return expr;
+}
+
/* Compute *SCORE for context selector CTX. Return true if the score
would be different depending on whether it is a declare simd clone or
@@ -2205,12 +2339,21 @@ omp_context_compute_score (tree ctx, score_wide_int *score, bool declare_simd)
{
tree selectors
= omp_get_context_selector_list (ctx, OMP_TRAIT_SET_CONSTRUCT);
- bool has_kind = omp_get_context_selector (ctx, OMP_TRAIT_SET_DEVICE,
- OMP_TRAIT_DEVICE_KIND);
- bool has_arch = omp_get_context_selector (ctx, OMP_TRAIT_SET_DEVICE,
- OMP_TRAIT_DEVICE_ARCH);
- bool has_isa = omp_get_context_selector (ctx, OMP_TRAIT_SET_DEVICE,
- OMP_TRAIT_DEVICE_ISA);
+ bool has_kind
+ = (omp_get_context_selector (ctx, OMP_TRAIT_SET_DEVICE,
+ OMP_TRAIT_DEVICE_KIND)
+ || omp_get_context_selector (ctx, OMP_TRAIT_SET_TARGET_DEVICE,
+ OMP_TRAIT_DEVICE_KIND));
+ bool has_arch
+ = (omp_get_context_selector (ctx, OMP_TRAIT_SET_DEVICE,
+ OMP_TRAIT_DEVICE_ARCH)
+ || omp_get_context_selector (ctx, OMP_TRAIT_SET_TARGET_DEVICE,
+ OMP_TRAIT_DEVICE_ARCH));
+ bool has_isa
+ = (omp_get_context_selector (ctx, OMP_TRAIT_SET_DEVICE,
+ OMP_TRAIT_DEVICE_ISA)
+ || omp_get_context_selector (ctx, OMP_TRAIT_SET_TARGET_DEVICE,
+ OMP_TRAIT_DEVICE_ISA));
bool ret = false;
*score = 1;
for (tree tss = ctx; tss; tss = TREE_CHAIN (tss))
@@ -2395,7 +2538,7 @@ omp_resolve_late_declare_variant (tree alt)
nmatches++;
continue;
}
- switch (omp_context_selector_matches (varentry1->ctx))
+ switch (omp_context_selector_matches (varentry1->ctx, false, true))
{
case 0:
matches.safe_push (false);
@@ -2499,7 +2642,8 @@ omp_resolve_declare_variant (tree base)
don't process it again. */
if (node && node->declare_variant_alt)
return base;
- switch (omp_context_selector_matches (TREE_VALUE (TREE_VALUE (attr))))
+ switch (omp_context_selector_matches (TREE_VALUE (TREE_VALUE (attr)),
+ false, true))
{
case 0:
/* No match, ignore. */
@@ -2864,6 +3008,185 @@ omp_lto_input_declare_variant_alt (lto_input_block *ib, cgraph_node *node,
INSERT) = entryp;
}
+/* Comparison function for sorting routines, to sort OpenMP metadirective
+ variants by decreasing score. */
+
+static int
+sort_variant (const void * a, const void *b, void *)
+{
+ score_wide_int score1
+ = ((const struct omp_variant *) a)->score;
+ score_wide_int score2
+ = ((const struct omp_variant *) b)->score;
+
+ if (score1 > score2)
+ return -1;
+ else if (score1 < score2)
+ return 1;
+ else
+ return 0;
+}
+
+/* Return a vector of dynamic replacement candidates for the directive
+ candidates in ALL_VARIANTS. Return an empty vector if the metadirective
+ cannot be resolved. */
+
+static vec<struct omp_variant>
+omp_get_dynamic_candidates (vec <struct omp_variant> &all_variants,
+ bool delay_p)
+{
+ auto_vec <struct omp_variant> variants;
+ struct omp_variant default_variant;
+ bool default_found = false;
+
+ for (unsigned int i = 0; i < all_variants.length (); i++)
+ {
+ struct omp_variant variant = all_variants[i];
+
+ if (variant.selector == NULL_TREE)
+ {
+ gcc_assert (!default_found);
+ default_found = true;
+ default_variant = variant;
+ default_variant.score = 0;
+ default_variant.resolvable_p = true;
+ default_variant.dynamic_selector = NULL_TREE;
+ if (dump_file)
+ fprintf (dump_file,
+ "Considering default selector as candidate\n");
+ continue;
+ }
+
+ variant.resolvable_p = true;
+
+ if (dump_file)
+ {
+ fprintf (dump_file, "Considering selector ");
+ print_omp_context_selector (dump_file, variant.selector, TDF_NONE);
+ fprintf (dump_file, " as candidate - ");
+ }
+
+ switch (omp_context_selector_matches (variant.selector, true, delay_p))
+ {
+ case -1:
+ variant.resolvable_p = false;
+ if (dump_file)
+ fprintf (dump_file, "unresolvable");
+ /* FALLTHRU */
+ case 1:
+ /* TODO: Handle SIMD score?. */
+ omp_context_compute_score (variant.selector, &variant.score, false);
+ variant.dynamic_selector = omp_dynamic_cond (variant.selector);
+ variants.safe_push (variant);
+ if (dump_file && variant.resolvable_p)
+ {
+ if (variant.dynamic_selector)
+ fprintf (dump_file, "matched, dynamic");
+ else
+ fprintf (dump_file, "matched, non-dynamic");
+ }
+ break;
+ case 0:
+ if (dump_file)
+ fprintf (dump_file, "no match");
+ break;
+ }
+
+ if (dump_file)
+ fprintf (dump_file, "\n");
+ }
+
+ /* There must be one default variant. */
+ gcc_assert (default_found);
+
+ /* A context selector that is a strict subset of another context selector
+ has a score of zero. */
+ for (unsigned int i = 0; i < variants.length (); i++)
+ for (unsigned int j = i + 1; j < variants.length (); j++)
+ {
+ int r = omp_context_selector_compare (variants[i].selector,
+ variants[j].selector);
+ if (r == -1)
+ {
+ /* variant1 is a strict subset of variant2. */
+ variants[i].score = 0;
+ break;
+ }
+ else if (r == 1)
+ /* variant2 is a strict subset of variant1. */
+ variants[j].score = 0;
+ }
+
+ /* Sort the variants by decreasing score, preserving the original order
+ in case of a tie. */
+ variants.stablesort (sort_variant, NULL);
+
+ /* Add the default as a final choice. */
+ variants.safe_push (default_variant);
+
+ /* Build the dynamic candidate list. */
+ for (unsigned i = 0; i < variants.length (); i++)
+ {
+ /* If one of the candidates is unresolvable, give up for now. */
+ if (!variants[i].resolvable_p)
+ {
+ variants.truncate (0);
+ break;
+ }
+
+ if (dump_file)
+ {
+ fprintf (dump_file, "Adding directive variant with ");
+
+ if (variants[i].selector)
+ {
+ fprintf (dump_file, "selector ");
+ print_omp_context_selector (dump_file, variants[i].selector,
+ TDF_NONE);
+ }
+ else
+ fprintf (dump_file, "default selector");
+
+ fprintf (dump_file, " as candidate.\n");
+ }
+
+ /* The last of the candidates is ended by a static selector. */
+ if (!variants[i].dynamic_selector)
+ {
+ variants.truncate (i + 1);
+ break;
+ }
+ }
+
+ return variants.copy ();
+}
+
+/* Return a vector of dynamic replacement candidates for the metadirective
+ statement in METADIRECTIVE. Return an empty vector if the metadirective
+ cannot be resolved. */
+
+vec<struct omp_variant>
+omp_early_resolve_metadirective (tree metadirective)
+{
+ auto_vec <struct omp_variant> candidates;
+ tree variant = OMP_METADIRECTIVE_VARIANTS (metadirective);
+
+ gcc_assert (variant);
+ while (variant)
+ {
+ struct omp_variant candidate;
+
+ candidate.selector = OMP_METADIRECTIVE_VARIANT_SELECTOR (variant);
+ candidate.alternative = OMP_METADIRECTIVE_VARIANT_DIRECTIVE (variant);
+ candidate.body = OMP_METADIRECTIVE_VARIANT_BODY (variant);
+
+ candidates.safe_push (candidate);
+ variant = TREE_CHAIN (variant);
+ }
+
+ return omp_get_dynamic_candidates (candidates, true);
+}
+
/* Encode an oacc launch argument. This matches the GOMP_LAUNCH_PACK
macro on gomp-constants.h. We do not check for overflow. */
diff --git a/gcc/omp-general.h b/gcc/omp-general.h
index b7d85a768ce..5807bc42cd7 100644
--- a/gcc/omp-general.h
+++ b/gcc/omp-general.h
@@ -91,6 +91,22 @@ struct omp_for_data
tree adjn1;
};
+/* Needs to be a GC-friendly widest_int variant, but precision is
+ desirable to be the same on all targets. */
+typedef generic_wide_int <fixed_wide_int_storage <1024> > score_wide_int;
+
+/* A structure describing a variant in a metadirective. */
+
+struct GTY(()) omp_variant
+{
+ score_wide_int score;
+ tree selector;
+ tree alternative;
+ tree body;
+ tree dynamic_selector;
+ bool resolvable_p : 1;
+};
+
#define OACC_FN_ATTRIB "oacc function"
/* Accessors for OMP context selectors, used by variant directives.
@@ -150,6 +166,15 @@ extern tree make_trait_set_selector (enum omp_tss_code, tree, tree);
extern tree make_trait_selector (enum omp_ts_code, tree, tree, tree);
extern tree make_trait_property (tree, tree, tree);
+/* Accessors and constructor for metadirective variants. */
+#define OMP_METADIRECTIVE_VARIANT_SELECTOR(v) \
+ TREE_PURPOSE (v)
+#define OMP_METADIRECTIVE_VARIANT_DIRECTIVE(v) \
+ TREE_PURPOSE (TREE_VALUE (v))
+#define OMP_METADIRECTIVE_VARIANT_BODY(v) \
+ TREE_VALUE (TREE_VALUE (v))
+extern tree make_omp_metadirective_variant (tree, tree, tree);
+
extern tree omp_find_clause (tree clauses, enum omp_clause_code kind);
extern bool omp_is_allocatable_or_ptr (tree decl);
extern tree omp_check_optional_argument (tree decl, bool for_present_check);
@@ -166,15 +191,17 @@ extern poly_uint64 omp_max_vf (void);
extern int omp_max_simt_vf (void);
extern const char *omp_context_name_list_prop (tree);
extern void omp_construct_traits_to_codes (tree, int, enum tree_code *);
-extern tree omp_check_context_selector (location_t loc, tree ctx);
+extern tree omp_check_context_selector (location_t loc, tree ctx,
+ bool metadirective_p);
extern void omp_mark_declare_variant (location_t loc, tree variant,
tree construct);
-extern int omp_context_selector_matches (tree);
+extern int omp_context_selector_matches (tree, bool, bool);
extern int omp_context_selector_set_compare (enum omp_tss_code, tree, tree);
extern tree omp_get_context_selector (tree, enum omp_tss_code,
enum omp_ts_code);
extern tree omp_get_context_selector_list (tree, enum omp_tss_code);
extern tree omp_resolve_declare_variant (tree);
+extern vec<struct omp_variant> omp_early_resolve_metadirective (tree);
extern tree oacc_launch_pack (unsigned code, tree device, unsigned op);
extern tree oacc_replace_fn_attrib_attr (tree attribs, tree dims);
extern void oacc_replace_fn_attrib (tree fn, tree dims);
diff --git a/gcc/tree-pretty-print.cc b/gcc/tree-pretty-print.cc
index c935a7da7d1..3cdf74d5caf 100644
--- a/gcc/tree-pretty-print.cc
+++ b/gcc/tree-pretty-print.cc
@@ -1503,7 +1503,7 @@ dump_omp_clauses (pretty_printer *pp, tree clause, int spc, dump_flags_t flags,
}
/* Dump an OpenMP context selector CTX to PP. */
-static void
+void
dump_omp_context_selector (pretty_printer *pp, tree ctx, int spc,
dump_flags_t flags)
{
@@ -4029,6 +4029,40 @@ dump_generic_node (pretty_printer *pp, tree node, int spc, dump_flags_t flags,
is_expr = false;
break;
+ case OMP_METADIRECTIVE:
+ {
+ pp_string (pp, "#pragma omp metadirective");
+ newline_and_indent (pp, spc + 2);
+ pp_left_brace (pp);
+
+ tree variant = OMP_METADIRECTIVE_VARIANTS (node);
+ while (variant != NULL_TREE)
+ {
+ tree selector = OMP_METADIRECTIVE_VARIANT_SELECTOR (variant);
+ tree directive = OMP_METADIRECTIVE_VARIANT_DIRECTIVE (variant);
+ tree body = OMP_METADIRECTIVE_VARIANT_BODY (variant);
+
+ newline_and_indent (pp, spc + 4);
+ if (selector == NULL_TREE)
+ pp_string (pp, "default:");
+ else
+ {
+ pp_string (pp, "when (");
+ dump_omp_context_selector (pp, selector, spc + 4, flags);
+ pp_string (pp, "):");
+ }
+ newline_and_indent (pp, spc + 6);
+
+ dump_generic_node (pp, directive, spc + 6, flags, false);
+ newline_and_indent (pp, spc + 6);
+ dump_generic_node (pp, body, spc + 6, flags, false);
+ variant = TREE_CHAIN (variant);
+ }
+ newline_and_indent (pp, spc + 2);
+ pp_right_brace (pp);
+ }
+ break;
+
case TRANSACTION_EXPR:
if (TRANSACTION_EXPR_OUTER (node))
pp_string (pp, "__transaction_atomic [[outer]]");
diff --git a/gcc/tree-pretty-print.h b/gcc/tree-pretty-print.h
index 0da6242629b..ac6467935c1 100644
--- a/gcc/tree-pretty-print.h
+++ b/gcc/tree-pretty-print.h
@@ -45,6 +45,8 @@ extern void dump_omp_atomic_memory_order (pretty_printer *,
enum omp_memory_order);
extern void dump_omp_loop_non_rect_expr (pretty_printer *, tree, int,
dump_flags_t);
+extern void dump_omp_context_selector (pretty_printer *, tree, int,
+ dump_flags_t);
extern void print_omp_context_selector (FILE *, tree, dump_flags_t);
extern int dump_generic_node (pretty_printer *, tree, int, dump_flags_t, bool);
extern void print_declaration (pretty_printer *, tree, int, dump_flags_t);
diff --git a/gcc/tree.def b/gcc/tree.def
index 24128e1e039..f909ae0a443 100644
--- a/gcc/tree.def
+++ b/gcc/tree.def
@@ -1340,6 +1340,12 @@ DEFTREECODE (OMP_TARGET_ENTER_DATA, "omp_target_enter_data", tcc_statement, 1)
Operand 0: OMP_TARGET_EXIT_DATA_CLAUSES: List of clauses. */
DEFTREECODE (OMP_TARGET_EXIT_DATA, "omp_target_exit_data", tcc_statement, 1)
+/* OpenMP - #pragma omp metadirective [variant1 ... variantN]
+ Operand 0: OMP_METADIRECTIVE_VARIANTS: List of selectors and directive
+ variants. Use the interface in omp-general.h to construct variants
+ and access their fields. */
+DEFTREECODE (OMP_METADIRECTIVE, "omp_metadirective", tcc_statement, 1)
+
/* OMP_ATOMIC through OMP_ATOMIC_CAPTURE_NEW must be consecutive,
or OMP_ATOMIC_SEQ_CST needs adjusting. */
diff --git a/gcc/tree.h b/gcc/tree.h
index ee2aae332a4..5e3f27fe6c6 100644
--- a/gcc/tree.h
+++ b/gcc/tree.h
@@ -1596,6 +1596,9 @@ class auto_suppress_location_wrappers
#define OMP_TARGET_EXIT_DATA_CLAUSES(NODE)\
TREE_OPERAND (OMP_TARGET_EXIT_DATA_CHECK (NODE), 0)
+#define OMP_METADIRECTIVE_VARIANTS(NODE) \
+ TREE_OPERAND (OMP_METADIRECTIVE_CHECK (NODE), 0)
+
#define OMP_SCAN_BODY(NODE) TREE_OPERAND (OMP_SCAN_CHECK (NODE), 0)
#define OMP_SCAN_CLAUSES(NODE) TREE_OPERAND (OMP_SCAN_CHECK (NODE), 1)
--
2.25.1
^ permalink raw reply [flat|nested] 13+ messages in thread
* [PATCH 02/12] OpenMP: middle-end support for metadirectives
2024-05-04 21:21 [PATCH 00/12] OpenMP: Metadirective support + "declare variant" improvements Sandra Loosemore
2024-05-04 21:21 ` [PATCH 01/12] OpenMP: metadirective tree data structures and front-end interfaces Sandra Loosemore
@ 2024-05-04 21:21 ` Sandra Loosemore
2024-05-04 21:21 ` [PATCH 03/12] libgomp: runtime support for target_device selector Sandra Loosemore
` (9 subsequent siblings)
11 siblings, 0 replies; 13+ messages in thread
From: Sandra Loosemore @ 2024-05-04 21:21 UTC (permalink / raw)
To: gcc-patches; +Cc: jakub, tburnus
This patch adds middle-end support for OpenMP metadirectives. Some
context selectors can be resolved during gimplification, but others need to
be deferred until the omp_device_lower pass, which requires that cgraph,
LTO streaming, inlining, etc all know about this construct as well.
gcc/ChangeLog
* cgraph.h (struct cgraph_node): Add has_metadirectives flag.
* cgraphclones.cc (cgraph_node::create_clone): Copy has_metadirectives
flag.
* doc/gimple.texi (Class hierarchy of GIMPLE statements): Document
gomp_metadirective and gomp_variant.
* gimple-low.cc (lower_omp_metadirective): New.
(lower_stmt): Call it.
* gimple-pretty-print.cc (dump_gimple_omp_metadirective): New.
(pp_gimple_stmt_1): Call it.
* gimple-streamer-in.cc (input_gimple_stmt): Handle
GIMPLE_OMP_METADIRECTIVE.
* gimple-streamer-out.cc (output_gimple_stmt): Likewise.
* gimple-walk.cc (walk_gimple_op): Likewise.
(walk_gimple_stmt): Likewise.
* gimple.cc (gimple_alloc_omp_metadirective): New.
(gimple_build_omp_metadirective): New.
(gimple_build_omp_variant): New.
* gimple.def (GIMPLE_OMP_METADIRECTIVE): New.
(GIMPLE_OMP_METADIRECTIVE_VARIANT): New.
* gimple.h (gomp_variant, gomp_metadirective): New.
(is_a_helper <gomp_metadirective *>::test): New.
(is_a_helper <gomp_variant *>::test): New.
(is_a_helper <const gomp_metadirective *>::test): New.
(is_a_helper <const gomp_variant *>::test): New.
(gimple_alloc_omp_metadirective): New.
(gimple_build_omp_metadirective): New.
(gimple_build_omp_variant): New.
(gimple_has_substatements): Handle GIMPLE_OMP_METADIRECTIVE.
(gimple_has_ops): Likewise.
(gimple_omp_metadirective_label): New.
(gimple_omp_metadirective_set_label): New.
(gimple_omp_variants): New.
(gimple_omp_metadirective_set_variants): New.
(gimple_return_set_retval): Handle GIMPLE_OMP_METADIRECTIVE.
* gimplify.cc (is_gimple_stmt): HANDLE OMP_METADIRECTIVE.
(expand_omp_metadirective): New.
(gimplify_omp_metadirective): New.
(gimplify_expr): Call it.
* gsstruct.def (GSS_OMP_METADIRECTIVE): New.
(GSS_OMP_METADIRECTIVE_VARIANT): New.
* lto-cgraph.cc (lto_output_node): Handle has_metadirectives flag.
(input_overwrite_node): Likewise.
* omp-expand.cc (expand_omp_target): Propagate has_metadirectives
flag.
(build_omp_regions_1): Handle GIMPLE_OMP_METADIRECTIVE.
(omp_make_gimple_edges): Likewise.
* omp-general.cc (omp_late_resolve_metadirective): New.
* omp-general.h (omp_late_resolve_metadirective): Declare.
* omp-low.cc (struct omp_context): Add next_clone field.
(new_omp_context): Handle next_clone field.
(clone_omp_context): New.
(delete_omp_context): Delete clones.
(create_omp_child_function): Propagate has_metadirectives bit.
(scan_omp_metadirective): New.
(scan_omp_1_stmt): Handle GIMPLE_OMP_METADIRECTIVE.
(lower_omp_metadirective): New.
(lower_omp_1): Handle GIMPLE_OMP_METADIRECTIVE. Warn about
direct calls to offloadable functions containing metadirectives.
* omp-offload.cc: Include cfganal.h and cfghooks.h.
(omp_expand_metadirective): New.
(execute_omp_device_lower): Handle metadirectives.
(pass_omp_device_lower::gate): Check has_metadirectives bit.
* omp-simd-clone.cc (simd_clone_create): Propagate has_metadirectives
flag.
* tree-cfg.cc (cleanup_dead_labels): Handle GIMPLE_OMP_METADIRECTIVE.
(gimple_redirect_edge_and_branch): Likewise.
* tree-inline.cc (remap_gimple_stmt): Handle GIMPLE_OMP_METADIRECTIVE.
(estimate_num_instructions): Likewise.
(expand_call_inline): Propagate has_metadirectives flag.
(tree_function_versioning): Likewise.
* tree-ssa-operands.cc: Include omp-general.h.
(operands_scanner::parse_ssa_operands): Handle
GIMPLE_OMP_METADIRECTIVE.
Co-Authored-By: Kwok Cheung Yeung <kcy@codesourcery.com>
Co-Authored-By: Sandra Loosemore <sandra@codesourcery.com>
Co-Authored-By: Marcel Vollweiler <marcel@codesourcery.com>
---
gcc/cgraph.h | 3 +
gcc/cgraphclones.cc | 1 +
gcc/doc/gimple.texi | 6 ++
gcc/gimple-low.cc | 36 ++++++++
gcc/gimple-pretty-print.cc | 64 +++++++++++++
gcc/gimple-streamer-in.cc | 10 ++
gcc/gimple-streamer-out.cc | 6 ++
gcc/gimple-walk.cc | 28 ++++++
gcc/gimple.cc | 35 +++++++
gcc/gimple.def | 7 ++
gcc/gimple.h | 100 +++++++++++++++++++-
gcc/gimplify.cc | 184 +++++++++++++++++++++++++++++++++++++
gcc/gsstruct.def | 2 +
gcc/lto-cgraph.cc | 2 +
gcc/omp-expand.cc | 30 ++++++
gcc/omp-general.cc | 22 +++++
gcc/omp-general.h | 1 +
gcc/omp-low.cc | 83 +++++++++++++++++
gcc/omp-offload.cc | 105 ++++++++++++++++++++-
gcc/omp-simd-clone.cc | 1 +
gcc/tree-cfg.cc | 24 +++++
gcc/tree-inline.cc | 39 ++++++++
gcc/tree-ssa-operands.cc | 17 ++++
23 files changed, 804 insertions(+), 2 deletions(-)
diff --git a/gcc/cgraph.h b/gcc/cgraph.h
index a8c3224802c..6653ce19c3e 100644
--- a/gcc/cgraph.h
+++ b/gcc/cgraph.h
@@ -900,6 +900,7 @@ struct GTY((tag ("SYMTAB_FUNCTION"))) cgraph_node : public symtab_node
ipcp_clone (false), declare_variant_alt (false),
calls_declare_variant_alt (false), gc_candidate (false),
called_by_ifunc_resolver (false),
+ has_metadirectives (false),
m_uid (uid), m_summary_id (-1)
{}
@@ -1501,6 +1502,8 @@ struct GTY((tag ("SYMTAB_FUNCTION"))) cgraph_node : public symtab_node
unsigned gc_candidate : 1;
/* Set if the function is called by an IFUNC resolver. */
unsigned called_by_ifunc_resolver : 1;
+ /* True if the function contains unresolved metadirectives. */
+ unsigned has_metadirectives : 1;
private:
/* Unique id of the node. */
diff --git a/gcc/cgraphclones.cc b/gcc/cgraphclones.cc
index 4fff6873a36..e6312b5c0ab 100644
--- a/gcc/cgraphclones.cc
+++ b/gcc/cgraphclones.cc
@@ -389,6 +389,7 @@ cgraph_node::create_clone (tree new_decl, profile_count prof_count,
prof_count = count.combine_with_ipa_count (prof_count);
new_node->count = prof_count;
new_node->calls_declare_variant_alt = this->calls_declare_variant_alt;
+ new_node->has_metadirectives = this->has_metadirectives;
/* Update IPA profile. Local profiles need no updating in original. */
if (update_original)
diff --git a/gcc/doc/gimple.texi b/gcc/doc/gimple.texi
index 5f241b1c64f..3de82992394 100644
--- a/gcc/doc/gimple.texi
+++ b/gcc/doc/gimple.texi
@@ -310,6 +310,9 @@ kinds, along with their relationships to @code{GSS_} values (layouts) and
+ gimple_statement_with_ops_base
| | (no GSS layout)
| |
+ | + gomp_metadirective
+ | | code: GIMPLE_OMP_METADIRECTIVE
+ | |
| + gimple_statement_with_ops
| | | layout: GSS_WITH_OPS
| | |
@@ -358,6 +361,9 @@ kinds, along with their relationships to @code{GSS_} values (layouts) and
| + gomp_for
| | layout: GSS_OMP_FOR, code: GIMPLE_OMP_FOR
| |
+ | + gomp_variant
+ | | code: GIMPLE_OMP_METADIRECTIVE_VARIANT
+ | |
| + gomp_parallel_layout
| | | layout: GSS_OMP_PARALLEL_LAYOUT
| | |
diff --git a/gcc/gimple-low.cc b/gcc/gimple-low.cc
index e0371988705..2a8f1e0f7d0 100644
--- a/gcc/gimple-low.cc
+++ b/gcc/gimple-low.cc
@@ -229,6 +229,36 @@ lower_sequence (gimple_seq *seq, struct lower_data *data)
lower_stmt (&gsi, data);
}
+/* Lower the OpenMP metadirective statement pointed by GSI. */
+
+static void
+lower_omp_metadirective (gimple_stmt_iterator *gsi, struct lower_data *data)
+{
+ gimple *stmt = gsi_stmt (*gsi);
+ gimple_seq variant_seq = gimple_omp_variants (stmt);
+ gimple_stmt_iterator variant_gsi = gsi_start (variant_seq);
+ unsigned i;
+
+ /* The variants are not used after lowering. */
+ gimple_omp_metadirective_set_variants (stmt, NULL);
+
+ for (i = 0; i < gimple_num_ops (stmt); i++)
+ {
+ gimple *variant = gsi_stmt (variant_gsi);
+ tree label = create_artificial_label (UNKNOWN_LOCATION);
+ gimple_omp_metadirective_set_label (stmt, i, label);
+ gsi_insert_after (gsi, gimple_build_label (label), GSI_CONTINUE_LINKING);
+
+ gimple_seq *directive_ptr = gimple_omp_body_ptr (variant);
+ lower_sequence (directive_ptr, data);
+ gsi_insert_seq_after (gsi, *directive_ptr, GSI_CONTINUE_LINKING);
+
+ gsi_next (&variant_gsi);
+ }
+
+ gsi_next (gsi);
+}
+
/* Lower the OpenMP directive statement pointed by GSI. DATA is
passed through the recursion. */
@@ -843,6 +873,12 @@ lower_stmt (gimple_stmt_iterator *gsi, struct lower_data *data)
lower_assumption (gsi, data);
return;
+ case GIMPLE_OMP_METADIRECTIVE:
+ data->cannot_fallthru = false;
+ lower_omp_metadirective (gsi, data);
+ data->cannot_fallthru = false;
+ return;
+
case GIMPLE_TRANSACTION:
lower_sequence (gimple_transaction_body_ptr (
as_a <gtransaction *> (stmt)),
diff --git a/gcc/gimple-pretty-print.cc b/gcc/gimple-pretty-print.cc
index abda8871f97..ff22833c211 100644
--- a/gcc/gimple-pretty-print.cc
+++ b/gcc/gimple-pretty-print.cc
@@ -2075,6 +2075,64 @@ dump_gimple_assume (pretty_printer *buffer, const gimple *gs,
}
}
+/* Dump a GIMPLE_OMP_METADIRECTIVE tuple on the pretty_printer BUFFER. */
+
+static void
+dump_gimple_omp_metadirective (pretty_printer *buffer, const gimple *gs,
+ int spc, dump_flags_t flags)
+{
+ if (flags & TDF_RAW)
+ dump_gimple_fmt (buffer, spc, flags, "%G <%+BODY <%S> >", gs,
+ gimple_omp_body (gs));
+ else
+ {
+ pp_string (buffer, "#pragma omp metadirective");
+ newline_and_indent (buffer, spc + 2);
+
+ gimple_seq variant_seq = gimple_omp_variants (gs);
+ gimple_stmt_iterator gsi = gsi_start (variant_seq);
+
+ for (unsigned i = 0; i < gimple_num_ops (gs); i++)
+ {
+ tree selector = gimple_op (gs, i);
+
+ if (selector == NULL_TREE)
+ pp_string (buffer, "default:");
+ else
+ {
+ pp_string (buffer, "when (");
+ dump_omp_context_selector (buffer, selector, spc, flags);
+ pp_string (buffer, "):");
+ }
+
+ gimple *variant = gsi_stmt (gsi);
+
+ if (variant != NULL)
+ {
+ newline_and_indent (buffer, spc + 4);
+ pp_left_brace (buffer);
+ pp_newline (buffer);
+ dump_gimple_seq (buffer, gimple_omp_body (variant), spc + 6,
+ flags);
+ newline_and_indent (buffer, spc + 4);
+ pp_right_brace (buffer);
+
+ gsi_next (&gsi);
+ }
+ else
+ {
+ tree label = gimple_omp_metadirective_label (gs, i);
+
+ pp_string (buffer, " ");
+ dump_generic_node (buffer, label, spc, flags, false);
+ }
+
+ if (i != gimple_num_ops (gs) - 1)
+ newline_and_indent (buffer, spc + 2);
+ }
+ }
+}
+
/* Dump a GIMPLE_TRANSACTION tuple on the pretty_printer BUFFER. */
static void
@@ -2823,6 +2881,12 @@ pp_gimple_stmt_1 (pretty_printer *buffer, const gimple *gs, int spc,
flags);
break;
+ case GIMPLE_OMP_METADIRECTIVE:
+ dump_gimple_omp_metadirective (buffer,
+ as_a <const gomp_metadirective *> (gs),
+ spc, flags);
+ break;
+
case GIMPLE_CATCH:
dump_gimple_catch (buffer, as_a <const gcatch *> (gs), spc, flags);
break;
diff --git a/gcc/gimple-streamer-in.cc b/gcc/gimple-streamer-in.cc
index 61f6d069875..1482d34e9a8 100644
--- a/gcc/gimple-streamer-in.cc
+++ b/gcc/gimple-streamer-in.cc
@@ -151,6 +151,7 @@ input_gimple_stmt (class lto_input_block *ib, class data_in *data_in,
case GIMPLE_COND:
case GIMPLE_GOTO:
case GIMPLE_DEBUG:
+ case GIMPLE_OMP_METADIRECTIVE:
for (i = 0; i < num_ops; i++)
{
tree *opp, op = stream_read_tree (ib, data_in);
@@ -188,6 +189,15 @@ input_gimple_stmt (class lto_input_block *ib, class data_in *data_in,
else
gimple_call_set_fntype (call_stmt, stream_read_tree (ib, data_in));
}
+ if (gomp_metadirective *metadirective_stmt
+ = dyn_cast <gomp_metadirective*> (stmt))
+ {
+ gimple_alloc_omp_metadirective (metadirective_stmt);
+ for (i = 0; i < num_ops; i++)
+ gimple_omp_metadirective_set_label (metadirective_stmt, i,
+ stream_read_tree (ib,
+ data_in));
+ }
break;
case GIMPLE_NOP:
diff --git a/gcc/gimple-streamer-out.cc b/gcc/gimple-streamer-out.cc
index e63d8b4df0c..ccb11fec1da 100644
--- a/gcc/gimple-streamer-out.cc
+++ b/gcc/gimple-streamer-out.cc
@@ -127,6 +127,7 @@ output_gimple_stmt (struct output_block *ob, struct function *fn, gimple *stmt)
case GIMPLE_COND:
case GIMPLE_GOTO:
case GIMPLE_DEBUG:
+ case GIMPLE_OMP_METADIRECTIVE:
for (i = 0; i < gimple_num_ops (stmt); i++)
{
tree op = gimple_op (stmt, i);
@@ -169,6 +170,11 @@ output_gimple_stmt (struct output_block *ob, struct function *fn, gimple *stmt)
else
stream_write_tree (ob, gimple_call_fntype (stmt), true);
}
+ if (gimple_code (stmt) == GIMPLE_OMP_METADIRECTIVE)
+ for (i = 0; i < gimple_num_ops (stmt); i++)
+ stream_write_tree (ob, gimple_omp_metadirective_label (stmt, i),
+ true);
+
break;
case GIMPLE_NOP:
diff --git a/gcc/gimple-walk.cc b/gcc/gimple-walk.cc
index 9f768ca20fd..1290c919116 100644
--- a/gcc/gimple-walk.cc
+++ b/gcc/gimple-walk.cc
@@ -501,6 +501,20 @@ walk_gimple_op (gimple *stmt, walk_tree_fn callback_op,
return ret;
break;
+ case GIMPLE_OMP_METADIRECTIVE:
+ {
+ gimple_seq variant_seq = gimple_omp_variants (stmt);
+ for (gimple_stmt_iterator gsi = gsi_start (variant_seq);
+ !gsi_end_p (gsi); gsi_next (&gsi))
+ {
+ ret = walk_gimple_op (gimple_omp_body (gsi_stmt (gsi)),
+ callback_op, wi);
+ if (ret)
+ return ret;
+ }
+ }
+ break;
+
case GIMPLE_TRANSACTION:
{
gtransaction *txn = as_a <gtransaction *> (stmt);
@@ -717,6 +731,20 @@ walk_gimple_stmt (gimple_stmt_iterator *gsi, walk_stmt_fn callback_stmt,
return wi->callback_result;
break;
+ case GIMPLE_OMP_METADIRECTIVE:
+ {
+ gimple_seq variant_seq = gimple_omp_variants (stmt);
+ for (gimple_stmt_iterator gsi = gsi_start (variant_seq);
+ !gsi_end_p (gsi); gsi_next (&gsi))
+ {
+ ret = walk_gimple_seq_mod (gimple_omp_body_ptr (gsi_stmt (gsi)),
+ callback_stmt, callback_op, wi);
+ if (ret)
+ return wi->callback_result;
+ }
+ }
+ break;
+
case GIMPLE_WITH_CLEANUP_EXPR:
ret = walk_gimple_seq_mod (gimple_wce_cleanup_ptr (stmt), callback_stmt,
callback_op, wi);
diff --git a/gcc/gimple.cc b/gcc/gimple.cc
index a9f968cb038..303b1b029ec 100644
--- a/gcc/gimple.cc
+++ b/gcc/gimple.cc
@@ -1312,6 +1312,41 @@ gimple_build_assume (tree guard, gimple_seq body)
return p;
}
+/* Allocate extra memory for a GIMPLE_OMP_METADIRECTIVE statement. */
+
+void
+gimple_alloc_omp_metadirective (gimple *g)
+{
+ gomp_metadirective *p = as_a <gomp_metadirective *> (g);
+
+ p->labels = ggc_cleared_vec_alloc<tree> (gimple_num_ops (p));
+}
+
+/* Build a GIMPLE_OMP_METADIRECTIVE statement. */
+
+gomp_metadirective *
+gimple_build_omp_metadirective (int num_variants)
+{
+ gomp_metadirective *p
+ = as_a <gomp_metadirective *> (gimple_alloc (GIMPLE_OMP_METADIRECTIVE,
+ num_variants));
+ gimple_alloc_omp_metadirective (p);
+ gimple_omp_metadirective_set_variants (p, NULL);
+
+ return p;
+}
+
+/* Build a GIMPLE_OMP_METADIRECTIVE_VARIANT statement. */
+
+gomp_variant *
+gimple_build_omp_variant (gimple_seq body)
+{
+ gomp_variant *variant = as_a <gomp_variant *>
+ (gimple_alloc (GIMPLE_OMP_METADIRECTIVE_VARIANT, 0));
+ gimple_omp_set_body (variant, body);
+ return variant;
+}
+
/* Build a GIMPLE_TRANSACTION statement. */
gtransaction *
diff --git a/gcc/gimple.def b/gcc/gimple.def
index fbcd727f945..41e69d56bb4 100644
--- a/gcc/gimple.def
+++ b/gcc/gimple.def
@@ -398,6 +398,13 @@ DEFGSCODE(GIMPLE_OMP_TEAMS, "gimple_omp_teams", GSS_OMP_PARALLEL_LAYOUT)
CLAUSES is an OMP_CLAUSE chain holding the associated clauses. */
DEFGSCODE(GIMPLE_OMP_ORDERED, "gimple_omp_ordered", GSS_OMP_SINGLE_LAYOUT)
+/* GIMPLE_OMP_METADIRECTIVE represents #pragma omp metadirective. */
+DEFGSCODE(GIMPLE_OMP_METADIRECTIVE, "gimple_omp_metadirective",
+ GSS_OMP_METADIRECTIVE)
+
+DEFGSCODE(GIMPLE_OMP_METADIRECTIVE_VARIANT,
+ "gimple_omp_variant", GSS_OMP_METADIRECTIVE_VARIANT)
+
/* GIMPLE_PREDICT <PREDICT, OUTCOME> specifies a hint for branch prediction.
PREDICT is one of the predictors from predict.def.
diff --git a/gcc/gimple.h b/gcc/gimple.h
index 8a8ca109bbf..b608ccd2ceb 100644
--- a/gcc/gimple.h
+++ b/gcc/gimple.h
@@ -840,6 +840,30 @@ struct GTY((tag("GSS_ASSUME")))
gimple_seq body;
};
+struct GTY((tag("GSS_OMP_METADIRECTIVE_VARIANT")))
+ gomp_variant : public gimple_statement_omp
+{
+ /* The body in the base class contains the directive for this variant. */
+
+ /* No extra fields; adds invariant:
+ stmt->code == GIMPLE_OMP_METADIRECTIVE_VARIANT. */};
+
+struct GTY((tag("GSS_OMP_METADIRECTIVE")))
+ gomp_metadirective : public gimple_statement_with_ops_base
+{
+ /* [ WORD 1-7 ] : base class */
+
+ /* [ WORD 8 ] : a list of bodies associated with the directive variants. */
+ gomp_variant *variants;
+
+ /* [ WORD 9 ] : label vector. */
+ tree * GTY((length ("%h.num_ops"))) labels;
+
+ /* [ WORD 10 ] : operand vector. Used to hold the selectors for the
+ directive variants. */
+ tree GTY((length ("%h.num_ops"))) op[1];
+};
+
/* GIMPLE_TRANSACTION. */
/* Bits to be stored in the GIMPLE_TRANSACTION subcode. */
@@ -1251,6 +1275,22 @@ is_a_helper <gomp_task *>::test (gimple *gs)
return gs->code == GIMPLE_OMP_TASK;
}
+template <>
+template <>
+inline bool
+is_a_helper <gomp_metadirective *>::test (gimple *gs)
+{
+ return gs->code == GIMPLE_OMP_METADIRECTIVE;
+}
+
+template <>
+template <>
+inline bool
+is_a_helper <gomp_variant *>::test (gimple *gs)
+{
+ return gs->code == GIMPLE_OMP_METADIRECTIVE_VARIANT;
+}
+
template <>
template <>
inline bool
@@ -1501,6 +1541,22 @@ is_a_helper <const gomp_task *>::test (const gimple *gs)
return gs->code == GIMPLE_OMP_TASK;
}
+template <>
+template <>
+inline bool
+is_a_helper <const gomp_metadirective *>::test (const gimple *gs)
+{
+ return gs->code == GIMPLE_OMP_METADIRECTIVE;
+}
+
+template <>
+template <>
+inline bool
+is_a_helper <const gomp_variant *>::test (const gimple *gs)
+{
+ return gs->code == GIMPLE_OMP_METADIRECTIVE_VARIANT;
+}
+
template <>
template <>
inline bool
@@ -1609,6 +1665,9 @@ gomp_teams *gimple_build_omp_teams (gimple_seq, tree);
gomp_atomic_load *gimple_build_omp_atomic_load (tree, tree,
enum omp_memory_order);
gomp_atomic_store *gimple_build_omp_atomic_store (tree, enum omp_memory_order);
+void gimple_alloc_omp_metadirective (gimple *g);
+gomp_metadirective *gimple_build_omp_metadirective (int num_variants);
+gomp_variant *gimple_build_omp_variant (gimple_seq body);
gimple *gimple_build_assume (tree, gimple_seq);
gtransaction *gimple_build_transaction (gimple_seq);
extern void gimple_seq_add_stmt (gimple_seq *, gimple *);
@@ -1890,6 +1949,7 @@ gimple_has_substatements (gimple *g)
case GIMPLE_OMP_TARGET:
case GIMPLE_OMP_TEAMS:
case GIMPLE_OMP_CRITICAL:
+ case GIMPLE_OMP_METADIRECTIVE:
case GIMPLE_WITH_CLEANUP_EXPR:
case GIMPLE_TRANSACTION:
return true;
@@ -2148,7 +2208,8 @@ gimple_init_singleton (gimple *g)
inline bool
gimple_has_ops (const gimple *g)
{
- return gimple_code (g) >= GIMPLE_COND && gimple_code (g) <= GIMPLE_RETURN;
+ return (gimple_code (g) >= GIMPLE_COND && gimple_code (g) <= GIMPLE_RETURN)
+ || gimple_code (g) == GIMPLE_OMP_METADIRECTIVE;
}
template <>
@@ -6630,6 +6691,42 @@ gimple_assume_body (const gimple *gs)
return assume_stmt->body;
}
+
+static inline tree
+gimple_omp_metadirective_label (const gimple *g, unsigned i)
+{
+ const gomp_metadirective *omp_metadirective
+ = as_a <const gomp_metadirective *> (g);
+ return omp_metadirective->labels[i];
+}
+
+
+static inline void
+gimple_omp_metadirective_set_label (gimple *g, unsigned i, tree label)
+{
+ gomp_metadirective *omp_metadirective = as_a <gomp_metadirective *> (g);
+ omp_metadirective->labels[i] = label;
+}
+
+
+static inline gomp_variant *
+gimple_omp_variants (const gimple *g)
+{
+ const gomp_metadirective *omp_metadirective
+ = as_a <const gomp_metadirective *> (g);
+ return omp_metadirective->variants;
+}
+
+
+static inline void
+gimple_omp_metadirective_set_variants (gimple *g, gimple *variants)
+{
+ gomp_metadirective *omp_metadirective = as_a <gomp_metadirective *> (g);
+ omp_metadirective->variants
+ = variants ? as_a <gomp_variant *> (variants) : NULL;
+}
+
+
/* Return a pointer to the body for the GIMPLE_TRANSACTION statement
TRANSACTION_STMT. */
@@ -6781,6 +6878,7 @@ gimple_return_set_retval (greturn *gs, tree retval)
case GIMPLE_OMP_RETURN: \
case GIMPLE_OMP_ATOMIC_LOAD: \
case GIMPLE_OMP_ATOMIC_STORE: \
+ case GIMPLE_OMP_METADIRECTIVE: \
case GIMPLE_OMP_CONTINUE
inline bool
diff --git a/gcc/gimplify.cc b/gcc/gimplify.cc
index 457b33a4293..ccbb5afbec7 100644
--- a/gcc/gimplify.cc
+++ b/gcc/gimplify.cc
@@ -6313,6 +6313,7 @@ is_gimple_stmt (tree t)
case OMP_TASKGROUP:
case OMP_ORDERED:
case OMP_CRITICAL:
+ case OMP_METADIRECTIVE:
case OMP_TASK:
case OMP_TARGET:
case OMP_TARGET_DATA:
@@ -17611,6 +17612,184 @@ gimplify_omp_ordered (tree expr, gimple_seq body)
return gimple_build_omp_ordered (body, OMP_ORDERED_CLAUSES (expr));
}
+/* Replace a metadirective with the candidate directive variants in
+ CANDIDATES. */
+
+static enum gimplify_status
+expand_omp_metadirective (vec<struct omp_variant> &candidates,
+ gimple_seq *pre_p)
+{
+ auto_vec<tree> selectors;
+ auto_vec<tree> directive_labels;
+ auto_vec<gimple_seq> directive_bodies;
+ tree body_label = NULL_TREE;
+ tree end_label = create_artificial_label (UNKNOWN_LOCATION);
+
+ /* Construct bodies for each candidate. */
+ for (unsigned i = 0; i < candidates.length(); i++)
+ {
+ struct omp_variant &candidate = candidates[i];
+ gimple_seq body = NULL;
+
+ selectors.safe_push (candidate.dynamic_selector);
+ directive_labels.safe_push (create_artificial_label (UNKNOWN_LOCATION));
+
+ gimplify_seq_add_stmt (&body,
+ gimple_build_label (directive_labels.last ()));
+ if (candidate.alternative != NULL_TREE)
+ gimplify_stmt (&candidate.alternative, &body);
+ if (candidate.body != NULL_TREE)
+ {
+ if (body_label != NULL_TREE)
+ gimplify_seq_add_stmt (&body, gimple_build_goto (body_label));
+ else
+ {
+ body_label = create_artificial_label (UNKNOWN_LOCATION);
+ gimplify_seq_add_stmt (&body, gimple_build_label (body_label));
+ gimplify_stmt (&candidate.body, &body);
+ }
+ }
+
+ directive_bodies.safe_push (body);
+ }
+
+ auto_vec<tree> cond_labels;
+
+ cond_labels.safe_push (NULL_TREE);
+ for (unsigned i = 1; i < candidates.length () - 1; i++)
+ cond_labels.safe_push (create_artificial_label (UNKNOWN_LOCATION));
+ if (candidates.length () > 1)
+ cond_labels.safe_push (directive_labels.last ());
+
+ /* Generate conditionals to test each dynamic selector in turn, executing
+ the directive candidate if successful. */
+ for (unsigned i = 0; i < candidates.length () - 1; i++)
+ {
+ if (i != 0)
+ gimplify_seq_add_stmt (pre_p, gimple_build_label (cond_labels [i]));
+
+ enum gimplify_status ret = gimplify_expr (&selectors[i], pre_p, NULL,
+ is_gimple_val, fb_rvalue);
+ if (ret == GS_ERROR || ret == GS_UNHANDLED)
+ return ret;
+
+ gcond *cond_stmt
+ = gimple_build_cond_from_tree (selectors[i], directive_labels[i],
+ cond_labels[i + 1]);
+
+ gimplify_seq_add_stmt (pre_p, cond_stmt);
+ gimplify_seq_add_seq (pre_p, directive_bodies[i]);
+ gimplify_seq_add_stmt (pre_p, gimple_build_goto (end_label));
+ }
+
+ gimplify_seq_add_seq (pre_p, directive_bodies.last ());
+ gimplify_seq_add_stmt (pre_p, gimple_build_label (end_label));
+
+ return GS_ALL_DONE;
+}
+
+/* Gimplify an OMP_METADIRECTIVE construct. EXPR is the tree version.
+ The metadirective will be resolved at this point if possible. */
+
+static enum gimplify_status
+gimplify_omp_metadirective (tree *expr_p, gimple_seq *pre_p, gimple_seq *,
+ bool (*) (tree), fallback_t)
+{
+ auto_vec<tree> selectors;
+
+ /* Mark offloadable functions containing metadirectives that specify
+ a 'construct' selector with a 'target' constructor. */
+ if (offloading_function_p (current_function_decl))
+ {
+ for (tree variant = OMP_METADIRECTIVE_VARIANTS (*expr_p);
+ variant != NULL_TREE; variant = TREE_CHAIN (variant))
+ {
+ tree selector = OMP_METADIRECTIVE_VARIANT_SELECTOR (variant);
+
+ if (omp_get_context_selector (selector, OMP_TRAIT_SET_CONSTRUCT,
+ OMP_TRAIT_CONSTRUCT_TARGET))
+ {
+ tree id = get_identifier ("omp metadirective construct target");
+
+ DECL_ATTRIBUTES (current_function_decl)
+ = tree_cons (id, NULL_TREE,
+ DECL_ATTRIBUTES (current_function_decl));
+ break;
+ }
+ }
+ }
+
+ /* Try to resolve the metadirective. */
+ vec<struct omp_variant> candidates
+ = omp_early_resolve_metadirective (*expr_p);
+ if (!candidates.is_empty ())
+ return expand_omp_metadirective (candidates, pre_p);
+
+ /* The metadirective cannot be resolved yet. */
+
+ gomp_variant *first_variant = NULL;
+ gomp_variant *prev_variant = NULL;
+ gimple_seq standalone_body = NULL;
+ tree body_label = NULL;
+ tree end_label = create_artificial_label (UNKNOWN_LOCATION);
+
+ for (tree variant = OMP_METADIRECTIVE_VARIANTS (*expr_p); variant != NULL_TREE;
+ variant = TREE_CHAIN (variant))
+ {
+ tree selector = OMP_METADIRECTIVE_VARIANT_SELECTOR (variant);
+ tree directive = OMP_METADIRECTIVE_VARIANT_DIRECTIVE (variant);
+ tree body = OMP_METADIRECTIVE_VARIANT_BODY (variant);
+
+ selectors.safe_push (selector);
+ gomp_variant *omp_variant
+ = gimple_build_omp_variant (NULL);
+ gimple_seq *directive_p = gimple_omp_body_ptr (omp_variant);
+
+ gimplify_stmt (&directive, directive_p);
+ if (body != NULL_TREE)
+ {
+ if (standalone_body == NULL)
+ {
+ gimplify_stmt (&body, &standalone_body);
+ body_label = create_artificial_label (UNKNOWN_LOCATION);
+ }
+ gimplify_seq_add_stmt (directive_p, gimple_build_goto (body_label));
+ }
+ else
+ gimplify_seq_add_stmt (directive_p, gimple_build_goto (end_label));
+
+ if (!first_variant)
+ first_variant = omp_variant;
+ if (prev_variant)
+ {
+ prev_variant->next = omp_variant;
+ omp_variant->prev = prev_variant;
+ }
+ prev_variant = omp_variant;
+ }
+
+ gomp_metadirective *stmt
+ = gimple_build_omp_metadirective (selectors.length ());
+ gimple_omp_metadirective_set_variants (stmt, first_variant);
+
+ tree selector;
+ unsigned int i;
+ FOR_EACH_VEC_ELT (selectors, i, selector)
+ gimple_set_op (stmt, i, selector);
+
+ gimplify_seq_add_stmt (pre_p, stmt);
+ if (standalone_body)
+ {
+ gimplify_seq_add_stmt (pre_p, gimple_build_label (body_label));
+ gimplify_seq_add_stmt (pre_p, standalone_body);
+ }
+ gimplify_seq_add_stmt (pre_p, gimple_build_label (end_label));
+
+ cgraph_node::get (cfun->decl)->has_metadirectives = 1;
+
+ return GS_ALL_DONE;
+}
+
/* Convert the GENERIC expression tree *EXPR_P to GIMPLE. If the
expression produces a value to be used as an operand inside a GIMPLE
statement, the value will be stored back in *EXPR_P. This value will
@@ -18537,6 +18716,11 @@ gimplify_expr (tree *expr_p, gimple_seq *pre_p, gimple_seq *post_p,
ret = gimplify_omp_atomic (expr_p, pre_p);
break;
+ case OMP_METADIRECTIVE:
+ ret = gimplify_omp_metadirective (expr_p, pre_p, post_p,
+ gimple_test_f, fallback);
+ break;
+
case TRANSACTION_EXPR:
ret = gimplify_transaction (expr_p, pre_p);
break;
diff --git a/gcc/gsstruct.def b/gcc/gsstruct.def
index 91fef093f41..7708dc35fbf 100644
--- a/gcc/gsstruct.def
+++ b/gcc/gsstruct.def
@@ -51,4 +51,6 @@ DEFGSSTRUCT(GSS_OMP_CONTINUE, gomp_continue, false)
DEFGSSTRUCT(GSS_OMP_ATOMIC_LOAD, gomp_atomic_load, false)
DEFGSSTRUCT(GSS_OMP_ATOMIC_STORE_LAYOUT, gomp_atomic_store, false)
DEFGSSTRUCT(GSS_ASSUME, gimple_statement_assume, false)
+DEFGSSTRUCT(GSS_OMP_METADIRECTIVE, gomp_metadirective, true)
+DEFGSSTRUCT(GSS_OMP_METADIRECTIVE_VARIANT, gomp_variant, false)
DEFGSSTRUCT(GSS_TRANSACTION, gtransaction, false)
diff --git a/gcc/lto-cgraph.cc b/gcc/lto-cgraph.cc
index 6395033ab9d..5bd9916fd2c 100644
--- a/gcc/lto-cgraph.cc
+++ b/gcc/lto-cgraph.cc
@@ -551,6 +551,7 @@ lto_output_node (struct lto_simple_output_block *ob, struct cgraph_node *node,
bp_pack_value (&bp, node->parallelized_function, 1);
bp_pack_value (&bp, node->declare_variant_alt, 1);
bp_pack_value (&bp, node->calls_declare_variant_alt, 1);
+ bp_pack_value (&bp, node->has_metadirectives, 1);
/* Stream thunk info always because we use it in
ipa_polymorphic_call_context::ipa_polymorphic_call_context
@@ -1252,6 +1253,7 @@ input_overwrite_node (struct lto_file_decl_data *file_data,
node->parallelized_function = bp_unpack_value (bp, 1);
node->declare_variant_alt = bp_unpack_value (bp, 1);
node->calls_declare_variant_alt = bp_unpack_value (bp, 1);
+ node->has_metadirectives = bp_unpack_value (bp, 1);
*has_thunk_info = bp_unpack_value (bp, 1);
node->resolution = bp_unpack_enum (bp, ld_plugin_symbol_resolution,
LDPR_NUM_KNOWN);
diff --git a/gcc/omp-expand.cc b/gcc/omp-expand.cc
index 24287826444..f44ba204123 100644
--- a/gcc/omp-expand.cc
+++ b/gcc/omp-expand.cc
@@ -10016,6 +10016,8 @@ expand_omp_target (struct omp_region *region)
child_cfun->has_force_vectorize_loops |= cfun->has_force_vectorize_loops;
cgraph_node *node = cgraph_node::get_create (child_fn);
node->parallelized_function = 1;
+ node->has_metadirectives
+ |= cgraph_node::get (cfun->decl)->has_metadirectives;
cgraph_node::add_new_function (child_fn, true);
/* Add the new function to the offload table. */
@@ -10752,6 +10754,10 @@ build_omp_regions_1 (basic_block bb, struct omp_region *parent,
/* GIMPLE_OMP_SECTIONS_SWITCH is part of
GIMPLE_OMP_SECTIONS, and we do nothing for it. */
}
+ else if (code == GIMPLE_OMP_METADIRECTIVE)
+ {
+ /* Do nothing for metadirectives. */
+ }
else
{
region = new_omp_region (bb, code, parent);
@@ -11137,6 +11143,30 @@ omp_make_gimple_edges (basic_block bb, struct omp_region **region,
}
break;
+ case GIMPLE_OMP_METADIRECTIVE:
+ /* Create an edge to the beginning of the body of each candidate
+ directive. */
+ {
+ gimple *stmt = last_nondebug_stmt (bb);
+ unsigned i;
+ bool seen_default = false;
+
+ for (i = 0; i < gimple_num_ops (stmt); i++)
+ {
+ tree dest = gimple_omp_metadirective_label (stmt, i);
+ basic_block dest_bb = label_to_block (cfun, dest);
+ make_edge (bb, dest_bb, 0);
+
+ if (gimple_op (stmt, i) == NULL_TREE)
+ seen_default = true;
+ }
+
+ gcc_assert (seen_default);
+
+ fallthru = false;
+ }
+ break;
+
default:
gcc_unreachable ();
}
diff --git a/gcc/omp-general.cc b/gcc/omp-general.cc
index e4c84d15644..6f36b5d163f 100644
--- a/gcc/omp-general.cc
+++ b/gcc/omp-general.cc
@@ -3187,6 +3187,28 @@ omp_early_resolve_metadirective (tree metadirective)
return omp_get_dynamic_candidates (candidates, true);
}
+/* Return a vector of dynamic replacement candidates for the metadirective
+ Gimple statement in GS. Return an empty vector if the metadirective
+ cannot be resolved. */
+
+vec<struct omp_variant>
+omp_late_resolve_metadirective (gimple *gs)
+{
+ auto_vec <struct omp_variant> variants;
+
+ for (unsigned i = 0; i < gimple_num_ops (gs); i++)
+ {
+ struct omp_variant variant;
+
+ variant.selector = gimple_op (gs, i);
+ variant.alternative = gimple_omp_metadirective_label (gs, i);
+
+ variants.safe_push (variant);
+ }
+
+ return omp_get_dynamic_candidates (variants, false);
+}
+
/* Encode an oacc launch argument. This matches the GOMP_LAUNCH_PACK
macro on gomp-constants.h. We do not check for overflow. */
diff --git a/gcc/omp-general.h b/gcc/omp-general.h
index 5807bc42cd7..b3e9efb93db 100644
--- a/gcc/omp-general.h
+++ b/gcc/omp-general.h
@@ -202,6 +202,7 @@ extern tree omp_get_context_selector (tree, enum omp_tss_code,
extern tree omp_get_context_selector_list (tree, enum omp_tss_code);
extern tree omp_resolve_declare_variant (tree);
extern vec<struct omp_variant> omp_early_resolve_metadirective (tree);
+extern vec<struct omp_variant> omp_late_resolve_metadirective (gimple *);
extern tree oacc_launch_pack (unsigned code, tree device, unsigned op);
extern tree oacc_replace_fn_attrib_attr (tree attribs, tree dims);
extern void oacc_replace_fn_attrib (tree fn, tree dims);
diff --git a/gcc/omp-low.cc b/gcc/omp-low.cc
index 4d003f42098..66915bdab4d 100644
--- a/gcc/omp-low.cc
+++ b/gcc/omp-low.cc
@@ -183,6 +183,10 @@ struct omp_context
/* Candidates for adjusting OpenACC privatization level. */
vec<tree> oacc_privatization_candidates;
+
+ /* Only used for omp metadirectives. Links to the next shallow
+ clone of this context. */
+ struct omp_context *next_clone;
};
static splay_tree all_contexts;
@@ -974,6 +978,7 @@ new_omp_context (gimple *stmt, omp_context *outer_ctx)
splay_tree_insert (all_contexts, (splay_tree_key) stmt,
(splay_tree_value) ctx);
ctx->stmt = stmt;
+ ctx->next_clone = NULL;
if (outer_ctx)
{
@@ -1003,6 +1008,18 @@ new_omp_context (gimple *stmt, omp_context *outer_ctx)
return ctx;
}
+static omp_context *
+clone_omp_context (omp_context *ctx)
+{
+ omp_context *clone_ctx = XCNEW (omp_context);
+
+ memcpy (clone_ctx, ctx, sizeof (omp_context));
+ ctx->next_clone = clone_ctx;
+ clone_ctx->next_clone = NULL;
+
+ return clone_ctx;
+}
+
static gimple_seq maybe_catch_exception (gimple_seq);
/* Finalize task copyfn. */
@@ -1049,6 +1066,15 @@ delete_omp_context (splay_tree_value value)
{
omp_context *ctx = (omp_context *) value;
+ /* Delete clones. */
+ omp_context *clone = ctx->next_clone;
+ while (clone)
+ {
+ omp_context *next_clone = clone->next_clone;
+ XDELETE (clone);
+ clone = next_clone;
+ }
+
delete ctx->cb.decl_map;
if (ctx->field_map)
@@ -2093,6 +2119,9 @@ create_omp_child_function (omp_context *ctx, bool task_copy)
DECL_FUNCTION_VERSIONED (decl)
= DECL_FUNCTION_VERSIONED (current_function_decl);
+ if (cgraph_node::get (cfun->decl)->has_metadirectives)
+ cgraph_node::get_create (decl)->has_metadirectives = 1;
+
if (omp_maybe_offloaded_ctx (ctx))
{
cgraph_node::get_create (decl)->offloadable = 1;
@@ -3182,6 +3211,22 @@ scan_omp_teams (gomp_teams *stmt, omp_context *outer_ctx)
ctx->record_type = ctx->receiver_decl = NULL;
}
+/* Scan an OpenMP metadirective. */
+
+static void
+scan_omp_metadirective (gomp_metadirective *stmt, omp_context *outer_ctx)
+{
+ gimple_seq variant_seq = gimple_omp_variants (stmt);
+ for (gimple_stmt_iterator gsi = gsi_start (variant_seq);
+ !gsi_end_p (gsi); gsi_next (&gsi))
+ {
+ gimple_seq *directive_p = gimple_omp_body_ptr (gsi_stmt (gsi));
+ omp_context *ctx = outer_ctx ? clone_omp_context (outer_ctx) : NULL;
+
+ scan_omp (directive_p, ctx);
+ }
+}
+
/* Check nesting restrictions. */
static bool
check_omp_nesting_restrictions (gimple *stmt, omp_context *ctx)
@@ -4245,6 +4290,10 @@ scan_omp_1_stmt (gimple_stmt_iterator *gsi, bool *handled_ops_p,
scan_omp_teams (as_a <gomp_teams *> (stmt), ctx);
break;
+ case GIMPLE_OMP_METADIRECTIVE:
+ scan_omp_metadirective (as_a <gomp_metadirective *> (stmt), ctx);
+ break;
+
case GIMPLE_BIND:
{
tree var;
@@ -10702,6 +10751,19 @@ oacc_privatization_scan_decl_chain (omp_context *ctx, tree decls)
}
}
+static void
+lower_omp_metadirective (gimple_stmt_iterator *gsi_p, omp_context *ctx)
+{
+ gimple *stmt = gsi_stmt (*gsi_p);
+ gimple_seq variant_seq = gimple_omp_variants (stmt);
+ for (gimple_stmt_iterator gsi = gsi_start (variant_seq);
+ !gsi_end_p (gsi); gsi_next (&gsi))
+ {
+ gimple_seq *directive_p = gimple_omp_body_ptr (gsi_stmt (gsi));
+ lower_omp (directive_p, ctx);
+ }
+}
+
/* Callback for walk_gimple_seq. Find #pragma omp scan statement. */
static tree
@@ -14458,10 +14520,31 @@ lower_omp_1 (gimple_stmt_iterator *gsi_p, omp_context *ctx)
else
lower_omp_teams (gsi_p, ctx);
break;
+ case GIMPLE_OMP_METADIRECTIVE:
+ lower_omp_metadirective (gsi_p, ctx);
+ break;
case GIMPLE_CALL:
tree fndecl;
call_stmt = as_a <gcall *> (stmt);
fndecl = gimple_call_fndecl (call_stmt);
+ if (fndecl
+ && lookup_attribute ("omp metadirective construct target",
+ DECL_ATTRIBUTES (fndecl)))
+ {
+ bool in_target_ctx = false;
+
+ for (omp_context *up = ctx; up; up = up->outer)
+ if (gimple_code (up->stmt) == GIMPLE_OMP_TARGET)
+ {
+ in_target_ctx = true;
+ break;
+ }
+ if (!ctx || !in_target_ctx)
+ warning_at (gimple_location (stmt), 0,
+ "direct calls to an offloadable function containing "
+ "metadirectives with a %<construct={target}%> "
+ "selector may produce unexpected results");
+ }
if (fndecl
&& fndecl_built_in_p (fndecl, BUILT_IN_NORMAL))
switch (DECL_FUNCTION_CODE (fndecl))
diff --git a/gcc/omp-offload.cc b/gcc/omp-offload.cc
index 35313c2ecf3..bbfc6beff87 100644
--- a/gcc/omp-offload.cc
+++ b/gcc/omp-offload.cc
@@ -55,6 +55,8 @@ along with GCC; see the file COPYING3. If not see
#include "context.h"
#include "convert.h"
#include "opts.h"
+#include "cfganal.h"
+#include "cfghooks.h"
/* Describe the OpenACC looping structure of a function. The entire
function is held in a 'NULL' loop. */
@@ -1954,6 +1956,92 @@ is_sync_builtin_call (gcall *call)
return false;
}
+/* Resolve an OpenMP metadirective in the function FUN, in the basic block
+ BB. The metadirective should be the last statement in BB. */
+
+static void
+omp_expand_metadirective (function *fun, basic_block bb)
+{
+ gimple *stmt = last_nondebug_stmt (bb);
+ vec<struct omp_variant> candidates
+ = omp_late_resolve_metadirective (stmt);
+
+ /* This is the last chance for the metadirective to be resolved. */
+ gcc_assert (!candidates.is_empty ());
+
+ auto_vec<tree> labels;
+
+ for (unsigned int i = 0; i < candidates.length (); i++)
+ labels.safe_push (candidates[i].alternative);
+
+ /* Delete BBs for all variants not in the candidate list. */
+ for (unsigned i = 0; i < gimple_num_ops (stmt); i++)
+ {
+ tree label = gimple_omp_metadirective_label (stmt, i);
+ if (!labels.contains (label))
+ {
+ edge e = find_edge (bb, label_to_block (fun, label));
+ remove_edge_and_dominated_blocks (e);
+ labels.safe_push (label);
+ }
+ }
+
+ /* Remove the metadirective statement. */
+ gimple_stmt_iterator gsi = gsi_last_bb (bb);
+ gsi_remove (&gsi, true);
+
+ if (candidates.length () == 1)
+ {
+ /* Special case if there is only one selector - there should be one
+ remaining edge from BB to the selected variant. */
+ edge e = find_edge (bb, label_to_block (fun,
+ candidates.last ().alternative));
+ e->flags |= EDGE_FALLTHRU;
+
+ return;
+ }
+
+ basic_block cur_bb = bb;
+
+ /* For each candidate, create a conditional that checks the dynamic
+ condition, branching to the candidate directive if true, to the
+ next candidate check if false. */
+ for (unsigned i = 0; i < candidates.length () - 1; i++)
+ {
+ basic_block next_bb = NULL;
+ gcond *cond_stmt
+ = gimple_build_cond_from_tree (candidates[i].dynamic_selector,
+ NULL_TREE, NULL_TREE);
+ gsi = gsi_last_bb (cur_bb);
+ gsi_insert_seq_after (&gsi, cond_stmt, GSI_NEW_STMT);
+
+ if (i < candidates.length () - 2)
+ {
+ edge e_false = split_block (cur_bb, cond_stmt);
+ e_false->flags &= ~EDGE_FALLTHRU;
+ e_false->flags |= EDGE_FALSE_VALUE;
+ e_false->probability = profile_probability::uninitialized ();
+
+ next_bb = e_false->dest;
+ }
+
+ /* Redirect the source of the edge from BB to the candidate directive
+ to the conditional. Reusing the edge avoids disturbing phi nodes in
+ the destination BB. */
+ edge e = find_edge (bb, label_to_block (fun, candidates[i].alternative));
+ redirect_edge_pred (e, cur_bb);
+ e->flags |= EDGE_TRUE_VALUE;
+
+ if (next_bb)
+ cur_bb = next_bb;
+ }
+
+ /* The last of the candidates is always static. */
+ edge e = find_edge (cur_bb, label_to_block (fun,
+ candidates.last ().alternative));
+ e->flags |= EDGE_FALSE_VALUE;
+}
+
/* Main entry point for oacc transformations which run on the device
compiler after LTO, so we know what the target device is at this
point (including the host fallback). */
@@ -2632,6 +2720,7 @@ execute_omp_device_lower ()
gimple_stmt_iterator gsi;
bool calls_declare_variant_alt
= cgraph_node::get (cfun->decl)->calls_declare_variant_alt;
+ auto_vec<basic_block> metadirective_bbs;
#ifdef ACCEL_COMPILER
bool omp_redirect_indirect_calls = vec_safe_length (offload_ind_funcs) > 0;
tree map_ptr_fn
@@ -2641,6 +2730,8 @@ execute_omp_device_lower ()
for (gsi = gsi_start_bb (bb); !gsi_end_p (gsi); gsi_next (&gsi))
{
gimple *stmt = gsi_stmt (gsi);
+ if (is_a<gomp_metadirective *> (stmt))
+ metadirective_bbs.safe_push (bb);
if (!is_gimple_call (stmt))
continue;
if (!gimple_call_internal_p (stmt))
@@ -2790,6 +2881,16 @@ execute_omp_device_lower ()
}
if (vf != 1)
cfun->has_force_vectorize_loops = false;
+ if (!metadirective_bbs.is_empty ())
+ {
+ calculate_dominance_info (CDI_DOMINATORS);
+
+ for (unsigned i = 0; i < metadirective_bbs.length (); i++)
+ omp_expand_metadirective (cfun, metadirective_bbs[i]);
+
+ free_dominance_info (cfun, CDI_DOMINATORS);
+ mark_virtual_operands_for_renaming (cfun);
+ }
return 0;
}
@@ -2818,6 +2919,7 @@ public:
/* opt_pass methods: */
bool gate (function *fun) final override
{
+ cgraph_node *node = cgraph_node::get (fun->decl);
#ifdef ACCEL_COMPILER
bool offload_ind_funcs_p = vec_safe_length (offload_ind_funcs) > 0;
#else
@@ -2825,7 +2927,8 @@ public:
#endif
return (!(fun->curr_properties & PROP_gimple_lomp_dev)
|| (flag_openmp
- && (cgraph_node::get (fun->decl)->calls_declare_variant_alt
+ && (node->calls_declare_variant_alt
+ || node->has_metadirectives
|| offload_ind_funcs_p)));
}
unsigned int execute (function *) final override
diff --git a/gcc/omp-simd-clone.cc b/gcc/omp-simd-clone.cc
index 864586207ee..fa80b6b3bb9 100644
--- a/gcc/omp-simd-clone.cc
+++ b/gcc/omp-simd-clone.cc
@@ -690,6 +690,7 @@ simd_clone_create (struct cgraph_node *old_node, bool force_local)
new_node->externally_visible = old_node->externally_visible;
new_node->calls_declare_variant_alt
= old_node->calls_declare_variant_alt;
+ new_node->has_metadirectives = old_node->has_metadirectives;
}
/* Mark clones with internal linkage as gc'able, so they will not be
diff --git a/gcc/tree-cfg.cc b/gcc/tree-cfg.cc
index b1ba33018fd..90194f057db 100644
--- a/gcc/tree-cfg.cc
+++ b/gcc/tree-cfg.cc
@@ -1752,6 +1752,18 @@ cleanup_dead_labels (void)
}
break;
+ case GIMPLE_OMP_METADIRECTIVE:
+ {
+ for (unsigned i = 0; i < gimple_num_ops (stmt); i++)
+ {
+ label = gimple_omp_metadirective_label (stmt, i);
+ new_label = main_block_label (label, label_for_bb);
+ if (new_label != label)
+ gimple_omp_metadirective_set_label (stmt, i, new_label);
+ }
+ }
+ break;
+
default:
break;
}
@@ -6315,6 +6327,18 @@ gimple_redirect_edge_and_branch (edge e, basic_block dest)
gimple_block_label (dest));
break;
+ case GIMPLE_OMP_METADIRECTIVE:
+ {
+ for (unsigned i = 0; i < gimple_num_ops (stmt); i++)
+ {
+ tree label = gimple_omp_metadirective_label (stmt, i);
+ if (label_to_block (cfun, label) == e->dest)
+ gimple_omp_metadirective_set_label (stmt, i,
+ gimple_block_label (dest));
+ }
+ }
+ break;
+
default:
/* Otherwise it must be a fallthru edge, and we don't need to
do anything besides redirecting it. */
diff --git a/gcc/tree-inline.cc b/gcc/tree-inline.cc
index 238afb7de80..c34d2ce1592 100644
--- a/gcc/tree-inline.cc
+++ b/gcc/tree-inline.cc
@@ -1672,6 +1672,36 @@ remap_gimple_stmt (gimple *stmt, copy_body_data *id)
(s1, gimple_omp_masked_clauses (stmt));
break;
+ case GIMPLE_OMP_METADIRECTIVE:
+ copy = gimple_build_omp_metadirective (gimple_num_ops (stmt));
+ {
+ gimple *first_variant = NULL;
+ gimple **prev_next = &first_variant;
+ gimple_seq variant_seq = gimple_omp_variants (stmt);
+ for (gimple_stmt_iterator gsi = gsi_start (variant_seq);
+ !gsi_end_p (gsi); gsi_next (&gsi))
+ {
+ s1 = remap_gimple_seq (gimple_omp_body (gsi_stmt (gsi)), id);
+ gimple *new_variant
+ = gimple_build_omp_variant (s1);
+
+ *prev_next = new_variant;
+ prev_next = &new_variant->next;
+ }
+ gimple_omp_metadirective_set_variants (copy, first_variant);
+ }
+
+ memset (&wi, 0, sizeof (wi));
+ wi.info = id;
+ for (unsigned i = 0; i < gimple_num_ops (stmt); i++)
+ {
+ tree label = gimple_omp_metadirective_label (stmt, i);
+ walk_tree (&label, remap_gimple_op_r, &wi, NULL);
+ gimple_omp_metadirective_set_label (copy, i, label);
+ gimple_set_op (copy, i, gimple_op (stmt, i));
+ }
+ break;
+
case GIMPLE_OMP_SCOPE:
s1 = remap_gimple_seq (gimple_omp_body (stmt), id);
copy = gimple_build_omp_scope
@@ -4607,6 +4637,13 @@ estimate_num_insns (gimple *stmt, eni_weights *weights)
return (weights->omp_cost
+ estimate_num_insns_seq (gimple_omp_body (stmt), weights));
+ case GIMPLE_OMP_METADIRECTIVE:
+ /* The actual instruction will disappear eventually, so metadirective
+ statements have zero additional cost (if only static selectors
+ are used). */
+ /* TODO: Estimate the cost of evaluating dynamic selectors */
+ return 0;
+
case GIMPLE_TRANSACTION:
return (weights->tm_cost
+ estimate_num_insns_seq (gimple_transaction_body (
@@ -5021,6 +5058,7 @@ expand_call_inline (basic_block bb, gimple *stmt, copy_body_data *id,
dst_cfun->calls_eh_return |= id->src_cfun->calls_eh_return;
id->dst_node->calls_declare_variant_alt
|= id->src_node->calls_declare_variant_alt;
+ id->dst_node->has_metadirectives |= id->src_node->has_metadirectives;
gcc_assert (!id->src_cfun->after_inlining);
@@ -6276,6 +6314,7 @@ tree_function_versioning (tree old_decl, tree new_decl,
new_entry ? new_entry->count : old_entry_block->count);
new_version_node->calls_declare_variant_alt
= old_version_node->calls_declare_variant_alt;
+ new_version_node->has_metadirectives = old_version_node->has_metadirectives;
if (DECL_STRUCT_FUNCTION (new_decl)->gimple_df)
DECL_STRUCT_FUNCTION (new_decl)->gimple_df->ipa_pta
= id.src_cfun->gimple_df->ipa_pta;
diff --git a/gcc/tree-ssa-operands.cc b/gcc/tree-ssa-operands.cc
index 1dbf6b9c7c4..30d8d209742 100644
--- a/gcc/tree-ssa-operands.cc
+++ b/gcc/tree-ssa-operands.cc
@@ -28,6 +28,7 @@ along with GCC; see the file COPYING3. If not see
#include "gimple-pretty-print.h"
#include "diagnostic-core.h"
#include "stmt.h"
+#include "omp-general.h"
#include "print-tree.h"
#include "dumpfile.h"
@@ -972,6 +973,22 @@ operands_scanner::parse_ssa_operands ()
append_vuse (gimple_vop (fn));
goto do_default;
+ case GIMPLE_OMP_METADIRECTIVE:
+ n = gimple_num_ops (stmt);
+ for (i = start; i < n; i++)
+ for (tree tss = gimple_op (stmt, i);
+ tss != NULL; tss = TREE_CHAIN (tss))
+ if (OMP_TSS_CODE (tss) == OMP_TRAIT_SET_USER
+ || OMP_TSS_CODE (tss) == OMP_TRAIT_SET_TARGET_DEVICE)
+ for (tree ts = OMP_TSS_TRAIT_SELECTORS (tss);
+ ts != NULL; ts = TREE_CHAIN (ts))
+ if (OMP_TS_CODE (ts) == OMP_TRAIT_USER_CONDITION
+ || OMP_TS_CODE (ts) == OMP_TRAIT_DEVICE_NUM)
+ for (tree tp = OMP_TS_PROPERTIES (ts);
+ tp != NULL; tp = TREE_CHAIN (tp))
+ get_expr_operands (&OMP_TP_VALUE (tp), opf_use);
+ break;
+
case GIMPLE_CALL:
/* Add call-clobbered operands, if needed. */
maybe_add_call_vops (as_a <gcall *> (stmt));
--
2.25.1
^ permalink raw reply [flat|nested] 13+ messages in thread
* [PATCH 03/12] libgomp: runtime support for target_device selector
2024-05-04 21:21 [PATCH 00/12] OpenMP: Metadirective support + "declare variant" improvements Sandra Loosemore
2024-05-04 21:21 ` [PATCH 01/12] OpenMP: metadirective tree data structures and front-end interfaces Sandra Loosemore
2024-05-04 21:21 ` [PATCH 02/12] OpenMP: middle-end support for metadirectives Sandra Loosemore
@ 2024-05-04 21:21 ` Sandra Loosemore
2024-05-04 21:21 ` [PATCH 04/12] OpenMP: C front end support for metadirectives Sandra Loosemore
` (8 subsequent siblings)
11 siblings, 0 replies; 13+ messages in thread
From: Sandra Loosemore @ 2024-05-04 21:21 UTC (permalink / raw)
To: gcc-patches; +Cc: jakub, tburnus
This patch implements the libgomp runtime support for the dynamic
target_device selector via the GOMP_evaluate_target_device function.
include/ChangeLog
* cuda/cuda.h (CUdevice_attribute): Add definitions for
CU_DEVICE_ATTRIBUTE_COMPUTE_CAPABILITY_MAJOR and
CU_DEVICE_ATTRIBUTE_COMPUTE_CAPABILITY_MINOR.
libgomp/ChangeLog
* Makefile.am (libgomp_la_SOURCES): Add selector.c.
* Makefile.in: Regenerate.
* config/gcn/selector.c: New.
* config/linux/selector.c: New.
* config/linux/x86/selector.c: New.
* config/nvptx/selector.c: New.
* libgomp-plugin.h (GOMP_OFFLOAD_evaluate_device): New.
* libgomp.h (struct gomp_device_descr): Add evaluate_device_func field.
* libgomp.map (GOMP_5.1.3): New, add GOMP_evaluate_target_device.
* libgomp.texi (OpenMP Context Selectors): Document dynamic selector
matching of kind/arch/isa.
* libgomp_g.h (GOMP_evaluate_current_device): New.
(GOMP_evaluate_target_device): New.
* oacc-host.c (host_evaluate_device): New.
(host_openacc_exec): Initialize evaluate_device_func field to
host_evaluate_device.
* plugin/plugin-gcn.c (gomp_match_selectors): New.
(gomp_match_isa): New.
(GOMP_OFFLOAD_evaluate_device): New.
* plugin/plugin-nvptx.c (struct ptx_device): Add compute_major and
compute_minor fields.
(nvptx_open_device): Read compute capability information from device.
(gomp_match_selectors): New.
(gomp_match_selector): New.
(CHECK_ISA): New macro.
(GOMP_OFFLOAD_evaluate_device): New.
* selector.c: New.
* target.c (GOMP_evaluate_target_device): New.
(gomp_load_plugin_for_device): Load evaluate_device plugin function.
Co-Authored-By: Kwok Cheung Yeung <kcy@codesourcery.com>
Co-Authored-By: Sandra Loosemore <sandra@codesourcery.com>
---
include/cuda/cuda.h | 2 +
libgomp/Makefile.am | 2 +-
libgomp/Makefile.in | 5 +-
libgomp/config/gcn/selector.c | 102 +++++++
libgomp/config/linux/selector.c | 65 +++++
libgomp/config/linux/x86/selector.c | 406 ++++++++++++++++++++++++++++
libgomp/config/nvptx/selector.c | 77 ++++++
libgomp/libgomp-plugin.h | 2 +
libgomp/libgomp.h | 1 +
libgomp/libgomp.map | 5 +
libgomp/libgomp.texi | 18 +-
libgomp/libgomp_g.h | 8 +
libgomp/oacc-host.c | 11 +
libgomp/plugin/plugin-gcn.c | 52 ++++
libgomp/plugin/plugin-nvptx.c | 82 ++++++
libgomp/selector.c | 64 +++++
libgomp/target.c | 40 +++
17 files changed, 936 insertions(+), 6 deletions(-)
create mode 100644 libgomp/config/gcn/selector.c
create mode 100644 libgomp/config/linux/selector.c
create mode 100644 libgomp/config/linux/x86/selector.c
create mode 100644 libgomp/config/nvptx/selector.c
create mode 100644 libgomp/selector.c
diff --git a/include/cuda/cuda.h b/include/cuda/cuda.h
index 0dca4b3a5c0..a775450df03 100644
--- a/include/cuda/cuda.h
+++ b/include/cuda/cuda.h
@@ -83,6 +83,8 @@ typedef enum {
CU_DEVICE_ATTRIBUTE_MAX_THREADS_PER_MULTIPROCESSOR = 39,
CU_DEVICE_ATTRIBUTE_ASYNC_ENGINE_COUNT = 40,
CU_DEVICE_ATTRIBUTE_UNIFIED_ADDRESSING = 41,
+ CU_DEVICE_ATTRIBUTE_COMPUTE_CAPABILITY_MAJOR = 75,
+ CU_DEVICE_ATTRIBUTE_COMPUTE_CAPABILITY_MINOR = 76,
CU_DEVICE_ATTRIBUTE_MAX_REGISTERS_PER_MULTIPROCESSOR = 82
} CUdevice_attribute;
diff --git a/libgomp/Makefile.am b/libgomp/Makefile.am
index 1871590596d..87658da2d5d 100644
--- a/libgomp/Makefile.am
+++ b/libgomp/Makefile.am
@@ -72,7 +72,7 @@ libgomp_la_SOURCES = alloc.c atomic.c barrier.c critical.c env.c error.c \
target.c splay-tree.c libgomp-plugin.c oacc-parallel.c oacc-host.c \
oacc-init.c oacc-mem.c oacc-async.c oacc-plugin.c oacc-cuda.c \
priority_queue.c affinity-fmt.c teams.c allocator.c oacc-profiling.c \
- oacc-target.c target-indirect.c
+ oacc-target.c target-indirect.c selector.c
include $(top_srcdir)/plugin/Makefrag.am
diff --git a/libgomp/Makefile.in b/libgomp/Makefile.in
index 11480d6a953..30e57571404 100644
--- a/libgomp/Makefile.in
+++ b/libgomp/Makefile.in
@@ -219,7 +219,7 @@ am_libgomp_la_OBJECTS = alloc.lo atomic.lo barrier.lo critical.lo \
oacc-parallel.lo oacc-host.lo oacc-init.lo oacc-mem.lo \
oacc-async.lo oacc-plugin.lo oacc-cuda.lo priority_queue.lo \
affinity-fmt.lo teams.lo allocator.lo oacc-profiling.lo \
- oacc-target.lo target-indirect.lo $(am__objects_1)
+ oacc-target.lo target-indirect.lo selector.lo $(am__objects_1)
libgomp_la_OBJECTS = $(am_libgomp_la_OBJECTS)
AM_V_P = $(am__v_P_@AM_V@)
am__v_P_ = $(am__v_P_@AM_DEFAULT_V@)
@@ -552,7 +552,7 @@ libgomp_la_SOURCES = alloc.c atomic.c barrier.c critical.c env.c \
oacc-parallel.c oacc-host.c oacc-init.c oacc-mem.c \
oacc-async.c oacc-plugin.c oacc-cuda.c priority_queue.c \
affinity-fmt.c teams.c allocator.c oacc-profiling.c \
- oacc-target.c target-indirect.c $(am__append_3)
+ oacc-target.c target-indirect.c selector.c $(am__append_3)
# Nvidia PTX OpenACC plugin.
@PLUGIN_NVPTX_TRUE@libgomp_plugin_nvptx_version_info = -version-info $(libtool_VERSION)
@@ -777,6 +777,7 @@ distclean-compile:
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/ptrlock.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/scope.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/sections.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/selector.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/sem.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/single.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/splay-tree.Plo@am__quote@
diff --git a/libgomp/config/gcn/selector.c b/libgomp/config/gcn/selector.c
new file mode 100644
index 00000000000..7e099a00b97
--- /dev/null
+++ b/libgomp/config/gcn/selector.c
@@ -0,0 +1,102 @@
+/* Copyright (C) 2022 Free Software Foundation, Inc.
+ Contributed by Mentor, a Siemens Business.
+
+ This file is part of the GNU Offloading and Multi Processing Library
+ (libgomp).
+
+ Libgomp is free software; you can redistribute it and/or modify it
+ under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 3, or (at your option)
+ any later version.
+
+ Libgomp is distributed in the hope that it will be useful, but WITHOUT ANY
+ WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+ FOR A PARTICULAR PURPOSE. See the GNU General Public License for
+ more details.
+
+ Under Section 7 of GPL version 3, you are granted additional
+ permissions described in the GCC Runtime Library Exception, version
+ 3.1, as published by the Free Software Foundation.
+
+ You should have received a copy of the GNU General Public License and
+ a copy of the GCC Runtime Library Exception along with this program;
+ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+ <http://www.gnu.org/licenses/>. */
+
+/* This file contains an implementation of GOMP_evaluate_current_device for
+ an AMD GCN GPU. */
+
+#include "libgomp.h"
+#include <string.h>
+
+/* The selectors are passed as strings, but are actually sets of multiple
+ trait property names, separated by '\0' and with an extra '\0' at
+ the end. Match such a string SELECTORS against an array of strings
+ CHOICES, that is terminated by a null pointer.
+ matches. */
+static bool
+gomp_match_selectors (const char *selectors, const char **choices)
+{
+ while (*selectors != '\0')
+ {
+ bool match = false;
+ for (int i = 0; !match && choices[i]; i++)
+ match = !strcmp (selectors, choices[i]);
+ if (!match)
+ return false;
+ selectors += strlen (selectors) + 1;
+ }
+ return true;
+}
+
+bool
+GOMP_evaluate_current_device (const char *kind, const char *arch,
+ const char *isa)
+{
+ static const char *kind_choices[] = { "gpu", "nohost", NULL };
+ static const char *arch_choices[] = { "gcn", "amdgcn", NULL };
+ static const char *isa_choices[]
+ = {
+#ifdef __fiji__
+ "fiji", "gfx803",
+#endif
+#ifdef __gfx900__
+ "gfx900",
+#endif
+#ifdef __gfx906__
+ "gfx906",
+#endif
+#ifdef __gfx908__
+ "gfx908",
+#endif
+#ifdef __gfx90a__
+ "gfx90a",
+#endif
+#ifdef __gfx90c__
+ "gfx90c",
+#endif
+#ifdef __gfx1030__
+ "gfx1030",
+#endif
+#ifdef __gfx1036__
+ "gfx1036",
+#endif
+#ifdef __gfx1100__
+ "gfx1100",
+#endif
+#ifdef __gfx1103__
+ "gfx1103",
+#endif
+ NULL };
+
+ if (kind && !gomp_match_selectors (kind, kind_choices))
+ return false;
+
+ if (arch && !gomp_match_selectors (arch, arch_choices))
+ return false;
+
+ if (isa && !gomp_match_selectors (isa, isa_choices))
+ return false;
+
+ return true;
+}
diff --git a/libgomp/config/linux/selector.c b/libgomp/config/linux/selector.c
new file mode 100644
index 00000000000..064cb937ecc
--- /dev/null
+++ b/libgomp/config/linux/selector.c
@@ -0,0 +1,65 @@
+/* Copyright (C) 2022 Free Software Foundation, Inc.
+ Contributed by Mentor, a Siemens Business.
+
+ This file is part of the GNU Offloading and Multi Processing Library
+ (libgomp).
+
+ Libgomp is free software; you can redistribute it and/or modify it
+ under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 3, or (at your option)
+ any later version.
+
+ Libgomp is distributed in the hope that it will be useful, but WITHOUT ANY
+ WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+ FOR A PARTICULAR PURPOSE. See the GNU General Public License for
+ more details.
+
+ Under Section 7 of GPL version 3, you are granted additional
+ permissions described in the GCC Runtime Library Exception, version
+ 3.1, as published by the Free Software Foundation.
+
+ You should have received a copy of the GNU General Public License and
+ a copy of the GCC Runtime Library Exception along with this program;
+ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+ <http://www.gnu.org/licenses/>. */
+
+/* This file contains a generic implementation of
+ GOMP_evaluate_current_device when run on a Linux host. */
+
+#include <string.h>
+#include "libgomp.h"
+
+/* The selectors are passed as strings, but are actually sets of multiple
+ trait property names, separated by '\0' and with an extra '\0' at
+ the end. Match such a string SELECTORS against an array of strings
+ CHOICES, that is terminated by a null pointer.
+ matches. */
+static bool
+gomp_match_selectors (const char *selectors, const char **choices)
+{
+ while (*selectors != '\0')
+ {
+ bool match = false;
+ for (int i = 0; !match && choices[i]; i++)
+ match = !strcmp (selectors, choices[i]);
+ if (!match)
+ return false;
+ selectors += strlen (selectors) + 1;
+ }
+ return true;
+}
+
+bool
+GOMP_evaluate_current_device (const char *kind, const char *arch,
+ const char *isa)
+{
+ static const char *kind_choices[] = { "cpu", "host", NULL };
+
+ if (kind && !gomp_match_selectors (kind, kind_choices))
+ return false;
+
+ if (arch || isa)
+ return false;
+
+ return true;
+}
diff --git a/libgomp/config/linux/x86/selector.c b/libgomp/config/linux/x86/selector.c
new file mode 100644
index 00000000000..13cd2e14389
--- /dev/null
+++ b/libgomp/config/linux/x86/selector.c
@@ -0,0 +1,406 @@
+/* Copyright (C) 2022 Free Software Foundation, Inc.
+ Contributed by Mentor, a Siemens Business.
+
+ This file is part of the GNU Offloading and Multi Processing Library
+ (libgomp).
+
+ Libgomp is free software; you can redistribute it and/or modify it
+ under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 3, or (at your option)
+ any later version.
+
+ Libgomp is distributed in the hope that it will be useful, but WITHOUT ANY
+ WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+ FOR A PARTICULAR PURPOSE. See the GNU General Public License for
+ more details.
+
+ Under Section 7 of GPL version 3, you are granted additional
+ permissions described in the GCC Runtime Library Exception, version
+ 3.1, as published by the Free Software Foundation.
+
+ You should have received a copy of the GNU General Public License and
+ a copy of the GCC Runtime Library Exception along with this program;
+ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+ <http://www.gnu.org/licenses/>. */
+
+/* This file contains an implementation of GOMP_evaluate_current_device for
+ an x86/x64-based Linux host. */
+
+#include <string.h>
+#include "libgomp.h"
+
+/* The selectors are passed as strings, but are actually sets of multiple
+ trait property names, separated by '\0' and with an extra '\0' at
+ the end. Match such a string SELECTORS against an array of strings
+ CHOICES, that is terminated by a null pointer.
+ matches. */
+static bool
+gomp_match_selectors (const char *selectors, const char **choices)
+{
+ while (*selectors != '\0')
+ {
+ bool match = false;
+ for (int i = 0; !match && choices[i]; i++)
+ match = !strcmp (selectors, choices[i]);
+ if (!match)
+ return false;
+ selectors += strlen (selectors) + 1;
+ }
+ return true;
+}
+
+bool
+GOMP_evaluate_current_device (const char *kind, const char *arch,
+ const char *isa)
+{
+ static const char *kind_choices[] = { "cpu", "host", NULL };
+
+ static const char *arch_choices[]
+ = { "x86",
+ "ia32",
+#ifdef __x86_64__
+ "x86_64",
+#endif
+#ifdef __ILP32__
+ "x32",
+#endif
+ "i386",
+#ifdef __i486__
+ "i486",
+#endif
+#ifdef __i586__
+ "i586",
+#endif
+#ifdef __i686__
+ "i686",
+#endif
+ NULL };
+
+ static const char *isa_choices[]
+ = {
+#ifdef __WBNOINVD__
+ "wbnoinvd",
+#endif
+#ifdef __AVX512VP2INTERSECT__
+ "avx512vp2intersect",
+#endif
+#ifdef __MMX__
+ "mmx",
+#endif
+#ifdef __3dNOW__
+ "3dnow",
+#endif
+#ifdef __3dNOW_A__
+ "3dnowa",
+#endif
+#ifdef __SSE__
+ "sse",
+#endif
+#ifdef __SSE2__
+ "sse2",
+#endif
+#ifdef __SSE3__
+ "sse3",
+#endif
+#ifdef __SSSE3__
+ "ssse3",
+#endif
+#ifdef __SSE4_1__
+ "sse4.1",
+#endif
+#ifdef __SSE4_2__
+ "sse4",
+ "sse4.2",
+#endif
+#ifdef __AES__
+ "aes",
+#endif
+#ifdef __SHA__
+ "sha",
+#endif
+#ifdef __PCLMUL__
+ "pclmul",
+#endif
+#ifdef __AVX__
+ "avx",
+#endif
+#ifdef __AVX2__
+ "avx2",
+#endif
+#ifdef __AVX512F__
+ "avx512f",
+#endif
+#ifdef __AVX512ER__
+ "avx512er",
+#endif
+#ifdef __AVX512CD__
+ "avx512cd",
+#endif
+#ifdef __AVX512PF__
+ "avx512pf",
+#endif
+#ifdef __AVX512DQ__
+ "avx512dq",
+#endif
+#ifdef __AVX512BW__
+ "avx512bw",
+#endif
+#ifdef __AVX512VL__
+ "avx512vl",
+#endif
+#ifdef __AVX512VBMI__
+ "avx512vbmi",
+#endif
+#ifdef __AVX512IFMA__
+ "avx512ifma",
+#endif
+#ifdef __AVX5124VNNIW__
+ "avx5124vnniw",
+#endif
+#ifdef __AVX512VBMI2__
+ "avx512vbmi2",
+#endif
+#ifdef __AVX512VNNI__
+ "avx512vnni",
+#endif
+#ifdef __PCONFIG__
+ "pconfig",
+#endif
+#ifdef __SGX__
+ "sgx",
+#endif
+#ifdef __AVX5124FMAPS__
+ "avx5124fmaps",
+#endif
+#ifdef __AVX512BITALG__
+ "avx512bitalg",
+#endif
+#ifdef __AVX512VPOPCNTDQ__
+ "avx512vpopcntdq",
+#endif
+#ifdef __FMA__
+ "fma",
+#endif
+#ifdef __RTM__
+ "rtm",
+#endif
+#ifdef __SSE4A__
+ "sse4a",
+#endif
+#ifdef __FMA4__
+ "fma4",
+#endif
+#ifdef __XOP__
+ "xop",
+#endif
+#ifdef __LWP__
+ "lwp",
+#endif
+#ifdef __ABM__
+ "abm",
+#endif
+#ifdef __BMI__
+ "bmi",
+#endif
+#ifdef __BMI2__
+ "bmi2",
+#endif
+#ifdef __LZCNT__
+ "lzcnt",
+#endif
+#ifdef __TBM__
+ "tbm",
+#endif
+#ifdef __CRC32__
+ "crc32",
+#endif
+#ifdef __POPCNT__
+ "popcnt",
+#endif
+#ifdef __FSGSBASE__
+ "fsgsbase",
+#endif
+#ifdef __RDRND__
+ "rdrnd",
+#endif
+#ifdef __F16C__
+ "f16c",
+#endif
+#ifdef __RDSEED__
+ "rdseed",
+#endif
+#ifdef __PRFCHW__
+ "prfchw",
+#endif
+#ifdef __ADX__
+ "adx",
+#endif
+#ifdef __FXSR__
+ "fxsr",
+#endif
+#ifdef __XSAVE__
+ "xsave",
+#endif
+#ifdef __XSAVEOPT__
+ "xsaveopt",
+#endif
+#ifdef __PREFETCHWT1__
+ "prefetchwt1",
+#endif
+#ifdef __CLFLUSHOPT__
+ "clflushopt",
+#endif
+#ifdef __CLZERO__
+ "clzero",
+#endif
+#ifdef __XSAVEC__
+ "xsavec",
+#endif
+#ifdef __XSAVES__
+ "xsaves",
+#endif
+#ifdef __CLWB__
+ "clwb",
+#endif
+#ifdef __MWAITX__
+ "mwaitx",
+#endif
+#ifdef __PKU__
+ "pku",
+#endif
+#ifdef __RDPID__
+ "rdpid",
+#endif
+#ifdef __GFNI__
+ "gfni",
+#endif
+#ifdef __SHSTK__
+ "shstk",
+#endif
+#ifdef __VAES__
+ "vaes",
+#endif
+#ifdef __VPCLMULQDQ__
+ "vpclmulqdq",
+#endif
+#ifdef __MOVDIRI__
+ "movdiri",
+#endif
+#ifdef __MOVDIR64B__
+ "movdir64b",
+#endif
+#ifdef __WAITPKG__
+ "waitpkg",
+#endif
+#ifdef __CLDEMOTE__
+ "cldemote",
+#endif
+#ifdef __SERIALIZE__
+ "serialize",
+#endif
+#ifdef __PTWRITE__
+ "ptwrite",
+#endif
+#ifdef __AVX512BF16__
+ "avx512bf16",
+#endif
+#ifdef __AVX512FP16__
+ "avx512fp16",
+#endif
+#ifdef __ENQCMD__
+ "enqcmd",
+#endif
+#ifdef __TSXLDTRK__
+ "tsxldtrk",
+#endif
+#ifdef __AMX_TILE__
+ "amx-tile",
+#endif
+#ifdef __AMX_INT8__
+ "amx-int8",
+#endif
+#ifdef __AMX_BF16__
+ "amx-bf16",
+#endif
+#ifdef __LAHF_SAHF__
+ "sahf",
+#endif
+#ifdef __MOVBE__
+ "movbe",
+#endif
+#ifdef __UINTR__
+ "uintr",
+#endif
+#ifdef __HRESET__
+ "hreset",
+#endif
+#ifdef __KL__
+ "kl",
+#endif
+#ifdef __WIDEKL__
+ "widekl",
+#endif
+#ifdef __AVXVNNI__
+ "avxvnni",
+#endif
+#ifdef __AVXIFMA_
+ "avxifma",_
+#endif
+#ifdef __AVXVNNIINT8__
+ "avxvnniint8",
+#endif
+#ifdef __AVXNECONVERT__
+ "avxneconvert",
+#endif
+#ifdef __CMPCCXADD__
+ "cmpccxadd",
+#endif
+#ifdef __AMX_FP16__
+ "amx-fp16",
+#endif
+#ifdef __PREFETCHI__
+ "prefetchi",
+#endif
+#ifdef __RAOINT__
+ "raoint",
+#endif
+#ifdef __AMX_COMPLEX__
+ "amx-complex",
+#endif
+#ifdef __AVXVNNIINT16__
+ "amxvnniint16",
+#endif
+#ifdef __SM3__
+ "sm3",
+#endif
+#ifdef __SHA512__
+ "sha512",
+#endif
+#ifdef __SM4__
+ "sm4",
+#endif
+#ifdef __EVEX512__
+ "evex512",
+#endif
+#ifdef __USER_MSR__
+ "usermsr",
+#endif
+#ifdef __AVX10_1_256__
+ "avx10.1-256",
+#endif
+#ifdef __AVX10_1_512__
+ "avx10.1-512",
+#endif
+#ifdef __APX_F__
+ "apxf",
+#endif
+ NULL };
+
+ if (kind && !gomp_match_selectors (kind, kind_choices))
+ return false;
+ if (arch && !gomp_match_selectors (arch, arch_choices))
+ return false;
+ if (isa && !gomp_match_selectors (isa, isa_choices))
+ return false;
+ return true;
+}
diff --git a/libgomp/config/nvptx/selector.c b/libgomp/config/nvptx/selector.c
new file mode 100644
index 00000000000..c1e81efca28
--- /dev/null
+++ b/libgomp/config/nvptx/selector.c
@@ -0,0 +1,77 @@
+/* Copyright (C) 2022 Free Software Foundation, Inc.
+ Contributed by Mentor, a Siemens Business.
+
+ This file is part of the GNU Offloading and Multi Processing Library
+ (libgomp).
+
+ Libgomp is free software; you can redistribute it and/or modify it
+ under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 3, or (at your option)
+ any later version.
+
+ Libgomp is distributed in the hope that it will be useful, but WITHOUT ANY
+ WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+ FOR A PARTICULAR PURPOSE. See the GNU General Public License for
+ more details.
+
+ Under Section 7 of GPL version 3, you are granted additional
+ permissions described in the GCC Runtime Library Exception, version
+ 3.1, as published by the Free Software Foundation.
+
+ You should have received a copy of the GNU General Public License and
+ a copy of the GCC Runtime Library Exception along with this program;
+ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+ <http://www.gnu.org/licenses/>. */
+
+/* This file contains an implementation of GOMP_evaluate_current_device for
+ a Nvidia GPU. */
+
+#include "libgomp.h"
+#include <string.h>
+
+static bool
+gomp_match_selectors (const char *selectors, const char **choices)
+{
+ while (*selectors != '\0')
+ {
+ bool match = false;
+ for (int i = 0; !match && choices[i]; i++)
+ match = !strcmp (selectors, choices[i]);
+ if (!match)
+ return false;
+ selectors += strlen (selectors) + 1;
+ }
+ return true;
+}
+
+bool
+GOMP_evaluate_current_device (const char *kind, const char *arch,
+ const char *isa)
+{
+ static const char *kind_choices[] = { "gpu", "nohost", NULL };
+ static const char *arch_choices[] = { "nvptx", NULL };
+ static const char *isa_choices[]
+ = {
+ "sm_30",
+#if __PTX_SM__ >= 350
+ "sm_35",
+#endif
+#if __PTX_SM__ >= 530
+ "sm_53",
+#endif
+#if __PTX_SM__ >= 750
+ "sm_75",
+#endif
+#if __PTX_SM__ >= 800
+ "sm_80",
+#endif
+ NULL };
+
+ if (kind && !gomp_match_selectors (kind, kind_choices))
+ return false;
+ if (arch && !gomp_match_selectors (arch, arch_choices))
+ return false;
+ if (isa && !gomp_match_selectors (isa, isa_choices))
+ return false;
+ return true;
+}
diff --git a/libgomp/libgomp-plugin.h b/libgomp/libgomp-plugin.h
index 0c9c28c65cf..73f880ffa2f 100644
--- a/libgomp/libgomp-plugin.h
+++ b/libgomp/libgomp-plugin.h
@@ -152,6 +152,8 @@ extern int GOMP_OFFLOAD_memcpy3d (int, int, size_t, size_t, size_t, void *,
extern bool GOMP_OFFLOAD_can_run (void *);
extern void GOMP_OFFLOAD_run (int, void *, void *, void **);
extern void GOMP_OFFLOAD_async_run (int, void *, void *, void **, void *);
+extern bool GOMP_OFFLOAD_evaluate_device (int, const char *, const char *,
+ const char *);
extern void GOMP_OFFLOAD_openacc_exec (void (*) (void *), size_t, void **,
void **, unsigned *, void *);
diff --git a/libgomp/libgomp.h b/libgomp/libgomp.h
index 089393846d1..4dad4bc321a 100644
--- a/libgomp/libgomp.h
+++ b/libgomp/libgomp.h
@@ -1417,6 +1417,7 @@ struct gomp_device_descr
__typeof (GOMP_OFFLOAD_can_run) *can_run_func;
__typeof (GOMP_OFFLOAD_run) *run_func;
__typeof (GOMP_OFFLOAD_async_run) *async_run_func;
+ __typeof (GOMP_OFFLOAD_evaluate_device) *evaluate_device_func;
/* Splay tree containing information about mapped memory regions. */
struct splay_tree_s mem_map;
diff --git a/libgomp/libgomp.map b/libgomp/libgomp.map
index 65901dff235..70a48874417 100644
--- a/libgomp/libgomp.map
+++ b/libgomp/libgomp.map
@@ -428,6 +428,11 @@ GOMP_5.1.2 {
GOMP_target_map_indirect_ptr;
} GOMP_5.1.1;
+GOMP_5.1.3 {
+ global:
+ GOMP_evaluate_target_device;
+} GOMP_5.1.2;
+
OACC_2.0 {
global:
acc_get_num_devices;
diff --git a/libgomp/libgomp.texi b/libgomp/libgomp.texi
index 71d62105a20..43048da4d6e 100644
--- a/libgomp/libgomp.texi
+++ b/libgomp/libgomp.texi
@@ -6181,9 +6181,10 @@ smaller number. On non-host devices, the value of the
@c has to be implemented; cf. also PR target/105640.
@c For offload devices, add *additionally* gcc/config/*/t-omp-device.
-For the host compiler, @code{kind} always matches @code{host}; for the
-offloading architectures AMD GCN and Nvidia PTX, @code{kind} always matches
-@code{gpu}. For the x86 family of computers, AMD GCN and Nvidia PTX
+For the host compiler, @code{kind} always matches @code{host} and @code{cpu};
+for the offloading architectures AMD GCN and Nvidia PTX, @code{kind}
+always matches @code{gpu} and @code{nohost}.
+For the x86 family of computers, AMD GCN and Nvidia PTX
the following traits are supported in addition; while OpenMP is supported
on more architectures, GCC currently does not match any @code{arch} or
@code{isa} traits for those.
@@ -6200,6 +6201,17 @@ on more architectures, GCC currently does not match any @code{arch} or
@tab See @code{-march=} in ``Nvidia PTX Options''
@end multitable
+For x86, note that the set of matching @code{arch} and @code{isa}
+selectors is determined by command-line options rather than the actual
+hardware. This is particularly true of dynamic selectors, which match
+the options used to build libgomp rather than the options used to
+build user programs (which may also differ between compilation units).
+
+For the @code{target_device} selector on AMD GCN and Nvidia PTX,
+the actual hardware is checked at run time. On AMD GCN, an exact match
+of the @code{isa} selector is required, while on Nvidia PTX lower-numbered
+revisions also match.
+
@node Memory allocation
@section Memory allocation
diff --git a/libgomp/libgomp_g.h b/libgomp/libgomp_g.h
index c0cc03ae61f..e9d60238e2b 100644
--- a/libgomp/libgomp_g.h
+++ b/libgomp/libgomp_g.h
@@ -337,6 +337,11 @@ extern void GOMP_single_copy_end (void *);
extern void GOMP_scope_start (uintptr_t *);
+/* selector.c */
+
+extern bool GOMP_evaluate_current_device (const char *, const char *,
+ const char *);
+
/* target.c */
extern void GOMP_target (int, void (*) (void *), const void *,
@@ -359,6 +364,9 @@ extern void GOMP_teams (unsigned int, unsigned int);
extern bool GOMP_teams4 (unsigned int, unsigned int, unsigned int, bool);
extern void *GOMP_target_map_indirect_ptr (void *);
+extern bool GOMP_evaluate_target_device (int, const char *, const char *,
+ const char *);
+
/* teams.c */
extern void GOMP_teams_reg (void (*) (void *), void *, unsigned, unsigned,
diff --git a/libgomp/oacc-host.c b/libgomp/oacc-host.c
index 5efdf7fb796..b6883850250 100644
--- a/libgomp/oacc-host.c
+++ b/libgomp/oacc-host.c
@@ -136,6 +136,16 @@ host_run (int n __attribute__ ((unused)), void *fn_ptr, void *vars,
fn (vars);
}
+static bool
+host_evaluate_device (int device_num __attribute__ ((unused)),
+ const char *kind __attribute__ ((unused)),
+ const char *arch __attribute__ ((unused)),
+ const char *isa __attribute__ ((unused)))
+{
+ __builtin_unreachable ();
+ return false;
+}
+
static void
host_openacc_exec (void (*fn) (void *),
size_t mapnum __attribute__ ((unused)),
@@ -285,6 +295,7 @@ static struct gomp_device_descr host_dispatch =
.memcpy2d_func = NULL,
.memcpy3d_func = NULL,
.run_func = host_run,
+ .evaluate_device_func = host_evaluate_device,
.mem_map = { NULL },
.mem_map_rev = { NULL },
diff --git a/libgomp/plugin/plugin-gcn.c b/libgomp/plugin/plugin-gcn.c
index 3cdc7ba929f..9d9f34cf767 100644
--- a/libgomp/plugin/plugin-gcn.c
+++ b/libgomp/plugin/plugin-gcn.c
@@ -4395,6 +4395,58 @@ GOMP_OFFLOAD_async_run (int device, void *tgt_fn, void *tgt_vars,
GOMP_PLUGIN_target_task_completion, async_data);
}
+/* The selectors are passed as strings, but are actually sets of multiple
+ trait property names, separated by '\0' and with an extra '\0' at
+ the end. Match such a string SELECTORS against an array of strings
+ CHOICES, that is terminated by a null pointer.
+ matches. */
+static bool
+gomp_match_selectors (const char *selectors, const char **choices)
+{
+ while (*selectors != '\0')
+ {
+ bool match = false;
+ for (int i = 0; !match && choices[i]; i++)
+ match = !strcmp (selectors, choices[i]);
+ if (!match)
+ return false;
+ selectors += strlen (selectors) + 1;
+ }
+ return true;
+}
+
+/* Here we can only have one possible match and it must be
+ the only selector provided. */
+static bool
+gomp_match_isa (const char *selectors, gcn_isa isa)
+{
+ if (isa_code (selectors) != isa)
+ return false;
+ if (*(selectors + strlen (selectors) + 1) != '\0')
+ return false;
+ return true;
+}
+
+bool
+GOMP_OFFLOAD_evaluate_device (int device_num, const char *kind,
+ const char *arch, const char *isa)
+{
+ static const char *kind_choices[] = { "gpu", "nohost", NULL };
+ static const char *arch_choices[] = { "gcn", "amdgcn", NULL };
+ struct agent_info *agent = get_agent_info (device_num);
+
+ if (kind && !gomp_match_selectors (kind, kind_choices))
+ return false;
+
+ if (arch && !gomp_match_selectors (arch, arch_choices))
+ return false;
+
+ if (isa && !gomp_match_isa (isa, agent->device_isa))
+ return false;
+
+ return true;
+}
+
/* }}} */
/* {{{ OpenACC Plugin API */
diff --git a/libgomp/plugin/plugin-nvptx.c b/libgomp/plugin/plugin-nvptx.c
index 5aad3448a8d..5126720eb5c 100644
--- a/libgomp/plugin/plugin-nvptx.c
+++ b/libgomp/plugin/plugin-nvptx.c
@@ -317,6 +317,7 @@ struct ptx_device
int max_threads_per_block;
int max_threads_per_multiprocessor;
int default_dims[GOMP_DIM_MAX];
+ int compute_major, compute_minor;
/* Length as used by the CUDA Runtime API ('struct cudaDeviceProp'). */
char name[256];
@@ -541,6 +542,14 @@ nvptx_open_device (int n)
for (int i = 0; i != GOMP_DIM_MAX; i++)
ptx_dev->default_dims[i] = 0;
+ CUDA_CALL_ERET (NULL, cuDeviceGetAttribute, &pi,
+ CU_DEVICE_ATTRIBUTE_COMPUTE_CAPABILITY_MAJOR, dev);
+ ptx_dev->compute_major = pi;
+
+ CUDA_CALL_ERET (NULL, cuDeviceGetAttribute, &pi,
+ CU_DEVICE_ATTRIBUTE_COMPUTE_CAPABILITY_MINOR, dev);
+ ptx_dev->compute_minor = pi;
+
CUDA_CALL_ERET (NULL, cuDeviceGetName, ptx_dev->name, sizeof ptx_dev->name,
dev);
@@ -2314,3 +2323,76 @@ GOMP_OFFLOAD_run (int ord, void *tgt_fn, void *tgt_vars, void **args)
}
/* TODO: Implement GOMP_OFFLOAD_async_run. */
+
+/* The selectors are passed as strings, but are actually sets of multiple
+ trait property names, separated by '\0' and with an extra '\0' at
+ the end. Match such a string SELECTORS against an array of strings
+ CHOICES, that is terminated by a null pointer.
+ matches. */
+static bool
+gomp_match_selectors (const char *selectors, const char **choices)
+{
+ while (*selectors != '\0')
+ {
+ bool match = false;
+ for (int i = 0; !match && choices[i]; i++)
+ match = !strcmp (selectors, choices[i]);
+ if (!match)
+ return false;
+ selectors += strlen (selectors) + 1;
+ }
+ return true;
+}
+
+/* Here we can only have one possible match and it must be
+ the only selector provided. */
+static bool
+gomp_match_selector (const char *selectors, const char *choice)
+{
+ if (!strcmp (selectors, choice))
+ return false;
+ if (*(selectors + strlen (selectors) + 1) != '\0')
+ return false;
+ return true;
+}
+
+#define CHECK_ISA(major, minor) \
+ if (device->compute_major >= major \
+ && device->compute_minor >= minor \
+ && gomp_match_selector (isa, "sm_"#major#minor)) \
+ return true
+
+bool
+GOMP_OFFLOAD_evaluate_device (int device_num, const char *kind,
+ const char *arch, const char *isa)
+{
+ static const char *kind_choices[] = { "gpu", "nohost", NULL };
+ static const char *arch_choices[] = { "nvptx", NULL };
+ if (kind && !gomp_match_selectors (kind, kind_choices))
+ return false;
+
+ if (arch && !gomp_match_selectors (arch, arch_choices))
+ return false;
+
+ if (!isa)
+ return true;
+
+ struct ptx_device *device = ptx_devices[device_num];
+
+ CHECK_ISA (3, 0);
+ CHECK_ISA (3, 5);
+ CHECK_ISA (3, 7);
+ CHECK_ISA (5, 0);
+ CHECK_ISA (5, 2);
+ CHECK_ISA (5, 3);
+ CHECK_ISA (6, 0);
+ CHECK_ISA (6, 1);
+ CHECK_ISA (6, 2);
+ CHECK_ISA (7, 0);
+ CHECK_ISA (7, 2);
+ CHECK_ISA (7, 5);
+ CHECK_ISA (8, 0);
+ CHECK_ISA (8, 6);
+
+ return false;
+}
diff --git a/libgomp/selector.c b/libgomp/selector.c
new file mode 100644
index 00000000000..5b21e582844
--- /dev/null
+++ b/libgomp/selector.c
@@ -0,0 +1,64 @@
+/* Copyright (C) 2022 Free Software Foundation, Inc.
+ Contributed by Mentor, a Siemens Business.
+
+ This file is part of the GNU Offloading and Multi Processing Library
+ (libgomp).
+
+ Libgomp is free software; you can redistribute it and/or modify it
+ under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 3, or (at your option)
+ any later version.
+
+ Libgomp is distributed in the hope that it will be useful, but WITHOUT ANY
+ WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+ FOR A PARTICULAR PURPOSE. See the GNU General Public License for
+ more details.
+
+ Under Section 7 of GPL version 3, you are granted additional
+ permissions described in the GCC Runtime Library Exception, version
+ 3.1, as published by the Free Software Foundation.
+
+ You should have received a copy of the GNU General Public License and
+ a copy of the GCC Runtime Library Exception along with this program;
+ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+ <http://www.gnu.org/licenses/>. */
+
+/* This file contains a placeholder implementation of
+ GOMP_evaluate_current_device. */
+
+#include "libgomp.h"
+
+/* The selectors are passed as strings, but are actually sets of multiple
+ trait property names, separated by '\0' and with an extra '\0' at
+ the end. Match such a string SELECTORS against an array of strings
+ CHOICES, that is terminated by a null pointer.
+ matches. */
+static bool
+gomp_match_selectors (const char *selectors, const char **choices)
+{
+ while (*selectors != '\0')
+ {
+ bool match = false;
+ for (int i = 0; !match && choices[i]; i++)
+ match = !strcmp (selectors, choices[i]);
+ if (!match)
+ return false;
+ selectors += strlen (selectors) + 1;
+ }
+ return true;
+}
+
+bool
+GOMP_evaluate_current_device (const char *kind, const char *arch,
+ const char *isa)
+{
+ static const char *kind_choices[] = { "cpu", "host", NULL };
+
+ if (kind && !gomp_match_selectors (kind, kind_choices))
+ return false;
+
+ if (arch || isa)
+ return false;
+
+ return true;
+}
diff --git a/libgomp/target.c b/libgomp/target.c
index 5ec19ae489e..02973ee2f40 100644
--- a/libgomp/target.c
+++ b/libgomp/target.c
@@ -5092,6 +5092,45 @@ omp_pause_resource_all (omp_pause_resource_t kind)
ialias (omp_pause_resource)
ialias (omp_pause_resource_all)
+bool
+GOMP_evaluate_target_device (int device_num, const char *kind,
+ const char *arch, const char *isa)
+{
+ bool result = true;
+
+ /* -2 is a magic number to indicate the device number was not specified;
+ in that case it's supposed to use the default device. */
+ if (device_num == -2)
+ device_num = omp_get_default_device ();
+
+ if (kind && strcmp (kind, "any") == 0)
+ kind = NULL;
+
+ gomp_debug (1, "%s: device_num = %u, kind=%s, arch=%s, isa=%s",
+ __FUNCTION__, device_num, kind, arch, isa);
+
+ if (omp_get_device_num () == device_num)
+ result = GOMP_evaluate_current_device (kind, arch, isa);
+ else
+ {
+ if (!omp_is_initial_device ())
+ /* Accelerators are not expected to know about other devices. */
+ result = false;
+ else
+ {
+ struct gomp_device_descr *device = resolve_device (device_num, true);
+ if (device == NULL)
+ result = false;
+ else if (device->evaluate_device_func)
+ result = device->evaluate_device_func (device_num, kind, arch,
+ isa);
+ }
+ }
+
+ gomp_debug (1, " -> %s\n", result ? "true" : "false");
+ return result;
+}
+
#ifdef PLUGIN_SUPPORT
/* This function tries to load a plugin for DEVICE. Name of plugin is passed
@@ -5144,6 +5183,7 @@ gomp_load_plugin_for_device (struct gomp_device_descr *device,
DLSYM (free);
DLSYM (dev2host);
DLSYM (host2dev);
+ DLSYM (evaluate_device);
DLSYM_OPT (memcpy2d, memcpy2d);
DLSYM_OPT (memcpy3d, memcpy3d);
device->capabilities = device->get_caps_func ();
--
2.25.1
^ permalink raw reply [flat|nested] 13+ messages in thread
* [PATCH 04/12] OpenMP: C front end support for metadirectives
2024-05-04 21:21 [PATCH 00/12] OpenMP: Metadirective support + "declare variant" improvements Sandra Loosemore
` (2 preceding siblings ...)
2024-05-04 21:21 ` [PATCH 03/12] libgomp: runtime support for target_device selector Sandra Loosemore
@ 2024-05-04 21:21 ` Sandra Loosemore
2024-05-04 21:21 ` [PATCH 05/12] OpenMP: C++ front-end " Sandra Loosemore
` (7 subsequent siblings)
11 siblings, 0 replies; 13+ messages in thread
From: Sandra Loosemore @ 2024-05-04 21:21 UTC (permalink / raw)
To: gcc-patches; +Cc: jakub, tburnus
This patch adds support to the C front end to parse OpenMP metadirective
constructs. It includes support for early parse-time resolution
of metadirectives (when possible) that will also be used by the C++ front
end.
Additional common C/C++ testcases are in a later patch in the series.
gcc/c-family/ChangeLog
* c-common.h (enum c_omp_directive_kind): Add C_OMP_DIR_META.
(c_omp_expand_metadirective): Declare.
* c-gimplify.cc: Include omp-general.h.
(genericize_omp_metadirective_stmt): New.
(c_genericize_control_stmt): Call it.
* c-omp.cc (c_omp_directives): Add "metadirective" and fix
commented-out stubs for the begin/end form.
(c_omp_expand_metadirective_r): New.
(c_omp_expand_metadirective): New.
* c-pragma.cc (omp_pragmas): Add "metadirective".
* c-pragma.h (enum pragma_kind): Add PRAGMA_OMP_METADIRECTIVE.
gcc/c/ChangeLog
* c-parser.cc (struct c_parser): Add new fields for metadirectives.
(c_parser_skip_to_end_of_block_or_statement): Add metadirective_p
parameter; use it to control brace and parentheses behavior.
(mangle_metadirective_region_label): New.
(c_parser_label, c_parser_statement_after_labels): Use it.
(c_parser_pragma): Handle metadirective.
(c_parser_omp_context_selector): Add metadirective_p flag, use it
to gate support for non-constant user condition.
(c_parser_omp_context_selector_specification): Add metadirective_p
argument.
(c_parser_finish_omp_declare_variant): Adjust call to above.
(analyze_metadirective_body): New.
(c_parser_omp_metadirective): New.
gcc/testsuite/ChangeLog
* gcc.dg/gomp/metadirective-1.c: New.
Co-Authored-By: Kwok Cheung Yeung <kcy@codesourcery.com>
Co-Authored-By: Sandra Loosemore <sandra@codesourcery.com>
---
gcc/c-family/c-common.h | 4 +-
gcc/c-family/c-gimplify.cc | 27 ++
gcc/c-family/c-omp.cc | 60 ++-
gcc/c-family/c-pragma.cc | 1 +
gcc/c-family/c-pragma.h | 1 +
gcc/c/c-parser.cc | 489 +++++++++++++++++++-
gcc/testsuite/gcc.dg/gomp/metadirective-1.c | 15 +
7 files changed, 577 insertions(+), 20 deletions(-)
create mode 100644 gcc/testsuite/gcc.dg/gomp/metadirective-1.c
diff --git a/gcc/c-family/c-common.h b/gcc/c-family/c-common.h
index 2d5f5399885..03f62571531 100644
--- a/gcc/c-family/c-common.h
+++ b/gcc/c-family/c-common.h
@@ -1391,7 +1391,8 @@ enum c_omp_directive_kind {
C_OMP_DIR_CONSTRUCT,
C_OMP_DIR_DECLARATIVE,
C_OMP_DIR_UTILITY,
- C_OMP_DIR_INFORMATIONAL
+ C_OMP_DIR_INFORMATIONAL,
+ C_OMP_DIR_META
};
struct c_omp_directive {
@@ -1405,6 +1406,7 @@ extern const struct c_omp_directive c_omp_directives[];
extern const struct c_omp_directive *c_omp_categorize_directive (const char *,
const char *,
const char *);
+extern tree c_omp_expand_metadirective (vec<struct omp_variant> &);
/* Return next tree in the chain for chain_next walking of tree nodes. */
inline tree
diff --git a/gcc/c-family/c-gimplify.cc b/gcc/c-family/c-gimplify.cc
index 494da49791d..c53aca60bcf 100644
--- a/gcc/c-family/c-gimplify.cc
+++ b/gcc/c-family/c-gimplify.cc
@@ -43,6 +43,7 @@ along with GCC; see the file COPYING3. If not see
#include "context.h"
#include "tree-pass.h"
#include "internal-fn.h"
+#include "omp-general.h"
/* The gimplification pass converts the language-dependent trees
(ld-trees) emitted by the parser into language-independent trees
@@ -485,6 +486,27 @@ genericize_omp_for_stmt (tree *stmt_p, int *walk_subtrees, void *data,
finish_bc_block (&OMP_FOR_BODY (stmt), bc_continue, clab);
}
+/* Genericize a OMP_METADIRECTIVE node *STMT_P. */
+
+static void
+genericize_omp_metadirective_stmt (tree *stmt_p, int *walk_subtrees,
+ void *data, walk_tree_fn func,
+ walk_tree_lh lh)
+{
+ tree stmt = *stmt_p;
+
+ for (tree variant = OMP_METADIRECTIVE_VARIANTS (stmt);
+ variant != NULL_TREE;
+ variant = TREE_CHAIN (variant))
+ {
+ walk_tree_1 (&OMP_METADIRECTIVE_VARIANT_DIRECTIVE (variant),
+ func, data, NULL, lh);
+ walk_tree_1 (&OMP_METADIRECTIVE_VARIANT_BODY (variant),
+ func, data, NULL, lh);
+ }
+
+ *walk_subtrees = 0;
+}
/* Lower structured control flow tree nodes, such as loops. The
STMT_P, WALK_SUBTREES, and DATA arguments are as for the walk_tree_fn
@@ -533,6 +555,11 @@ c_genericize_control_stmt (tree *stmt_p, int *walk_subtrees, void *data,
genericize_omp_for_stmt (stmt_p, walk_subtrees, data, func, lh);
break;
+ case OMP_METADIRECTIVE:
+ genericize_omp_metadirective_stmt (stmt_p, walk_subtrees, data, func,
+ lh);
+ break;
+
case STATEMENT_LIST:
if (TREE_SIDE_EFFECTS (stmt))
{
diff --git a/gcc/c-family/c-omp.cc b/gcc/c-family/c-omp.cc
index c0e02aa422f..9426c0af2ce 100644
--- a/gcc/c-family/c-omp.cc
+++ b/gcc/c-family/c-omp.cc
@@ -4177,7 +4177,7 @@ const struct c_omp_directive c_omp_directives[] = {
/* { "begin", "declare", "variant", PRAGMA_OMP_BEGIN,
C_OMP_DIR_DECLARATIVE, false }, */
/* { "begin", "metadirective", nullptr, PRAGMA_OMP_BEGIN,
- C_OMP_DIR_???, ??? }, */
+ C_OMP_DIR_META, false }, */
{ "cancel", nullptr, nullptr, PRAGMA_OMP_CANCEL,
C_OMP_DIR_STANDALONE, false },
{ "cancellation", "point", nullptr, PRAGMA_OMP_CANCELLATION_POINT,
@@ -4207,7 +4207,7 @@ const struct c_omp_directive c_omp_directives[] = {
/* { "end", "declare", "variant", PRAGMA_OMP_END,
C_OMP_DIR_DECLARATIVE, false }, */
/* { "end", "metadirective", nullptr, PRAGMA_OMP_END,
- C_OMP_DIR_???, ??? }, */
+ C_OMP_DIR_META, false }, */
/* error with at(execution) is C_OMP_DIR_STANDALONE. */
{ "error", nullptr, nullptr, PRAGMA_OMP_ERROR,
C_OMP_DIR_UTILITY, false },
@@ -4225,8 +4225,8 @@ const struct c_omp_directive c_omp_directives[] = {
C_OMP_DIR_CONSTRUCT, true },
{ "master", nullptr, nullptr, PRAGMA_OMP_MASTER,
C_OMP_DIR_CONSTRUCT, true },
- /* { "metadirective", nullptr, nullptr, PRAGMA_OMP_METADIRECTIVE,
- C_OMP_DIR_???, ??? }, */
+ { "metadirective", nullptr, nullptr, PRAGMA_OMP_METADIRECTIVE,
+ C_OMP_DIR_META, false },
{ "nothing", nullptr, nullptr, PRAGMA_OMP_NOTHING,
C_OMP_DIR_UTILITY, false },
/* ordered with depend clause is C_OMP_DIR_STANDALONE. */
@@ -4309,3 +4309,55 @@ c_omp_categorize_directive (const char *first, const char *second,
}
return NULL;
}
+
+/* Auxilliary helper function for c_omp_expand_metadirective. */
+
+static tree
+c_omp_expand_metadirective_r (vec<struct omp_variant> &candidates,
+ hash_map<tree, tree> &body_labels,
+ unsigned index)
+{
+ struct omp_variant &candidate = candidates[index];
+ tree if_block = push_stmt_list ();
+ if (candidate.alternative != NULL_TREE)
+ add_stmt (candidate.alternative);
+ if (candidate.body != NULL_TREE)
+ {
+ tree *label = body_labels.get (candidate.body);
+ if (label != NULL)
+ add_stmt (build1 (GOTO_EXPR, void_type_node, *label));
+ else
+ {
+ tree body_label = create_artificial_label (UNKNOWN_LOCATION);
+ add_stmt (build1 (LABEL_EXPR, void_type_node, body_label));
+ add_stmt (candidate.body);
+ body_labels.put (candidate.body, body_label);
+ }
+ }
+ if_block = pop_stmt_list (if_block);
+
+ if (index == candidates.length () - 1)
+ return if_block;
+
+ tree cond = candidate.dynamic_selector;
+ gcc_assert (cond != NULL_TREE);
+
+ tree else_block = c_omp_expand_metadirective_r (candidates, body_labels,
+ index + 1);
+ tree ret = push_stmt_list ();
+ tree stmt = build3 (COND_EXPR, void_type_node, cond, if_block, else_block);
+ add_stmt (stmt);
+ ret = pop_stmt_list (ret);
+
+ return ret;
+}
+
+/* Resolve the vector of metadirective variant CANDIDATES to a parse tree
+ structure. */
+
+tree
+c_omp_expand_metadirective (vec<struct omp_variant> &candidates)
+{
+ hash_map<tree, tree> body_labels;
+ return c_omp_expand_metadirective_r (candidates, body_labels, 0);
+}
diff --git a/gcc/c-family/c-pragma.cc b/gcc/c-family/c-pragma.cc
index 1237ee6e62b..8488a4d1142 100644
--- a/gcc/c-family/c-pragma.cc
+++ b/gcc/c-family/c-pragma.cc
@@ -1529,6 +1529,7 @@ static const struct omp_pragma_def omp_pragmas[] = {
{ "error", PRAGMA_OMP_ERROR },
{ "end", PRAGMA_OMP_END },
{ "flush", PRAGMA_OMP_FLUSH },
+ { "metadirective", PRAGMA_OMP_METADIRECTIVE },
{ "nothing", PRAGMA_OMP_NOTHING },
{ "requires", PRAGMA_OMP_REQUIRES },
{ "scope", PRAGMA_OMP_SCOPE },
diff --git a/gcc/c-family/c-pragma.h b/gcc/c-family/c-pragma.h
index ce93a52fa57..f933755ea44 100644
--- a/gcc/c-family/c-pragma.h
+++ b/gcc/c-family/c-pragma.h
@@ -64,6 +64,7 @@ enum pragma_kind {
PRAGMA_OMP_NOTHING,
PRAGMA_OMP_MASKED,
PRAGMA_OMP_MASTER,
+ PRAGMA_OMP_METADIRECTIVE,
PRAGMA_OMP_ORDERED,
PRAGMA_OMP_PARALLEL,
PRAGMA_OMP_REQUIRES,
diff --git a/gcc/c/c-parser.cc b/gcc/c/c-parser.cc
index 41e8c923fcd..e6546bcb32b 100644
--- a/gcc/c/c-parser.cc
+++ b/gcc/c/c-parser.cc
@@ -266,6 +266,13 @@ struct GTY(()) c_parser {
/* Set for omp::decl attribute parsing to the decl to which it
appertains. */
tree in_omp_decl_attribute;
+
+ /* Set if we are processing a statement body associated with a
+ metadirective variant. */
+ BOOL_BITFIELD in_metadirective_body : 1;
+
+ vec<tree> * GTY((skip)) metadirective_body_labels;
+ unsigned int metadirective_region_num;
};
/* Return a pointer to the Nth token in PARSERs tokens_buf. */
@@ -1437,9 +1444,11 @@ c_parser_skip_to_pragma_eol (c_parser *parser, bool error_if_not_eol = true)
have consumed a non-nested ';'. */
static void
-c_parser_skip_to_end_of_block_or_statement (c_parser *parser)
+c_parser_skip_to_end_of_block_or_statement (c_parser *parser,
+ bool metadirective_p = false)
{
unsigned nesting_depth = 0;
+ int bracket_depth = 0;
bool save_error = parser->error;
while (true)
@@ -1462,7 +1471,7 @@ c_parser_skip_to_end_of_block_or_statement (c_parser *parser)
case CPP_SEMICOLON:
/* If the next token is a ';', we have reached the
end of the statement. */
- if (!nesting_depth)
+ if (!nesting_depth && (!metadirective_p || bracket_depth <= 0))
{
/* Consume the ';'. */
c_parser_consume_token (parser);
@@ -1473,7 +1482,8 @@ c_parser_skip_to_end_of_block_or_statement (c_parser *parser)
case CPP_CLOSE_BRACE:
/* If the next token is a non-nested '}', then we have
reached the end of the current block. */
- if (nesting_depth == 0 || --nesting_depth == 0)
+ if ((nesting_depth == 0 || --nesting_depth == 0)
+ && (!metadirective_p || bracket_depth <= 0))
{
c_parser_consume_token (parser);
goto finished;
@@ -1486,6 +1496,19 @@ c_parser_skip_to_end_of_block_or_statement (c_parser *parser)
++nesting_depth;
break;
+ case CPP_OPEN_PAREN:
+ /* Track parentheses in case the statement is a standalone 'for'
+ statement - we want to skip over the semicolons separating the
+ operands. */
+ if (metadirective_p && nesting_depth == 0)
+ ++bracket_depth;
+ break;
+
+ case CPP_CLOSE_PAREN:
+ if (metadirective_p && nesting_depth == 0)
+ --bracket_depth;
+ break;
+
case CPP_PRAGMA:
/* If we see a pragma, consume the whole thing at once. We
have some safeguards against consuming pragmas willy-nilly.
@@ -1718,6 +1741,7 @@ static void c_parser_omp_taskwait (c_parser *);
static void c_parser_omp_taskyield (c_parser *);
static void c_parser_omp_cancel (c_parser *);
static void c_parser_omp_nothing (c_parser *);
+static void c_parser_omp_metadirective (c_parser *, bool *);
enum pragma_context { pragma_external, pragma_struct, pragma_param,
pragma_stmt, pragma_compound };
@@ -7317,6 +7341,18 @@ c_parser_all_labels (c_parser *parser)
c_parser_error (parser, "expected statement");
}
+
+/* Helper function for c_parser_label: mangle a metadirective region
+ label NAME. */
+static tree
+mangle_metadirective_region_label (c_parser *parser, tree name)
+{
+ const char *old_name = IDENTIFIER_POINTER (name);
+ char *new_name = (char *) alloca (strlen (old_name) + 32);
+ sprintf (new_name, "%s_MDR%u", old_name, parser->metadirective_region_num);
+ return get_identifier (new_name);
+}
+
/* Parse a label (C90 6.6.1, C99 6.8.1, C11 6.8.1).
label:
@@ -7388,6 +7424,9 @@ c_parser_label (c_parser *parser, tree std_attrs)
gcc_assert (c_parser_next_token_is (parser, CPP_COLON));
c_parser_consume_token (parser);
attrs = c_parser_gnu_attributes (parser);
+ if (parser->in_metadirective_body
+ && parser->metadirective_body_labels->contains (name))
+ name = mangle_metadirective_region_label (parser, name);
tlab = define_label (loc2, name);
if (tlab)
{
@@ -7615,8 +7654,11 @@ c_parser_statement_after_labels (c_parser *parser, bool *if_p,
c_parser_consume_token (parser);
if (c_parser_next_token_is (parser, CPP_NAME))
{
- stmt = c_finish_goto_label (loc,
- c_parser_peek_token (parser)->value);
+ tree name = c_parser_peek_token (parser)->value;
+ if (parser->in_metadirective_body
+ && parser->metadirective_body_labels->contains (name))
+ name = mangle_metadirective_region_label (parser, name);
+ stmt = c_finish_goto_label (loc, name);
c_parser_consume_token (parser);
}
else if (c_parser_next_token_is (parser, CPP_MULT))
@@ -14666,6 +14708,10 @@ c_parser_pragma (c_parser *parser, enum pragma_context context, bool *if_p)
c_parser_omp_nothing (parser);
return false;
+ case PRAGMA_OMP_METADIRECTIVE:
+ c_parser_omp_metadirective (parser, if_p);
+ return true;
+
case PRAGMA_OMP_ERROR:
return c_parser_omp_error (parser, context);
@@ -24589,7 +24635,7 @@ c_parser_omp_declare_simd (c_parser *parser, enum pragma_context context)
static tree
c_parser_omp_context_selector (c_parser *parser, enum omp_tss_code set,
- tree parms)
+ tree parms, bool metadirective_p)
{
tree ret = NULL_TREE;
do
@@ -24736,12 +24782,18 @@ c_parser_omp_context_selector (c_parser *parser, enum omp_tss_code set,
{
mark_exp_read (t);
t = c_fully_fold (t, false, NULL);
- /* FIXME: this is bogus, both device_num and
- condition selectors allow arbitrary expressions. */
- if (!INTEGRAL_TYPE_P (TREE_TYPE (t))
- || !tree_fits_shwi_p (t))
- error_at (token->location, "property must be "
- "constant integer expression");
+ /* FIXME: I believe it is an unimplemented feature rather
+ than a user error to have non-constant expressions
+ inside "declare variant". */
+ if (!metadirective_p
+ && (!INTEGRAL_TYPE_P (TREE_TYPE (t))
+ || !tree_fits_shwi_p (t)))
+ error_at (token->location,
+ "property must be constant integer expression");
+ else if (metadirective_p
+ && !INTEGRAL_TYPE_P (TREE_TYPE (t)))
+ error_at (token->location,
+ "property must be integer expression");
else
properties = make_trait_property (NULL_TREE, t,
properties);
@@ -24822,7 +24874,8 @@ c_parser_omp_context_selector (c_parser *parser, enum omp_tss_code set,
user */
static tree
-c_parser_omp_context_selector_specification (c_parser *parser, tree parms)
+c_parser_omp_context_selector_specification (c_parser *parser, tree parms,
+ bool metadirective_p)
{
tree ret = NULL_TREE;
do
@@ -24847,7 +24900,8 @@ c_parser_omp_context_selector_specification (c_parser *parser, tree parms)
if (!braces.require_open (parser))
return error_mark_node;
- tree selectors = c_parser_omp_context_selector (parser, set, parms);
+ tree selectors = c_parser_omp_context_selector (parser, set, parms,
+ metadirective_p);
if (selectors == error_mark_node)
ret = error_mark_node;
else if (ret != error_mark_node)
@@ -24923,7 +24977,8 @@ c_finish_omp_declare_variant (c_parser *parser, tree fndecl, tree parms)
if (parms == NULL_TREE)
parms = error_mark_node;
- tree ctx = c_parser_omp_context_selector_specification (parser, parms);
+ tree ctx = c_parser_omp_context_selector_specification (parser,
+ parms, false);
if (ctx == error_mark_node)
goto fail;
ctx = omp_check_context_selector (match_loc, ctx, false);
@@ -26494,6 +26549,410 @@ c_parser_omp_assumes (c_parser *parser)
c_parser_omp_assumption_clauses (parser, false);
}
+/* Helper function for c_parser_omp_metadirective. */
+
+static void
+analyze_metadirective_body (c_parser *parser,
+ vec<c_token> &tokens,
+ vec<tree> &labels)
+{
+ int nesting_depth = 0;
+ int bracket_depth = 0;
+ bool ignore_label = false;
+
+ /* Read in the body tokens to the tokens for each candidate directive. */
+ while (1)
+ {
+ c_token *token = c_parser_peek_token (parser);
+ bool stop = false;
+
+ if (c_parser_next_token_is_keyword (parser, RID_CASE))
+ ignore_label = true;
+
+ switch (token->type)
+ {
+ case CPP_EOF:
+ break;
+ case CPP_NAME:
+ if (!ignore_label
+ && c_parser_peek_2nd_token (parser)->type == CPP_COLON)
+ labels.safe_push (token->value);
+ goto add;
+ case CPP_OPEN_BRACE:
+ ++nesting_depth;
+ goto add;
+ case CPP_CLOSE_BRACE:
+ if (--nesting_depth == 0 && bracket_depth == 0)
+ stop = true;
+ goto add;
+ case CPP_OPEN_PAREN:
+ ++bracket_depth;
+ goto add;
+ case CPP_CLOSE_PAREN:
+ --bracket_depth;
+ goto add;
+ case CPP_COLON:
+ ignore_label = false;
+ goto add;
+ case CPP_SEMICOLON:
+ if (nesting_depth == 0 && bracket_depth == 0)
+ stop = true;
+ goto add;
+ default:
+ add:
+ tokens.safe_push (*token);
+ if (token->type == CPP_PRAGMA)
+ c_parser_consume_pragma (parser);
+ else if (token->type == CPP_PRAGMA_EOL)
+ c_parser_skip_to_pragma_eol (parser);
+ else
+ c_parser_consume_token (parser);
+ if (stop)
+ break;
+ continue;
+ }
+ break;
+ }
+}
+
+/* OpenMP 5.0:
+
+ # pragma omp metadirective [clause[, clause]]
+*/
+
+static void
+c_parser_omp_metadirective (c_parser *parser, bool *if_p)
+{
+ static unsigned int metadirective_region_count = 0;
+
+ tree ret;
+ auto_vec<c_token> directive_tokens;
+ auto_vec<c_token> body_tokens;
+ auto_vec<tree> body_labels;
+ auto_vec<const struct c_omp_directive *> directives;
+ auto_vec<tree> ctxs;
+ vec<struct omp_variant> candidates;
+ bool default_seen = false;
+ int directive_token_idx = 0;
+ tree standalone_body = NULL_TREE;
+ location_t pragma_loc = c_parser_peek_token (parser)->location;
+ bool requires_body = false;
+
+ ret = make_node (OMP_METADIRECTIVE);
+ SET_EXPR_LOCATION (ret, pragma_loc);
+ TREE_TYPE (ret) = void_type_node;
+ OMP_METADIRECTIVE_VARIANTS (ret) = NULL_TREE;
+
+ c_parser_consume_pragma (parser);
+ while (c_parser_next_token_is_not (parser, CPP_PRAGMA_EOL))
+ {
+ if (c_parser_next_token_is_not (parser, CPP_NAME)
+ && c_parser_next_token_is_not (parser, CPP_KEYWORD))
+ {
+ c_parser_error (parser, "expected %<when%>, "
+ "%<otherwise%>, or %<default%> clause");
+ goto error;
+ }
+
+ location_t match_loc = c_parser_peek_token (parser)->location;
+ const char *p = IDENTIFIER_POINTER (c_parser_peek_token (parser)->value);
+ c_parser_consume_token (parser);
+ bool default_p
+ = strcmp (p, "default") == 0 || strcmp (p, "otherwise") == 0;
+ if (default_p)
+ {
+ if (default_seen)
+ {
+ error_at (match_loc, "too many %<otherwise%> or %<default%> "
+ "clauses in %<metadirective%>");
+ c_parser_skip_to_end_of_block_or_statement (parser, true);
+ goto error;
+ }
+ default_seen = true;
+ }
+ if (!(strcmp (p, "when") == 0 || default_p))
+ {
+ error_at (match_loc, "%qs is not valid for %qs",
+ p, "metadirective");
+ c_parser_skip_to_end_of_block_or_statement (parser, true);
+ goto error;
+ }
+
+ matching_parens parens;
+ tree ctx = NULL_TREE;
+ bool skip = false;
+
+ if (!parens.require_open (parser))
+ goto error;
+
+ if (!default_p)
+ {
+ ctx = c_parser_omp_context_selector_specification (parser,
+ NULL_TREE, true);
+ if (ctx == error_mark_node)
+ goto error;
+ ctx = omp_check_context_selector (match_loc, ctx, true);
+ if (ctx == error_mark_node)
+ goto error;
+
+ /* Remove the selector from further consideration if can be
+ evaluated as a non-match at this point. */
+ skip = omp_context_selector_matches (ctx, true, true) == 0;
+
+ if (c_parser_next_token_is_not (parser, CPP_COLON))
+ {
+ c_parser_require (parser, CPP_COLON, "expected %<:%>");
+ goto error;
+ }
+ c_parser_consume_token (parser);
+ }
+
+ /* Read in the directive type and create a dummy pragma token for
+ it. */
+ location_t loc = c_parser_peek_token (parser)->location;
+
+ const char *directive[3] = {};
+ int i;
+ for (i = 0; i < 3; i++)
+ {
+ tree id;
+ if (c_parser_peek_nth_token (parser, i + 1)->type
+ == CPP_CLOSE_PAREN)
+ {
+ if (i == 0)
+ directive[i++] = "nothing";
+ break;
+ }
+ else if (c_parser_peek_nth_token (parser, i + 1)->type
+ == CPP_NAME)
+ id = c_parser_peek_nth_token (parser, i + 1)->value;
+ else if (c_parser_peek_nth_token (parser, i + 1)->keyword
+ != RID_MAX)
+ {
+ enum rid rid
+ = c_parser_peek_nth_token (parser, i + 1)->keyword;
+ id = ridpointers[rid];
+ }
+ else
+ break;
+
+ directive[i] = IDENTIFIER_POINTER (id);
+ }
+ if (i == 0)
+ {
+ error_at (loc, "expected directive name");
+ c_parser_skip_to_end_of_block_or_statement (parser, true);
+ goto error;
+ }
+
+ const struct c_omp_directive *omp_directive
+ = c_omp_categorize_directive (directive[0],
+ directive[1],
+ directive[2]);
+
+ if (omp_directive == NULL)
+ {
+ for (int j = 0; j < i; j++)
+ c_parser_consume_token (parser);
+ c_parser_error (parser, "unknown directive name");
+ goto error;
+ }
+ else
+ {
+ int token_count = 0;
+ if (omp_directive->first) token_count++;
+ if (omp_directive->second) token_count++;
+ if (omp_directive->third) token_count++;
+ for (int j = 0; j < token_count; j++)
+ c_parser_consume_token (parser);
+ }
+ if (omp_directive->id == PRAGMA_OMP_METADIRECTIVE)
+ {
+ c_parser_error (parser,
+ "metadirectives cannot be used as variants of a "
+ "%<metadirective%>");
+ goto error;
+ }
+ if (omp_directive->kind == C_OMP_DIR_DECLARATIVE)
+ {
+ sorry_at (loc, "declarative directive variants of a "
+ "%<metadirective%> are not supported");
+ goto error;
+ }
+ if (omp_directive->kind == C_OMP_DIR_CONSTRUCT)
+ requires_body = true;
+
+ if (!skip)
+ {
+ c_token pragma_token;
+ pragma_token.type = CPP_PRAGMA;
+ pragma_token.location = loc;
+ pragma_token.pragma_kind = (enum pragma_kind) omp_directive->id;
+
+ directives.safe_push (omp_directive);
+ directive_tokens.safe_push (pragma_token);
+ ctxs.safe_push (ctx);
+ }
+
+ /* Read in tokens for the directive clauses. */
+ int nesting_depth = 0;
+ while (1)
+ {
+ c_token *token = c_parser_peek_token (parser);
+ switch (token->type)
+ {
+ case CPP_EOF:
+ case CPP_PRAGMA_EOL:
+ break;
+ case CPP_OPEN_PAREN:
+ ++nesting_depth;
+ goto add;
+ case CPP_CLOSE_PAREN:
+ if (nesting_depth-- == 0)
+ break;
+ goto add;
+ default:
+ add:
+ if (!skip)
+ directive_tokens.safe_push (*token);
+ c_parser_consume_token (parser);
+ continue;
+ }
+ break;
+ }
+
+ c_parser_consume_token (parser);
+
+ if (!skip)
+ {
+ c_token eol_token;
+ memset (&eol_token, 0, sizeof (eol_token));
+ eol_token.type = CPP_PRAGMA_EOL;
+ directive_tokens.safe_push (eol_token);
+ }
+ }
+ c_parser_skip_to_pragma_eol (parser);
+
+ if (!default_seen)
+ {
+ /* Add a default clause that evaluates to 'omp nothing'. */
+ const struct c_omp_directive *omp_directive
+ = c_omp_categorize_directive ("nothing", NULL, NULL);
+
+ c_token pragma_token;
+ pragma_token.type = CPP_PRAGMA;
+ pragma_token.location = UNKNOWN_LOCATION;
+ pragma_token.pragma_kind = PRAGMA_OMP_NOTHING;
+
+ directives.safe_push (omp_directive);
+ directive_tokens.safe_push (pragma_token);
+ ctxs.safe_push (NULL_TREE);
+
+ c_token eol_token;
+ memset (&eol_token, 0, sizeof (eol_token));
+ eol_token.type = CPP_PRAGMA_EOL;
+ directive_tokens.safe_push (eol_token);
+ }
+
+ if (requires_body)
+ analyze_metadirective_body (parser, body_tokens, body_labels);
+
+ /* Process each candidate directive. */
+ unsigned i;
+ tree ctx;
+
+ FOR_EACH_VEC_ELT (ctxs, i, ctx)
+ {
+ auto_vec<c_token> tokens;
+
+ /* Add the directive tokens. */
+ do
+ tokens.safe_push (directive_tokens [directive_token_idx++]);
+ while (tokens.last ().type != CPP_PRAGMA_EOL);
+
+ /* Add the body tokens. */
+ gcc_assert (requires_body || body_tokens.is_empty ());
+ for (unsigned j = 0; j < body_tokens.length (); j++)
+ tokens.safe_push (body_tokens[j]);
+
+ /* Make sure nothing tries to read past the end of the tokens. */
+ c_token eof_token;
+ memset (&eof_token, 0, sizeof (eof_token));
+ eof_token.type = CPP_EOF;
+ tokens.safe_push (eof_token);
+ tokens.safe_push (eof_token);
+
+ unsigned int old_tokens_avail = parser->tokens_avail;
+ c_token *old_tokens = parser->tokens;
+ bool old_in_metadirective_body = parser->in_metadirective_body;
+ vec<tree> *old_metadirective_body_labels
+ = parser->metadirective_body_labels;
+ unsigned int old_metadirective_region_num
+ = parser->metadirective_region_num;
+
+ parser->tokens = tokens.address ();
+ parser->tokens_avail = tokens.length ();
+ parser->in_metadirective_body = true;
+ parser->metadirective_body_labels = &body_labels;
+ parser->metadirective_region_num = ++metadirective_region_count;
+
+ int prev_errorcount = errorcount;
+ tree directive = c_begin_compound_stmt (true);
+
+ c_parser_pragma (parser, pragma_compound, if_p);
+ directive = c_end_compound_stmt (pragma_loc, directive, true);
+ bool standalone_p
+ = directives[i]->kind == C_OMP_DIR_STANDALONE
+ || directives[i]->kind == C_OMP_DIR_UTILITY;
+ if (standalone_p && requires_body)
+ {
+ /* Parsing standalone directives will not consume the body
+ tokens, so do that here. */
+ if (standalone_body == NULL_TREE)
+ {
+ standalone_body = push_stmt_list ();
+ c_parser_statement (parser, if_p);
+ standalone_body = pop_stmt_list (standalone_body);
+ }
+ else
+ c_parser_skip_to_end_of_block_or_statement (parser, true);
+ }
+
+ tree body = standalone_p ? standalone_body : NULL_TREE;
+ tree variant = make_omp_metadirective_variant (ctx, directive, body);
+ OMP_METADIRECTIVE_VARIANTS (ret)
+ = chainon (OMP_METADIRECTIVE_VARIANTS (ret), variant);
+
+ /* Check that all valid tokens have been consumed if no parse errors
+ encountered. */
+ if (errorcount == prev_errorcount)
+ {
+ gcc_assert (parser->tokens_avail == 2);
+ gcc_assert (c_parser_next_token_is (parser, CPP_EOF));
+ gcc_assert (c_parser_peek_2nd_token (parser)->type == CPP_EOF);
+ }
+
+ parser->tokens = old_tokens;
+ parser->tokens_avail = old_tokens_avail;
+ parser->in_metadirective_body = old_in_metadirective_body;
+ parser->metadirective_body_labels = old_metadirective_body_labels;
+ parser->metadirective_region_num = old_metadirective_region_num;
+ }
+
+ /* Try to resolve the metadirective early. */
+ candidates = omp_early_resolve_metadirective (ret);
+ if (!candidates.is_empty ())
+ ret = c_omp_expand_metadirective (candidates);
+
+ add_stmt (ret);
+ return;
+
+error:
+ if (parser->in_pragma)
+ c_parser_skip_to_pragma_eol (parser);
+ c_parser_skip_to_end_of_block_or_statement (parser, true);
+}
+
/* Main entry point to parsing most OpenMP pragmas. */
static void
diff --git a/gcc/testsuite/gcc.dg/gomp/metadirective-1.c b/gcc/testsuite/gcc.dg/gomp/metadirective-1.c
new file mode 100644
index 00000000000..2ac81bfde75
--- /dev/null
+++ b/gcc/testsuite/gcc.dg/gomp/metadirective-1.c
@@ -0,0 +1,15 @@
+int main (void)
+{
+ int x, y;
+
+ /* Test nested functions inside statement body. */
+ #pragma omp metadirective \
+ when (device={arch("nvptx")}: teams num_teams(512)) \
+ when (device={arch("gcn")}: teams num_teams(256)) \
+ default (teams num_teams(4))
+ {
+ int f (int x) { return x * 3; }
+
+ y = f (x);
+ }
+}
--
2.25.1
^ permalink raw reply [flat|nested] 13+ messages in thread
* [PATCH 05/12] OpenMP: C++ front-end support for metadirectives
2024-05-04 21:21 [PATCH 00/12] OpenMP: Metadirective support + "declare variant" improvements Sandra Loosemore
` (3 preceding siblings ...)
2024-05-04 21:21 ` [PATCH 04/12] OpenMP: C front end support for metadirectives Sandra Loosemore
@ 2024-05-04 21:21 ` Sandra Loosemore
2024-05-04 21:21 ` [PATCH 06/12] OpenMP: common c/c++ testcases " Sandra Loosemore
` (6 subsequent siblings)
11 siblings, 0 replies; 13+ messages in thread
From: Sandra Loosemore @ 2024-05-04 21:21 UTC (permalink / raw)
To: gcc-patches; +Cc: jakub, tburnus
This patch adds C++ support for metadirectives. It uses the
c-family support committed with the corresponding C front end patch
to do early parse-time metadirective resolution when possible.
Additional C/C++ common testcases are provided in a subsequent
patch in the series.
gcc/cp/ChangeLog
* parser.cc (cp_parser_skip_to_end_of_block_or_statement): Add
metadirective_p parameter, use it to control brace/parentheses
behavior for metadirectives.
(mangle_metadirective_region_label): New.
(cp_parser_label_for_labeled_statement): Use it.
(cp_parser_jump_statement): Likewise.
(cp_parser_omp_context_selector): Add metadirective_p
parameter, use it to control error behavior for non-constant exprs
properties.
(cp_parser_omp_context_selector_specification): Add metadirective_p
parameter, use it for cp_parser_omp_context_selector call.
(cp_finish_omp_declare_variant): Adjust call to
cp_parser_omp_context_selector_specification.
(analyze_metadirective_body): New.
(cp_parser_omp_metadirective): New.
(cp_parser_pragma): Handle PRAGMA_OMP_METADIRECTIVE.
* parser.h (struct cp_parser): Add fields for metadirective parsing
state.
* pt.cc (tsubst_omp_context_selector): New.
(tsubst_stmt): Handle OMP_METADIRECTIVE.
gcc/testsuite/ChangeLog
* g++.dg/gomp/attrs-metadirective-1.C: New.
* g++.dg/gomp/attrs-metadirective-2.C: New.
* g++.dg/gomp/attrs-metadirective-3.C: New.
* g++.dg/gomp/attrs-metadirective-4.C: New.
* g++.dg/gomp/attrs-metadirective-5.C: New.
* g++.dg/gomp/attrs-metadirective-6.C: New.
* g++.dg/gomp/attrs-metadirective-7.C: New.
* g++.dg/gomp/attrs-metadirective-8.C: New.
libgomp/ChangeLog
* testsuite/libgomp.c++/metadirective-template-1.C: New.
* testsuite/libgomp.c++/metadirective-template-2.C: New.
* testsuite/libgomp.c++/metadirective-template-3.C: New.
Co-Authored-By: Kwok Cheung Yeung <kcy@codesourcery.com>
Co-Authored-By: Sandra Loosemore <sandra@codesourcery.com>
---
gcc/cp/parser.cc | 524 +++++++++++++++++-
gcc/cp/parser.h | 7 +
gcc/cp/pt.cc | 119 ++++
.../g++.dg/gomp/attrs-metadirective-1.C | 40 ++
.../g++.dg/gomp/attrs-metadirective-2.C | 74 +++
.../g++.dg/gomp/attrs-metadirective-3.C | 31 ++
.../g++.dg/gomp/attrs-metadirective-4.C | 41 ++
.../g++.dg/gomp/attrs-metadirective-5.C | 24 +
.../g++.dg/gomp/attrs-metadirective-6.C | 31 ++
.../g++.dg/gomp/attrs-metadirective-7.C | 31 ++
.../g++.dg/gomp/attrs-metadirective-8.C | 16 +
.../libgomp.c++/metadirective-template-1.C | 37 ++
.../libgomp.c++/metadirective-template-2.C | 41 ++
.../libgomp.c++/metadirective-template-3.C | 41 ++
14 files changed, 1044 insertions(+), 13 deletions(-)
create mode 100644 gcc/testsuite/g++.dg/gomp/attrs-metadirective-1.C
create mode 100644 gcc/testsuite/g++.dg/gomp/attrs-metadirective-2.C
create mode 100644 gcc/testsuite/g++.dg/gomp/attrs-metadirective-3.C
create mode 100644 gcc/testsuite/g++.dg/gomp/attrs-metadirective-4.C
create mode 100644 gcc/testsuite/g++.dg/gomp/attrs-metadirective-5.C
create mode 100644 gcc/testsuite/g++.dg/gomp/attrs-metadirective-6.C
create mode 100644 gcc/testsuite/g++.dg/gomp/attrs-metadirective-7.C
create mode 100644 gcc/testsuite/g++.dg/gomp/attrs-metadirective-8.C
create mode 100644 libgomp/testsuite/libgomp.c++/metadirective-template-1.C
create mode 100644 libgomp/testsuite/libgomp.c++/metadirective-template-2.C
create mode 100644 libgomp/testsuite/libgomp.c++/metadirective-template-3.C
diff --git a/gcc/cp/parser.cc b/gcc/cp/parser.cc
index 8b819b2ebfd..4bb9b086095 100644
--- a/gcc/cp/parser.cc
+++ b/gcc/cp/parser.cc
@@ -3001,7 +3001,7 @@ static void cp_parser_skip_to_end_of_statement
static void cp_parser_consume_semicolon_at_end_of_statement
(cp_parser *);
static void cp_parser_skip_to_end_of_block_or_statement
- (cp_parser *);
+ (cp_parser *, bool = false);
static bool cp_parser_skip_to_closing_brace
(cp_parser *);
static bool cp_parser_skip_entire_template_parameter_list
@@ -4177,9 +4177,11 @@ cp_parser_consume_semicolon_at_end_of_statement (cp_parser *parser)
have consumed a non-nested `;'. */
static void
-cp_parser_skip_to_end_of_block_or_statement (cp_parser* parser)
+cp_parser_skip_to_end_of_block_or_statement (cp_parser* parser,
+ bool metadirective_p)
{
int nesting_depth = 0;
+ int bracket_depth = 0;
/* Unwind generic function template scope if necessary. */
if (parser->fully_implicit_function_template_p)
@@ -4201,7 +4203,7 @@ cp_parser_skip_to_end_of_block_or_statement (cp_parser* parser)
case CPP_SEMICOLON:
/* Stop if this is an unnested ';'. */
- if (!nesting_depth)
+ if (!nesting_depth && (!metadirective_p || bracket_depth <= 0))
nesting_depth = -1;
break;
@@ -4220,6 +4222,19 @@ cp_parser_skip_to_end_of_block_or_statement (cp_parser* parser)
nesting_depth++;
break;
+ case CPP_OPEN_PAREN:
+ /* Track parentheses in case the statement is a standalone 'for'
+ statement - we want to skip over the semicolons separating the
+ operands. */
+ if (metadirective_p && nesting_depth == 0)
+ bracket_depth++;
+ break;
+
+ case CPP_CLOSE_PAREN:
+ if (metadirective_p && nesting_depth == 0)
+ bracket_depth--;
+ break;
+
case CPP_KEYWORD:
if (!cp_token_is_module_directive (token))
break;
@@ -12999,6 +13014,18 @@ attr_chainon (tree attrs, tree attr)
return chainon (attrs, attr);
}
+
+/* Helper function for cp_parser_label: mangle a metadirective region
+ label NAME. */
+static tree
+mangle_metadirective_region_label (cp_parser *parser, tree name)
+{
+ const char *old_name = IDENTIFIER_POINTER (name);
+ char *new_name = (char *) alloca (strlen (old_name) + 32);
+ sprintf (new_name, "%s_MDR%u", old_name, parser->metadirective_region_num);
+ return get_identifier (new_name);
+}
+
/* Parse the label for a labeled-statement, i.e.
label:
@@ -13101,7 +13128,12 @@ cp_parser_label_for_labeled_statement (cp_parser* parser, tree attributes)
default:
/* Anything else must be an ordinary label. */
- label = finish_label_stmt (cp_parser_identifier (parser));
+ cp_expr identifier = cp_parser_identifier (parser);
+ if (identifier != error_mark_node
+ && parser->in_metadirective_body
+ && parser->metadirective_body_labels->contains (*identifier))
+ *identifier = mangle_metadirective_region_label (parser, *identifier);
+ label = finish_label_stmt (identifier);
if (label && TREE_CODE (label) == LABEL_DECL)
FALLTHROUGH_LABEL_P (label) = fallthrough_p;
break;
@@ -14906,7 +14938,15 @@ cp_parser_jump_statement (cp_parser* parser)
finish_goto_stmt (cp_parser_expression (parser));
}
else
- finish_goto_stmt (cp_parser_identifier (parser));
+ {
+ cp_expr identifier = cp_parser_identifier (parser);
+ if (identifier != error_mark_node
+ && parser->in_metadirective_body
+ && parser->metadirective_body_labels->contains (*identifier))
+ *identifier = mangle_metadirective_region_label (parser,
+ *identifier);
+ finish_goto_stmt (identifier);
+ }
/* Look for the final `;'. */
cp_parser_require (parser, CPP_SEMICOLON, RT_SEMICOLON);
break;
@@ -47899,7 +47939,7 @@ cp_parser_omp_declare_simd (cp_parser *parser, cp_token *pragma_tok,
static tree
cp_parser_omp_context_selector (cp_parser *parser, enum omp_tss_code set,
- bool has_parms_p)
+ bool has_parms_p, bool metadirective_p)
{
tree ret = NULL_TREE;
do
@@ -48060,17 +48100,25 @@ cp_parser_omp_context_selector (cp_parser *parser, enum omp_tss_code set,
break;
case OMP_TRAIT_PROPERTY_DEV_NUM_EXPR:
case OMP_TRAIT_PROPERTY_BOOL_EXPR:
- /* FIXME: this is bogus, the expression need
- not be constant. */
- t = cp_parser_constant_expression (parser);
+ /* FIXME: I believe it is an unimplemented feature rather
+ than a user error to have non-constant expressions
+ inside "declare variant". */
+ t = metadirective_p
+ ? cp_parser_expression (parser)
+ : cp_parser_constant_expression (parser);
if (t != error_mark_node)
{
t = fold_non_dependent_expr (t);
- if (!value_dependent_expression_p (t)
+ if (!metadirective_p
+ && !value_dependent_expression_p (t)
&& (!INTEGRAL_TYPE_P (TREE_TYPE (t))
|| !tree_fits_shwi_p (t)))
error_at (token->location, "property must be "
"constant integer expression");
+ if (metadirective_p
+ && !INTEGRAL_TYPE_P (TREE_TYPE (t)))
+ error_at (token->location,
+ "property must be integer expression");
else
properties = make_trait_property (NULL_TREE, t,
properties);
@@ -48149,7 +48197,8 @@ cp_parser_omp_context_selector (cp_parser *parser, enum omp_tss_code set,
static tree
cp_parser_omp_context_selector_specification (cp_parser *parser,
- bool has_parms_p)
+ bool has_parms_p,
+ bool metadirective_p)
{
tree ret = NULL_TREE;
do
@@ -48176,7 +48225,8 @@ cp_parser_omp_context_selector_specification (cp_parser *parser,
return error_mark_node;
tree selectors
- = cp_parser_omp_context_selector (parser, set, has_parms_p);
+ = cp_parser_omp_context_selector (parser, set, has_parms_p,
+ metadirective_p);
if (selectors == error_mark_node)
{
cp_parser_skip_to_closing_brace (parser);
@@ -48486,7 +48536,8 @@ cp_finish_omp_declare_variant (cp_parser *parser, cp_token *pragma_tok,
if (!parens.require_open (parser))
goto fail;
- tree ctx = cp_parser_omp_context_selector_specification (parser, true);
+ tree ctx = cp_parser_omp_context_selector_specification (parser, true,
+ false);
if (ctx == error_mark_node)
goto fail;
ctx = omp_check_context_selector (match_loc, ctx, false);
@@ -49119,6 +49170,449 @@ cp_parser_omp_end (cp_parser *parser, cp_token *pragma_tok)
}
}
+
+/* Helper function for cp_parser_omp_metadirective. */
+
+static void
+analyze_metadirective_body (cp_parser *parser,
+ vec<cp_token> &tokens,
+ vec<tree> &labels)
+{
+ int nesting_depth = 0;
+ int bracket_depth = 0;
+ bool in_case = false;
+ bool in_label_decl = false;
+ cp_token *pragma_tok = NULL;
+
+ while (1)
+ {
+ cp_token *token = cp_lexer_peek_token (parser->lexer);
+ bool stop = false;
+
+ if (cp_lexer_next_token_is_keyword (parser->lexer, RID_CASE))
+ in_case = true;
+ else if (cp_lexer_next_token_is_keyword (parser->lexer, RID_LABEL))
+ in_label_decl = true;
+
+ switch (token->type)
+ {
+ case CPP_EOF:
+ break;
+ case CPP_NAME:
+ if ((!in_case
+ && cp_lexer_nth_token_is (parser->lexer, 2, CPP_COLON))
+ || in_label_decl)
+ labels.safe_push (token->u.value);
+ goto add;
+ case CPP_OPEN_BRACE:
+ ++nesting_depth;
+ goto add;
+ case CPP_CLOSE_BRACE:
+ if (--nesting_depth == 0 && bracket_depth == 0)
+ stop = true;
+ goto add;
+ case CPP_OPEN_PAREN:
+ ++bracket_depth;
+ goto add;
+ case CPP_CLOSE_PAREN:
+ --bracket_depth;
+ goto add;
+ case CPP_COLON:
+ in_case = false;
+ goto add;
+ case CPP_SEMICOLON:
+ if (nesting_depth == 0 && bracket_depth == 0)
+ stop = true;
+ /* Local label declarations are terminated by a semicolon. */
+ in_label_decl = false;
+ goto add;
+ case CPP_PRAGMA:
+ parser->lexer->in_pragma = true;
+ pragma_tok = token;
+ goto add;
+ case CPP_PRAGMA_EOL:
+ /* C++ attribute syntax for OMP directives lexes as a pragma,
+ but we must reset the associated lexer state when we reach
+ the end in order to get the tokens for the statement that
+ come after it. */
+ tokens.safe_push (*token);
+ cp_parser_skip_to_pragma_eol (parser, pragma_tok);
+ pragma_tok = NULL;
+ continue;
+ default:
+ add:
+ tokens.safe_push (*token);
+ cp_lexer_consume_token (parser->lexer);
+ if (stop)
+ break;
+ continue;
+ }
+ break;
+ }
+}
+
+/* OpenMP 5.0:
+
+ # pragma omp metadirective [clause[, clause]]
+*/
+
+static void
+cp_parser_omp_metadirective (cp_parser *parser, cp_token *pragma_tok,
+ bool *if_p)
+{
+ static unsigned int metadirective_region_count = 0;
+
+ auto_vec<cp_token> directive_tokens;
+ auto_vec<cp_token> body_tokens;
+ auto_vec<tree> body_labels;
+ auto_vec<const struct c_omp_directive *> directives;
+ auto_vec<tree> ctxs;
+ bool default_seen = false;
+ int directive_token_idx = 0;
+ location_t pragma_loc = pragma_tok->location;
+ tree standalone_body = NULL_TREE;
+ vec<struct omp_variant> candidates;
+ bool requires_body = false;
+
+ tree ret = make_node (OMP_METADIRECTIVE);
+ SET_EXPR_LOCATION (ret, pragma_loc);
+ TREE_TYPE (ret) = void_type_node;
+ OMP_METADIRECTIVE_VARIANTS (ret) = NULL_TREE;
+
+ while (cp_lexer_next_token_is_not (parser->lexer, CPP_PRAGMA_EOL))
+ {
+ if (cp_lexer_next_token_is (parser->lexer, CPP_COMMA))
+ cp_lexer_consume_token (parser->lexer);
+ if (cp_lexer_next_token_is_not (parser->lexer, CPP_NAME)
+ && cp_lexer_next_token_is_not (parser->lexer, CPP_KEYWORD))
+ {
+ cp_parser_error (parser, "expected %<when%>, "
+ "%<otherwise%>, or %<default%> clause");
+ goto fail;
+ }
+
+ location_t match_loc = cp_lexer_peek_token (parser->lexer)->location;
+ const char *p
+ = IDENTIFIER_POINTER (cp_lexer_peek_token (parser->lexer)->u.value);
+ cp_lexer_consume_token (parser->lexer);
+ bool default_p
+ = strcmp (p, "default") == 0 || strcmp (p, "otherwise") == 0;
+ if (default_p)
+ {
+ if (default_seen)
+ {
+ error_at (match_loc, "too many %<otherwise%> or %<default%> "
+ "clauses in %<metadirective%>");
+ cp_parser_skip_to_end_of_block_or_statement (parser, true);
+ goto fail;
+ }
+ else
+ default_seen = true;
+ }
+ if (!strcmp (p, "when") == 0 && !default_p)
+ {
+ error_at (match_loc, "%qs is not valid for %qs",
+ p, "metadirective");
+ cp_parser_skip_to_end_of_block_or_statement (parser, true);
+ goto fail;
+ }
+
+ matching_parens parens;
+ tree ctx = NULL_TREE;
+ bool skip = false;
+
+ if (!parens.require_open (parser))
+ goto fail;
+
+ if (!default_p)
+ {
+ ctx = cp_parser_omp_context_selector_specification (parser, false,
+ true);
+ if (ctx == error_mark_node)
+ goto fail;
+ ctx = omp_check_context_selector (match_loc, ctx, true);
+ if (ctx == error_mark_node)
+ goto fail;
+
+ /* Remove the selector from further consideration if it can be
+ evaluated as a non-match at this point. */
+ /* FIXME: we could still do this if the context selector
+ doesn't have any dependent subexpressions. */
+ skip = (!processing_template_decl
+ && omp_context_selector_matches (ctx, true, true) == 0);
+
+ if (cp_lexer_next_token_is_not (parser->lexer, CPP_COLON))
+ {
+ cp_parser_require (parser, CPP_COLON, RT_COLON);
+ goto fail;
+ }
+ cp_lexer_consume_token (parser->lexer);
+ }
+
+ /* Read in the directive type and create a dummy pragma token for
+ it. */
+ location_t loc = cp_lexer_peek_token (parser->lexer)->location;
+
+ const char *directive[3] = {};
+ int i;
+ for (i = 0; i < 3; i++)
+ {
+ tree id;
+ if (cp_lexer_peek_nth_token (parser->lexer, i + 1)->type
+ == CPP_CLOSE_PAREN)
+ {
+ if (i == 0)
+ directive[i++] = "nothing";
+ break;
+ }
+ else if (cp_lexer_peek_nth_token (parser->lexer, i + 1)->type
+ == CPP_NAME)
+ id = cp_lexer_peek_nth_token (parser->lexer, i + 1)->u.value;
+ else if (cp_lexer_peek_nth_token (parser->lexer, i + 1)->keyword
+ != RID_MAX)
+ {
+ enum rid rid
+ = cp_lexer_peek_nth_token (parser->lexer, i + 1)->keyword;
+ id = ridpointers[rid];
+ }
+ else
+ break;
+
+ directive[i] = IDENTIFIER_POINTER (id);
+ }
+ if (i == 0)
+ {
+ error_at (loc, "expected directive name");
+ cp_parser_skip_to_end_of_block_or_statement (parser, true);
+ goto fail;
+ }
+
+ const struct c_omp_directive *omp_directive
+ = c_omp_categorize_directive (directive[0],
+ directive[1],
+ directive[2]);
+
+ if (omp_directive == NULL)
+ {
+ for (int j = 0; j < i; j++)
+ cp_lexer_consume_token (parser->lexer);
+ cp_parser_error (parser, "unknown directive name");
+ goto fail;
+ }
+ else
+ {
+ int token_count = 0;
+ if (omp_directive->first) token_count++;
+ if (omp_directive->second) token_count++;
+ if (omp_directive->third) token_count++;
+ for (int j = 0; j < token_count; j++)
+ cp_lexer_consume_token (parser->lexer);
+ }
+ if (p == NULL)
+ {
+ cp_parser_error (parser, "expected directive name");
+ goto fail;
+ }
+ if (omp_directive->id == PRAGMA_OMP_METADIRECTIVE)
+ {
+ cp_parser_error (parser,
+ "metadirectives cannot be used as variants of a "
+ "%<metadirective%>");
+ goto fail;
+ }
+ if (omp_directive->kind == C_OMP_DIR_DECLARATIVE)
+ {
+ sorry_at (loc, "declarative directive variants of a "
+ "%<metadirective%> are not supported");
+ goto fail;
+ }
+ if (omp_directive->kind == C_OMP_DIR_CONSTRUCT)
+ requires_body = true;
+
+ if (!skip)
+ {
+ cp_token pragma_token;
+ pragma_token.type = CPP_PRAGMA;
+ pragma_token.location = loc;
+ pragma_token.u.value = build_int_cst (NULL, omp_directive->id);
+
+ directives.safe_push (omp_directive);
+ directive_tokens.safe_push (pragma_token);
+ ctxs.safe_push (ctx);
+ }
+
+ /* Read in tokens for the directive clauses. */
+ int nesting_depth = 0;
+ while (1)
+ {
+ cp_token *token = cp_lexer_peek_token (parser->lexer);
+ switch (token->type)
+ {
+ case CPP_EOF:
+ case CPP_PRAGMA_EOL:
+ break;
+ case CPP_OPEN_PAREN:
+ ++nesting_depth;
+ goto add;
+ case CPP_CLOSE_PAREN:
+ if (nesting_depth-- == 0)
+ break;
+ goto add;
+ default:
+ add:
+ if (!skip)
+ directive_tokens.safe_push (*token);
+ cp_lexer_consume_token (parser->lexer);
+ continue;
+ }
+ break;
+ }
+
+ cp_lexer_consume_token (parser->lexer);
+
+ if (!skip)
+ {
+ cp_token eol_token = {};
+ eol_token.type = CPP_PRAGMA_EOL;
+ eol_token.keyword = RID_MAX;
+ directive_tokens.safe_push (eol_token);
+ }
+ }
+ cp_parser_skip_to_pragma_eol (parser, pragma_tok);
+
+ if (!default_seen)
+ {
+ /* Add a default clause that evaluates to 'omp nothing'. */
+ const struct c_omp_directive *omp_directive
+ = c_omp_categorize_directive ("nothing", NULL, NULL);
+
+ cp_token pragma_token = {};
+ pragma_token.type = CPP_PRAGMA;
+ pragma_token.keyword = RID_MAX;
+ pragma_token.location = UNKNOWN_LOCATION;
+ pragma_token.u.value = build_int_cst (NULL, PRAGMA_OMP_NOTHING);
+
+ directives.safe_push (omp_directive);
+ directive_tokens.safe_push (pragma_token);
+ ctxs.safe_push (NULL_TREE);
+
+ cp_token eol_token = {};
+ eol_token.type = CPP_PRAGMA_EOL;
+ eol_token.keyword = RID_MAX;
+ directive_tokens.safe_push (eol_token);
+ }
+
+ if (requires_body)
+ analyze_metadirective_body (parser, body_tokens, body_labels);
+
+ /* Process each candidate directive. */
+ unsigned i;
+ tree ctx;
+ cp_lexer *lexer;
+
+ lexer = cp_lexer_alloc ();
+ lexer->debugging_p = parser->lexer->debugging_p;
+ vec_safe_reserve (lexer->buffer,
+ directive_tokens.length () + body_tokens.length () + 2);
+
+ FOR_EACH_VEC_ELT (ctxs, i, ctx)
+ {
+ lexer->buffer->truncate (0);
+
+ /* Add the directive tokens. */
+ do
+ lexer->buffer->quick_push (directive_tokens [directive_token_idx++]);
+ while (lexer->buffer->last ().type != CPP_PRAGMA_EOL);
+
+ /* Add the body tokens. */
+ gcc_assert (requires_body || body_tokens.is_empty ());
+ for (unsigned j = 0; j < body_tokens.length (); j++)
+ lexer->buffer->quick_push (body_tokens[j]);
+
+ /* Make sure nothing tries to read past the end of the tokens. */
+ cp_token eof_token = {};
+ eof_token.type = CPP_EOF;
+ eof_token.keyword = RID_MAX;
+ lexer->buffer->quick_push (eof_token);
+ lexer->buffer->quick_push (eof_token);
+
+ lexer->next_token = lexer->buffer->address();
+ lexer->last_token = lexer->next_token + lexer->buffer->length () - 1;
+
+ cp_lexer *old_lexer = parser->lexer;
+ bool old_in_metadirective_body = parser->in_metadirective_body;
+ vec<tree> *old_metadirective_body_labels
+ = parser->metadirective_body_labels;
+ unsigned int old_metadirective_region_num
+ = parser->metadirective_region_num;
+ parser->lexer = lexer;
+ cp_lexer_set_source_position_from_token (lexer->next_token);
+ parser->in_metadirective_body = true;
+ parser->metadirective_body_labels = &body_labels;
+ parser->metadirective_region_num = ++metadirective_region_count;
+
+ int prev_errorcount = errorcount;
+ tree directive = push_stmt_list ();
+ tree directive_stmt = begin_compound_stmt (0);
+
+ cp_parser_pragma (parser, pragma_compound, if_p);
+ finish_compound_stmt (directive_stmt);
+ directive = pop_stmt_list (directive);
+
+ bool standalone_p
+ = directives[i]->kind == C_OMP_DIR_STANDALONE
+ || directives[i]->kind == C_OMP_DIR_UTILITY;
+ if (standalone_p && requires_body)
+ {
+ /* Parsing standalone directives will not consume the body
+ tokens, so do that here. */
+ if (standalone_body == NULL_TREE)
+ {
+ standalone_body = push_stmt_list ();
+ cp_parser_statement (parser, NULL_TREE, false, if_p);
+ standalone_body = pop_stmt_list (standalone_body);
+ }
+ else
+ cp_parser_skip_to_end_of_block_or_statement (parser, true);
+ }
+
+ tree body = standalone_p ? standalone_body : NULL_TREE;
+ tree variant = make_omp_metadirective_variant (ctx, directive, body);
+ OMP_METADIRECTIVE_VARIANTS (ret)
+ = chainon (OMP_METADIRECTIVE_VARIANTS (ret), variant);
+
+ /* Check that all valid tokens have been consumed if no parse errors
+ encountered. */
+ gcc_assert (errorcount != prev_errorcount
+ || cp_lexer_next_token_is (parser->lexer, CPP_EOF));
+
+ parser->lexer = old_lexer;
+ cp_lexer_set_source_position_from_token (old_lexer->next_token);
+ parser->in_metadirective_body = old_in_metadirective_body;
+ parser->metadirective_body_labels = old_metadirective_body_labels;
+ parser->metadirective_region_num = old_metadirective_region_num;
+ }
+
+ /* Try to resolve the metadirective early. */
+ if (!processing_template_decl)
+ {
+ candidates = omp_early_resolve_metadirective (ret);
+ if (!candidates.is_empty ())
+ ret = c_omp_expand_metadirective (candidates);
+ }
+
+ add_stmt (ret);
+ return;
+
+fail:
+ /* Skip the metadirective pragma. */
+ cp_parser_skip_to_pragma_eol (parser, pragma_tok);
+
+ /* Skip the metadirective body. */
+ cp_parser_skip_to_end_of_block_or_statement (parser, true);
+}
+
+
/* Helper function of cp_parser_omp_declare_reduction. Parse the combiner
expression and optional initializer clause of
#pragma omp declare reduction. We store the expression(s) as
@@ -51051,6 +51545,10 @@ cp_parser_pragma (cp_parser *parser, enum pragma_context context, bool *if_p)
cp_parser_omp_nothing (parser, pragma_tok);
return false;
+ case PRAGMA_OMP_METADIRECTIVE:
+ cp_parser_omp_metadirective (parser, pragma_tok, if_p);
+ return true;
+
case PRAGMA_OMP_ERROR:
return cp_parser_omp_error (parser, pragma_tok, context);
diff --git a/gcc/cp/parser.h b/gcc/cp/parser.h
index 373e78f3ea4..1260898774c 100644
--- a/gcc/cp/parser.h
+++ b/gcc/cp/parser.h
@@ -446,6 +446,13 @@ struct GTY(()) cp_parser {
/* Pointer to state for parsing omp_loops. Managed by
cp_parser_omp_for_loop in parser.cc and not used outside that file. */
struct omp_for_parse_data * GTY((skip)) omp_for_parse_state;
+
+ /* Set if we are processing a statement body associated with a
+ metadirective variant. */
+ bool in_metadirective_body;
+
+ vec<tree> * GTY((skip)) metadirective_body_labels;
+ unsigned metadirective_region_num;
};
/* In parser.cc */
diff --git a/gcc/cp/pt.cc b/gcc/cp/pt.cc
index 3b2106dd3f6..409c4df68bc 100644
--- a/gcc/cp/pt.cc
+++ b/gcc/cp/pt.cc
@@ -17859,6 +17859,79 @@ tsubst_omp_clauses (tree clauses, enum c_omp_region_type ort,
return new_clauses;
}
+/* Like tsubst_copy, but specifically for OpenMP context selectors. */
+static tree
+tsubst_omp_context_selector (tree ctx, tree args, tsubst_flags_t complain,
+ tree in_decl)
+{
+ tree new_ctx = NULL_TREE;
+ for (tree set = ctx; set; set = TREE_CHAIN (set))
+ {
+ tree selectors = NULL_TREE;
+ for (tree sel = OMP_TSS_TRAIT_SELECTORS (set); sel;
+ sel = TREE_CHAIN (sel))
+ {
+ enum omp_ts_code code = OMP_TS_CODE (sel);
+ tree properties = NULL_TREE;
+ tree score = OMP_TS_SCORE (sel);
+ tree t;
+
+ if (score)
+ {
+ score = tsubst_expr (score, args, complain, in_decl);
+ score = fold_non_dependent_expr (score);
+ if (!INTEGRAL_TYPE_P (TREE_TYPE (score))
+ || TREE_CODE (score) != INTEGER_CST)
+ {
+ error_at (cp_expr_loc_or_input_loc (score),
+ "%<score%> argument must "
+ "be constant integer expression");
+ score = NULL_TREE;
+ }
+ else if (tree_int_cst_sgn (score) < 0)
+ {
+ error_at (cp_expr_loc_or_input_loc (score),
+ "%<score%> argument must be non-negative");
+ score = NULL_TREE;
+ }
+ }
+
+ switch (omp_ts_map[OMP_TS_CODE (sel)].tp_type)
+ {
+ case OMP_TRAIT_PROPERTY_DEV_NUM_EXPR:
+ case OMP_TRAIT_PROPERTY_BOOL_EXPR:
+ t = tsubst_expr (OMP_TP_VALUE (OMP_TS_PROPERTIES (sel)),
+ args, complain, in_decl);
+ t = fold_non_dependent_expr (t);
+ if (!INTEGRAL_TYPE_P (TREE_TYPE (t)))
+ error_at (cp_expr_loc_or_input_loc (t),
+ "property must be integer expression");
+ properties = make_trait_property (NULL_TREE, t, NULL_TREE);
+ break;
+ case OMP_TRAIT_PROPERTY_CLAUSE_LIST:
+ if (OMP_TS_CODE (sel) == OMP_TRAIT_CONSTRUCT_SIMD)
+ properties = tsubst_omp_clauses (OMP_TS_PROPERTIES (sel),
+ C_ORT_OMP_DECLARE_SIMD,
+ args, complain, in_decl);
+ break;
+ default:
+ /* Nothing to do here, just copy. */
+ for (tree prop = OMP_TS_PROPERTIES (sel);
+ prop; prop = TREE_CHAIN (prop))
+ properties = make_trait_property (OMP_TP_NAME (prop),
+ OMP_TP_VALUE (prop),
+ properties);
+ }
+ selectors = make_trait_selector (code, score, properties, selectors);
+ }
+ new_ctx = make_trait_set_selector (OMP_TSS_CODE (set),
+ nreverse (selectors),
+ new_ctx);
+ }
+ return nreverse (new_ctx);
+}
+
+
/* Like tsubst_expr, but unshare TREE_LIST nodes. */
static tree
@@ -19406,6 +19479,52 @@ tsubst_stmt (tree t, tree args, tsubst_flags_t complain, tree in_decl)
}
break;
+ case OMP_METADIRECTIVE:
+ {
+ tree variants = NULL_TREE;
+ for (tree v = OMP_METADIRECTIVE_VARIANTS (t); v; v = TREE_CHAIN (v))
+ {
+ tree ctx = OMP_METADIRECTIVE_VARIANT_SELECTOR (v);
+ tree directive = OMP_METADIRECTIVE_VARIANT_DIRECTIVE (v);
+ tree body = OMP_METADIRECTIVE_VARIANT_BODY (v);
+ tree s;
+
+ /* CTX is null if this is the default variant. */
+ if (ctx)
+ {
+ ctx = tsubst_omp_context_selector (ctx, args, complain,
+ in_decl);
+ /* Remove the selector from further consideration if it can be
+ evaluated as a non-match at this point. */
+ if (omp_context_selector_matches (ctx, true, true) == 0)
+ continue;
+ }
+ s = push_stmt_list ();
+ RECUR (directive);
+ directive = pop_stmt_list (s);
+ if (body)
+ {
+ s = push_stmt_list ();
+ RECUR (body);
+ body = pop_stmt_list (s);
+ }
+ variants
+ = chainon (variants,
+ make_omp_metadirective_variant (ctx, directive,
+ body));
+ }
+ t = copy_node (t);
+ OMP_METADIRECTIVE_VARIANTS (t) = variants;
+
+ /* Try to resolve the metadirective early. */
+ vec<struct omp_variant> candidates
+ = omp_early_resolve_metadirective (t);
+ if (!candidates.is_empty ())
+ t = c_omp_expand_metadirective (candidates);
+ add_stmt (t);
+ break;
+ }
+
case TRANSACTION_EXPR:
{
int flags = 0;
diff --git a/gcc/testsuite/g++.dg/gomp/attrs-metadirective-1.C b/gcc/testsuite/g++.dg/gomp/attrs-metadirective-1.C
new file mode 100644
index 00000000000..a0b09088d3a
--- /dev/null
+++ b/gcc/testsuite/g++.dg/gomp/attrs-metadirective-1.C
@@ -0,0 +1,40 @@
+// { dg-do compile { target c++11 } }
+
+#define N 100
+
+void f (int a[], int b[], int c[])
+{
+ int i;
+
+ [[omp::directive (metadirective
+ default (teams loop)
+ default (parallel loop))]] /* { dg-error "too many 'otherwise' or 'default' clauses in 'metadirective'" } */
+ for (i = 0; i < N; i++) c[i] = a[i] * b[i];
+
+ [[omp::directive (metadirective
+ default (bad_directive))]] /* { dg-error "unknown directive name before '\\)' token" } */
+ for (i = 0; i < N; i++) c[i] = a[i] * b[i];
+
+ [[omp::directive (metadirective
+ default (teams loop)
+ where (device={arch("nvptx")}: parallel loop))]] /* { dg-error "'where' is not valid for 'metadirective'" } */
+ for (i = 0; i < N; i++) c[i] = a[i] * b[i];
+
+ [[omp::directive (metadirective
+ default (teams loop)
+ when (device={arch("nvptx")} parallel loop))]] /* { dg-error "expected ':' before 'parallel'" } */
+ for (i = 0; i < N; i++) c[i] = a[i] * b[i];
+
+ [[omp::directive (metadirective
+ default (metadirective default (flush)))]] /* { dg-error "metadirectives cannot be used as variants of a 'metadirective' before 'default'" } */
+ for (i = 0; i < N; i++) c[i] = a[i] * b[i];
+
+ /* Test improperly nested metadirectives - even though the second
+ metadirective resolves to 'omp nothing', that is not the same as there
+ being literally nothing there. */
+ [[omp::directive (metadirective
+ when (implementation={vendor("gnu")}: parallel for))]]
+ [[omp::directive (metadirective /* { dg-error "'#pragma' is not allowed here" } */
+ when (implementation={vendor("cray")}: parallel for))]]
+ for (i = 0; i < N; i++) c[i] = a[i] * b[i];
+}
diff --git a/gcc/testsuite/g++.dg/gomp/attrs-metadirective-2.C b/gcc/testsuite/g++.dg/gomp/attrs-metadirective-2.C
new file mode 100644
index 00000000000..44c87df1776
--- /dev/null
+++ b/gcc/testsuite/g++.dg/gomp/attrs-metadirective-2.C
@@ -0,0 +1,74 @@
+// { dg-do compile { target c++11 } }
+
+#define N 100
+
+int main (void)
+{
+ int x = 0;
+ int y = 0;
+
+ /* Test implicit default (nothing). */
+ [[omp::directive (metadirective,
+ when (device={arch("nvptx")}: barrier))]]
+ x = 1;
+
+ /* Test with multiple standalone directives. */
+ [[omp::directive (metadirective,
+ when (device={arch("nvptx")}: barrier),
+ default (flush))]]
+ x = 1;
+
+ /* Test combining a standalone directive with one that takes a statement
+ body. */
+ [[omp::directive (metadirective,
+ when (device={arch("nvptx")}: parallel),
+ default (barrier))]]
+ x = 1;
+
+ /* Test combining a standalone directive with one that takes a for loop. */
+ [[omp::directive (metadirective,
+ when (device={arch("nvptx")}: parallel for),
+ default (barrier))]]
+ for (int i = 0; i < N; i++)
+ x += i;
+
+ /* Test combining a directive that takes a for loop with one that takes
+ a regular statement body. */
+ [[omp::directive (metadirective,
+ when (device={arch("nvptx")}: parallel for),
+ default (parallel))]]
+ for (int i = 0; i < N; i++)
+ x += i;
+
+ /* Test labels inside statement body. */
+ [[omp::directive (metadirective,
+ when (device={arch("nvptx")}: teams num_teams(512)),
+ when (device={arch("gcn")}: teams num_teams(256)),
+ default (teams num_teams(4)))]]
+ {
+ if (x)
+ goto l1;
+ else
+ goto l2;
+ l1: ;
+ l2: ;
+ }
+
+ /* Test local labels inside statement body. */
+ [[omp::directive (metadirective,
+ when (device={arch("nvptx")}: teams num_teams(512)),
+ when (device={arch("gcn")}: teams num_teams(256)),
+ default (teams num_teams(4)))]]
+ {
+ //__label__ l1, l2;
+
+ if (x)
+ goto l1;
+ else
+ goto l2;
+ l1: ;
+ l2: ;
+ }
+
+ return 0;
+}
diff --git a/gcc/testsuite/g++.dg/gomp/attrs-metadirective-3.C b/gcc/testsuite/g++.dg/gomp/attrs-metadirective-3.C
new file mode 100644
index 00000000000..0c2bbdd2f10
--- /dev/null
+++ b/gcc/testsuite/g++.dg/gomp/attrs-metadirective-3.C
@@ -0,0 +1,31 @@
+// { dg-do compile { target c++11 } }
+/* { dg-additional-options "-fdump-tree-original" } */
+/* { dg-additional-options "-fdump-tree-gimple" } */
+/* { dg-additional-options "-fdump-tree-optimized" } */
+
+#define N 100
+
+void f (int x[], int y[], int z[])
+{
+ int i;
+
+ [[omp::sequence (directive (target map(to: x, y) map(from: z)),
+ directive (metadirective
+ when (device={arch("nvptx")}: teams loop)
+ default (parallel loop)))]]
+ for (i = 0; i < N; i++)
+ z[i] = x[i] * y[i];
+}
+
+/* The metadirective should be resolved after Gimplification. */
+
+/* { dg-final { scan-tree-dump-times "#pragma omp metadirective" 1 "original" } } */
+/* { dg-final { scan-tree-dump-times "when \\(device = .*arch.*nvptx.*\\):" 1 "original" } } */
+/* { dg-final { scan-tree-dump-times "#pragma omp teams" 1 "original" } } */
+/* { dg-final { scan-tree-dump-times "default:" 1 "original" } } */
+/* { dg-final { scan-tree-dump-times "#pragma omp parallel" 1 "original" } } */
+/* { dg-final { scan-tree-dump-times "#pragma omp loop" 2 "original" } } */
+
+/* { dg-final { scan-tree-dump-times "#pragma omp metadirective" 1 "gimple" } } */
+
+/* { dg-final { scan-tree-dump-not "#pragma omp metadirective" "optimized" } } */
diff --git a/gcc/testsuite/g++.dg/gomp/attrs-metadirective-4.C b/gcc/testsuite/g++.dg/gomp/attrs-metadirective-4.C
new file mode 100644
index 00000000000..43b939be43b
--- /dev/null
+++ b/gcc/testsuite/g++.dg/gomp/attrs-metadirective-4.C
@@ -0,0 +1,41 @@
+// { dg-do compile { target c++11 } }
+
+/* { dg-additional-options "-fdump-tree-original" } */
+/* { dg-additional-options "-fdump-tree-gimple" } */
+
+#define N 100
+
+#pragma omp declare target
+void f(double a[], double x) {
+ int i;
+
+ [[omp::directive (metadirective
+ when (construct={target}: distribute parallel for)
+ default (parallel for simd))]]
+ for (i = 0; i < N; i++)
+ a[i] = x * i;
+}
+#pragma omp end declare target
+
+ int main()
+{
+ double a[N];
+
+ #pragma omp target teams map(from: a[0:N])
+ f (a, 3.14159);
+
+ /* TODO: This does not execute a version of f with the default clause
+ active as might be expected. */
+ f (a, 2.71828); /* { dg-warning "direct calls to an offloadable function containing metadirectives with a 'construct={target}' selector may produce unexpected results" } */
+
+ return 0;
+ }
+
+ /* The metadirective should be resolved during Gimplification. */
+
+/* { dg-final { scan-tree-dump-times "#pragma omp metadirective" 1 "original" } } */
+/* { dg-final { scan-tree-dump-times "when \\(construct = .*target.*\\):" 1 "original" } } */
+/* { dg-final { scan-tree-dump-times "default:" 1 "original" } } */
+/* { dg-final { scan-tree-dump-times "#pragma omp parallel" 2 "original" } } */
+
+/* { dg-final { scan-tree-dump-not "#pragma omp metadirective" "gimple" } } */
diff --git a/gcc/testsuite/g++.dg/gomp/attrs-metadirective-5.C b/gcc/testsuite/g++.dg/gomp/attrs-metadirective-5.C
new file mode 100644
index 00000000000..1a9cee15be3
--- /dev/null
+++ b/gcc/testsuite/g++.dg/gomp/attrs-metadirective-5.C
@@ -0,0 +1,24 @@
+// { dg-do compile { target c++11 } }
+/* { dg-additional-options "-fdump-tree-original" } */
+
+#define N 100
+
+void f (int a[], int flag)
+{
+ int i;
+ [[omp::directive (metadirective
+ when (user={condition(flag)}:
+ target teams distribute parallel for map(from: a[0:N]))
+ default (parallel for))]]
+ for (i = 0; i < N; i++)
+ a[i] = i;
+}
+
+/* The metadirective should be resolved at parse time. */
+
+/* { dg-final { scan-tree-dump-not "#pragma omp metadirective" "original" } } */
+/* { dg-final { scan-tree-dump-times "#pragma omp target" 1 "original" } } */
+/* { dg-final { scan-tree-dump-times "#pragma omp teams" 1 "original" } } */
+/* { dg-final { scan-tree-dump-times "#pragma omp distribute" 1 "original" } } */
+/* { dg-final { scan-tree-dump-times "#pragma omp parallel" 2 "original" } } */
+/* { dg-final { scan-tree-dump-times "#pragma omp for" 2 "original" } } */
diff --git a/gcc/testsuite/g++.dg/gomp/attrs-metadirective-6.C b/gcc/testsuite/g++.dg/gomp/attrs-metadirective-6.C
new file mode 100644
index 00000000000..8a104ff2ebe
--- /dev/null
+++ b/gcc/testsuite/g++.dg/gomp/attrs-metadirective-6.C
@@ -0,0 +1,31 @@
+// { dg-do compile { target c++11 } }
+/* { dg-additional-options "-fdump-tree-original" } */
+/* { dg-additional-options "-fdump-tree-gimple" } */
+
+#define N 100
+
+void bar (int a[], int run_parallel, int run_guided)
+{
+ [[omp::directive (metadirective
+ when (user={condition(run_parallel)}: parallel))]]
+ {
+ int i;
+ [[omp::directive (metadirective
+ when (construct={parallel}, user={condition(run_guided)}:
+ for schedule(guided))
+ when (construct={parallel}: for schedule(static)))]]
+ for (i = 0; i < N; i++)
+ a[i] = i;
+ }
+ }
+
+/* The outer metadirective should be resolved at parse time. */
+/* The inner metadirective should be resolved during Gimplificiation. */
+
+/* { dg-final { scan-tree-dump-times "#pragma omp metadirective" 2 "original" } } */
+/* { dg-final { scan-tree-dump-times "#pragma omp parallel" 1 "original" } } */
+/* { dg-final { scan-tree-dump-times "#pragma omp for" 4 "original" } } */
+/* { dg-final { scan-tree-dump-times "when \\(construct = .parallel" 4 "original" } } */
+/* { dg-final { scan-tree-dump-times "default:" 2 "original" } } */
+
+/* { dg-final { scan-tree-dump-not "#pragma omp metadirective" "gimple" } } */
diff --git a/gcc/testsuite/g++.dg/gomp/attrs-metadirective-7.C b/gcc/testsuite/g++.dg/gomp/attrs-metadirective-7.C
new file mode 100644
index 00000000000..33861ec077e
--- /dev/null
+++ b/gcc/testsuite/g++.dg/gomp/attrs-metadirective-7.C
@@ -0,0 +1,31 @@
+// { dg-do compile { target c++11 } }
+/* { dg-additional-options "-fdump-tree-gimple" } */
+
+#define N 256
+
+void f (int a[], int num)
+{
+ int i;
+
+ [[omp::directive (metadirective
+ when (target_device={device_num(num), kind("gpu"), arch("nvptx")}:
+ target parallel for map(tofrom: a[0:N]))
+ when (target_device={device_num(num), kind("gpu"),
+ arch("amdgcn"), isa("gfx906")}:
+ target parallel for)
+ when (target_device={device_num(num), kind("cpu"), arch("x86_64")}:
+ parallel for))]]
+ for (i = 0; i < N; i++)
+ a[i] += i;
+
+ [[omp::directive (metadirective
+ when (target_device={kind("gpu"), arch("nvptx")}:
+ target parallel for map(tofrom: a[0:N])))]]
+ for (i = 0; i < N; i++)
+ a[i] += i;
+}
+
+/* { dg-final { scan-tree-dump "__builtin_GOMP_evaluate_target_device \\(num, &\"gpu.x00\"\\\[0\\\], &\"amdgcn.x00\"\\\[0\\\], &\"gfx906.x00\"\\\[0\\\]\\)" "gimple" } } */
+/* { dg-final { scan-tree-dump "__builtin_GOMP_evaluate_target_device \\(num, &\"gpu.x00\"\\\[0\\\], &\"nvptx.x00\"\\\[0\\\], 0B\\)" "gimple" } } */
+/* { dg-final { scan-tree-dump "__builtin_GOMP_evaluate_target_device \\(num, &\"cpu.x00\"\\\[0\\\], &\"x86_64.x00\"\\\[0\\\], 0B\\)" "gimple" } } */
+/* { dg-final { scan-tree-dump "__builtin_GOMP_evaluate_target_device \\(-2, &\"gpu.x00\"\\\[0\\\], &\"nvptx.x00\"\\\[0\\\], 0B\\)" "gimple" } } */
diff --git a/gcc/testsuite/g++.dg/gomp/attrs-metadirective-8.C b/gcc/testsuite/g++.dg/gomp/attrs-metadirective-8.C
new file mode 100644
index 00000000000..dcb3c365b80
--- /dev/null
+++ b/gcc/testsuite/g++.dg/gomp/attrs-metadirective-8.C
@@ -0,0 +1,16 @@
+// { dg-do compile { target c++11 } }
+
+#define N 256
+
+void f ()
+{
+ int i;
+ int a[N];
+
+ [[omp::directive (metadirective
+ when( device={kind(nohost)}: nothing )
+ when( device={arch("nvptx")}: nothing)
+ default( parallel for))]]
+ for (i = 0; i < N; i++)
+ a[i] = i;
+}
diff --git a/libgomp/testsuite/libgomp.c++/metadirective-template-1.C b/libgomp/testsuite/libgomp.c++/metadirective-template-1.C
new file mode 100644
index 00000000000..2d826574861
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c++/metadirective-template-1.C
@@ -0,0 +1,37 @@
+# include <stdio.h>
+
+template <bool tasking> int
+fib (int n)
+{
+ int i, j;
+ if (n < 2)
+ return n;
+ else if ( tasking && n < 8 ) // serial/taskless cutoff for n<8
+ return fib<false> (n);
+ else
+ {
+#pragma omp metadirective \
+ when (user = {condition (tasking)}: task shared(i))
+ i = fib<tasking> (n - 1);
+#pragma omp metadirective \
+ when (user = {condition (score(10): tasking)}: task shared(j))
+ j = fib<tasking> (n - 2);
+#pragma omp metadirective \
+ when (user = {condition (tasking)}: taskwait)
+ return i + j;
+ }
+}
+
+int main ()
+{
+ int n = 15, o = 610;
+#pragma omp parallel
+#pragma omp single
+ {
+ if (fib<true> (n) != o)
+ __builtin_abort ();
+ if (fib<false> (n) != o)
+ __builtin_abort ();
+ }
+ return 0;
+}
diff --git a/libgomp/testsuite/libgomp.c++/metadirective-template-2.C b/libgomp/testsuite/libgomp.c++/metadirective-template-2.C
new file mode 100644
index 00000000000..9134fefc7ac
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c++/metadirective-template-2.C
@@ -0,0 +1,41 @@
+# include <stdio.h>
+
+template <bool tasking> int
+fib (int n, bool flag)
+{
+ int i, j;
+ if (n < 2)
+ return n;
+ else if ( tasking && flag && n < 8 ) // serial/taskless cutoff for n<8
+ return fib<false> (n, false);
+ else
+ {
+#pragma omp metadirective \
+ when (user = {condition (tasking && flag)}: task shared(i))
+ i = fib<tasking> (n - 1, flag);
+#pragma omp metadirective \
+ when (user = {condition (score(10): tasking && flag)}: task shared(j))
+ j = fib<tasking> (n - 2, flag);
+#pragma omp metadirective \
+ when (user = {condition (tasking && flag)}: taskwait)
+ return i + j;
+ }
+}
+
+int main ()
+{
+ int n = 15, o = 610;
+#pragma omp parallel
+#pragma omp single
+ {
+ if (fib<true> (n, true) != o)
+ __builtin_abort ();
+ if (fib<true> (n, false) != o)
+ __builtin_abort ();
+ if (fib<false> (n, false) != o)
+ __builtin_abort ();
+ if (fib<false> (n, true) != o)
+ __builtin_abort ();
+ }
+ return 0;
+}
diff --git a/libgomp/testsuite/libgomp.c++/metadirective-template-3.C b/libgomp/testsuite/libgomp.c++/metadirective-template-3.C
new file mode 100644
index 00000000000..cc48fde0fda
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c++/metadirective-template-3.C
@@ -0,0 +1,41 @@
+# include <stdio.h>
+
+template <bool tasking> int
+fib (int n, bool flag)
+{
+ int i, j;
+ if (n < 2)
+ return n;
+ else if ( tasking && flag && n < 8 ) // serial/taskless cutoff for n<8
+ return fib<false> (n, false);
+ else
+ {
+#pragma omp metadirective \
+ when (user = {condition (tasking && flag)}: task shared(i)) \
+ when (user = {condition (!tasking && !flag)}: nothing) \
+ otherwise (error at(execution) message("oops 1"))
+ i = fib<tasking> (n - 1, flag);
+#pragma omp metadirective \
+ when (user = {condition (score(10): tasking && flag)}: task shared(j)) \
+ when (user = {condition (tasking || flag)} : \
+ error at(execution) message ("oops 2"))
+ j = fib<tasking> (n - 2, flag);
+#pragma omp metadirective \
+ when (user = {condition (tasking && flag)}: taskwait)
+ return i + j;
+ }
+}
+
+int main ()
+{
+ int n = 15, o = 610;
+#pragma omp parallel
+#pragma omp single
+ {
+ if (fib<true> (n, true) != o)
+ __builtin_abort ();
+ if (fib<false> (n, false) != o)
+ __builtin_abort ();
+ }
+ return 0;
+}
--
2.25.1
^ permalink raw reply [flat|nested] 13+ messages in thread
* [PATCH 06/12] OpenMP: common c/c++ testcases for metadirectives
2024-05-04 21:21 [PATCH 00/12] OpenMP: Metadirective support + "declare variant" improvements Sandra Loosemore
` (4 preceding siblings ...)
2024-05-04 21:21 ` [PATCH 05/12] OpenMP: C++ front-end " Sandra Loosemore
@ 2024-05-04 21:21 ` Sandra Loosemore
2024-05-04 21:21 ` [PATCH 07/12] OpenMP: Fortran front-end support " Sandra Loosemore
` (5 subsequent siblings)
11 siblings, 0 replies; 13+ messages in thread
From: Sandra Loosemore @ 2024-05-04 21:21 UTC (permalink / raw)
To: gcc-patches; +Cc: jakub, tburnus
gcc/testsuite/ChangeLog
* c-c++-common/gomp/metadirective-1.c: New.
* c-c++-common/gomp/metadirective-2.c: New.
* c-c++-common/gomp/metadirective-3.c: New.
* c-c++-common/gomp/metadirective-4.c: New.
* c-c++-common/gomp/metadirective-5.c: New.
* c-c++-common/gomp/metadirective-6.c: New.
* c-c++-common/gomp/metadirective-7.c: New.
* c-c++-common/gomp/metadirective-8.c: New.
* c-c++-common/gomp/metadirective-construct.c: New.
* c-c++-common/gomp/metadirective-device.c: New.
* c-c++-common/gomp/metadirective-no-score.c: New.
* c-c++-common/gomp/metadirective-target-device.c: New.
libgomp/ChangeLog
* testsuite/libgomp.c-c++-common/metadirective-1.c: New.
* testsuite/libgomp.c-c++-common/metadirective-2.c: New.
* testsuite/libgomp.c-c++-common/metadirective-3.c: New.
* testsuite/libgomp.c-c++-common/metadirective-4.c: New.
* testsuite/libgomp.c-c++-common/metadirective-5.c: New.
Co-Authored-By: Kwok Cheung Yeung <kcy@codesourcery.com>
Co-Authored-By: Sandra Loosemore <sandra@codesourcery.com>
---
.../c-c++-common/gomp/metadirective-1.c | 52 +++++
.../c-c++-common/gomp/metadirective-2.c | 74 ++++++++
.../c-c++-common/gomp/metadirective-3.c | 31 +++
.../c-c++-common/gomp/metadirective-4.c | 40 ++++
.../c-c++-common/gomp/metadirective-5.c | 24 +++
.../c-c++-common/gomp/metadirective-6.c | 31 +++
.../c-c++-common/gomp/metadirective-7.c | 31 +++
.../c-c++-common/gomp/metadirective-8.c | 16 ++
.../gomp/metadirective-construct.c | 177 ++++++++++++++++++
.../c-c++-common/gomp/metadirective-device.c | 147 +++++++++++++++
.../gomp/metadirective-no-score.c | 95 ++++++++++
.../gomp/metadirective-target-device.c | 147 +++++++++++++++
.../libgomp.c-c++-common/metadirective-1.c | 35 ++++
.../libgomp.c-c++-common/metadirective-2.c | 41 ++++
.../libgomp.c-c++-common/metadirective-3.c | 34 ++++
.../libgomp.c-c++-common/metadirective-4.c | 52 +++++
.../libgomp.c-c++-common/metadirective-5.c | 46 +++++
17 files changed, 1073 insertions(+)
create mode 100644 gcc/testsuite/c-c++-common/gomp/metadirective-1.c
create mode 100644 gcc/testsuite/c-c++-common/gomp/metadirective-2.c
create mode 100644 gcc/testsuite/c-c++-common/gomp/metadirective-3.c
create mode 100644 gcc/testsuite/c-c++-common/gomp/metadirective-4.c
create mode 100644 gcc/testsuite/c-c++-common/gomp/metadirective-5.c
create mode 100644 gcc/testsuite/c-c++-common/gomp/metadirective-6.c
create mode 100644 gcc/testsuite/c-c++-common/gomp/metadirective-7.c
create mode 100644 gcc/testsuite/c-c++-common/gomp/metadirective-8.c
create mode 100644 gcc/testsuite/c-c++-common/gomp/metadirective-construct.c
create mode 100644 gcc/testsuite/c-c++-common/gomp/metadirective-device.c
create mode 100644 gcc/testsuite/c-c++-common/gomp/metadirective-no-score.c
create mode 100644 gcc/testsuite/c-c++-common/gomp/metadirective-target-device.c
create mode 100644 libgomp/testsuite/libgomp.c-c++-common/metadirective-1.c
create mode 100644 libgomp/testsuite/libgomp.c-c++-common/metadirective-2.c
create mode 100644 libgomp/testsuite/libgomp.c-c++-common/metadirective-3.c
create mode 100644 libgomp/testsuite/libgomp.c-c++-common/metadirective-4.c
create mode 100644 libgomp/testsuite/libgomp.c-c++-common/metadirective-5.c
diff --git a/gcc/testsuite/c-c++-common/gomp/metadirective-1.c b/gcc/testsuite/c-c++-common/gomp/metadirective-1.c
new file mode 100644
index 00000000000..37b56237531
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/gomp/metadirective-1.c
@@ -0,0 +1,52 @@
+/* { dg-do compile } */
+
+#define N 100
+
+void f (int a[], int b[], int c[])
+{
+ int i;
+
+ #pragma omp metadirective \
+ default (teams loop) \
+ default (parallel loop) /* { dg-error "too many 'otherwise' or 'default' clauses in 'metadirective'" } */
+ for (i = 0; i < N; i++) c[i] = a[i] * b[i];
+
+ #pragma omp metadirective \
+ otherwise (teams loop) \
+ default (parallel loop) /* { dg-error "too many 'otherwise' or 'default' clauses in 'metadirective'" } */
+ for (i = 0; i < N; i++) c[i] = a[i] * b[i];
+
+ #pragma omp metadirective \
+ otherwise (teams loop) \
+ otherwise (parallel loop) /* { dg-error "too many 'otherwise' or 'default' clauses in 'metadirective'" } */
+ for (i = 0; i < N; i++) c[i] = a[i] * b[i];
+
+ #pragma omp metadirective \
+ default (bad_directive) /* { dg-error "unknown directive name before '\\)' token" } */
+ for (i = 0; i < N; i++) c[i] = a[i] * b[i];
+
+ #pragma omp metadirective \
+ default (teams loop) \
+ where (device={arch("nvptx")}: parallel loop) /* { dg-error "'where' is not valid for 'metadirective'" } */
+ for (i = 0; i < N; i++) c[i] = a[i] * b[i];
+
+ #pragma omp metadirective \
+ default (teams loop) \
+ when (device={arch("nvptx")} parallel loop) /* { dg-error "expected ':' before 'parallel'" } */
+ for (i = 0; i < N; i++) c[i] = a[i] * b[i];
+
+ #pragma omp metadirective \
+ default (metadirective default (flush)) /* { dg-error "metadirectives cannot be used as variants of a 'metadirective' before 'default'" } */
+ for (i = 0; i < N; i++) c[i] = a[i] * b[i];
+
+ /* Test improperly nested metadirectives - even though the second
+ metadirective resolves to 'omp nothing', that is not the same as there
+ being literally nothing there. */
+ #pragma omp metadirective \
+ when (implementation={vendor("gnu")}: parallel for)
+ #pragma omp metadirective \
+ when (implementation={vendor("cray")}: parallel for)
+ /* { dg-error "for statement expected before '#pragma'" "" { target c } .-2 } */
+ /* { dg-error "'#pragma' is not allowed here" "" { target c++ } .-3 } */
+ for (i = 0; i < N; i++) c[i] = a[i] * b[i];
+}
diff --git a/gcc/testsuite/c-c++-common/gomp/metadirective-2.c b/gcc/testsuite/c-c++-common/gomp/metadirective-2.c
new file mode 100644
index 00000000000..ea6904c9c12
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/gomp/metadirective-2.c
@@ -0,0 +1,74 @@
+/* { dg-do compile } */
+
+#define N 100
+
+int main (void)
+{
+ int x = 0;
+ int y = 0;
+
+ /* Test implicit default (nothing). */
+ #pragma omp metadirective \
+ when (device={arch("nvptx")}: barrier)
+ x = 1;
+
+ /* Test with multiple standalone directives. */
+ #pragma omp metadirective \
+ when (device={arch("nvptx")}: barrier) \
+ default (flush)
+ x = 1;
+
+ /* Test combining a standalone directive with one that takes a statement
+ body. */
+ #pragma omp metadirective \
+ when (device={arch("nvptx")}: parallel) \
+ default (barrier)
+ x = 1;
+
+ /* Test combining a standalone directive with one that takes a for loop. */
+ #pragma omp metadirective \
+ when (device={arch("nvptx")}: parallel for) \
+ default (barrier)
+ for (int i = 0; i < N; i++)
+ x += i;
+
+ /* Test combining a directive that takes a for loop with one that takes
+ a regular statement body. */
+ #pragma omp metadirective \
+ when (device={arch("nvptx")}: parallel for) \
+ default (parallel)
+ for (int i = 0; i < N; i++)
+ x += i;
+
+ /* Test labels inside statement body. */
+ #pragma omp metadirective \
+ when (device={arch("nvptx")}: teams num_teams(512)) \
+ when (device={arch("gcn")}: teams num_teams(256)) \
+ default (teams num_teams(4))
+ {
+ if (x)
+ goto l1;
+ else
+ goto l2;
+ l1: ;
+ l2: ;
+ }
+
+ /* Test local labels inside statement body. */
+ #pragma omp metadirective \
+ when (device={arch("nvptx")}: teams num_teams(512)) \
+ when (device={arch("gcn")}: teams num_teams(256)) \
+ default (teams num_teams(4))
+ {
+ //__label__ l1, l2;
+
+ if (x)
+ goto l1;
+ else
+ goto l2;
+ l1: ;
+ l2: ;
+ }
+
+ return 0;
+}
diff --git a/gcc/testsuite/c-c++-common/gomp/metadirective-3.c b/gcc/testsuite/c-c++-common/gomp/metadirective-3.c
new file mode 100644
index 00000000000..7a2818dd710
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/gomp/metadirective-3.c
@@ -0,0 +1,31 @@
+/* { dg-do compile } */
+/* { dg-additional-options "-fdump-tree-original" } */
+/* { dg-additional-options "-fdump-tree-gimple" } */
+/* { dg-additional-options "-fdump-tree-optimized" } */
+
+#define N 100
+
+void f (int x[], int y[], int z[])
+{
+ int i;
+
+ #pragma omp target map(to: x, y) map(from: z)
+ #pragma omp metadirective \
+ when (device={arch("nvptx")}: teams loop) \
+ default (parallel loop)
+ for (i = 0; i < N; i++)
+ z[i] = x[i] * y[i];
+}
+
+/* The metadirective should be resolved after Gimplification. */
+
+/* { dg-final { scan-tree-dump-times "#pragma omp metadirective" 1 "original" } } */
+/* { dg-final { scan-tree-dump-times "when \\(device = .*arch.*nvptx.*\\):" 1 "original" } } */
+/* { dg-final { scan-tree-dump-times "#pragma omp teams" 1 "original" } } */
+/* { dg-final { scan-tree-dump-times "default:" 1 "original" } } */
+/* { dg-final { scan-tree-dump-times "#pragma omp parallel" 1 "original" } } */
+/* { dg-final { scan-tree-dump-times "#pragma omp loop" 2 "original" } } */
+
+/* { dg-final { scan-tree-dump-times "#pragma omp metadirective" 1 "gimple" } } */
+
+/* { dg-final { scan-tree-dump-not "#pragma omp metadirective" "optimized" } } */
diff --git a/gcc/testsuite/c-c++-common/gomp/metadirective-4.c b/gcc/testsuite/c-c++-common/gomp/metadirective-4.c
new file mode 100644
index 00000000000..5fa86561a23
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/gomp/metadirective-4.c
@@ -0,0 +1,40 @@
+/* { dg-do compile } */
+/* { dg-additional-options "-fdump-tree-original" } */
+/* { dg-additional-options "-fdump-tree-gimple" } */
+
+#define N 100
+
+#pragma omp declare target
+void f(double a[], double x) {
+ int i;
+
+ #pragma omp metadirective \
+ when (construct={target}: distribute parallel for) \
+ default (parallel for simd)
+ for (i = 0; i < N; i++)
+ a[i] = x * i;
+}
+#pragma omp end declare target
+
+ int main()
+{
+ double a[N];
+
+ #pragma omp target teams map(from: a[0:N])
+ f (a, 3.14159);
+
+ /* TODO: This does not execute a version of f with the default clause
+ active as might be expected. */
+ f (a, 2.71828); /* { dg-warning "direct calls to an offloadable function containing metadirectives with a 'construct={target}' selector may produce unexpected results" } */
+
+ return 0;
+ }
+
+ /* The metadirective should be resolved during Gimplification. */
+
+/* { dg-final { scan-tree-dump-times "#pragma omp metadirective" 1 "original" } } */
+/* { dg-final { scan-tree-dump-times "when \\(construct = .*target.*\\):" 1 "original" } } */
+/* { dg-final { scan-tree-dump-times "default:" 1 "original" } } */
+/* { dg-final { scan-tree-dump-times "#pragma omp parallel" 2 "original" } } */
+
+/* { dg-final { scan-tree-dump-not "#pragma omp metadirective" "gimple" } } */
diff --git a/gcc/testsuite/c-c++-common/gomp/metadirective-5.c b/gcc/testsuite/c-c++-common/gomp/metadirective-5.c
new file mode 100644
index 00000000000..4a9f1aa85a6
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/gomp/metadirective-5.c
@@ -0,0 +1,24 @@
+/* { dg-do compile } */
+/* { dg-additional-options "-fdump-tree-original" } */
+
+#define N 100
+
+void f (int a[], int flag)
+{
+ int i;
+ #pragma omp metadirective \
+ when (user={condition(flag)}: \
+ target teams distribute parallel for map(from: a[0:N])) \
+ default (parallel for)
+ for (i = 0; i < N; i++)
+ a[i] = i;
+}
+
+/* The metadirective should be resolved at parse time. */
+
+/* { dg-final { scan-tree-dump-not "#pragma omp metadirective" "original" } } */
+/* { dg-final { scan-tree-dump-times "#pragma omp target" 1 "original" } } */
+/* { dg-final { scan-tree-dump-times "#pragma omp teams" 1 "original" } } */
+/* { dg-final { scan-tree-dump-times "#pragma omp distribute" 1 "original" } } */
+/* { dg-final { scan-tree-dump-times "#pragma omp parallel" 2 "original" } } */
+/* { dg-final { scan-tree-dump-times "#pragma omp for" 2 "original" } } */
diff --git a/gcc/testsuite/c-c++-common/gomp/metadirective-6.c b/gcc/testsuite/c-c++-common/gomp/metadirective-6.c
new file mode 100644
index 00000000000..26c7a008e95
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/gomp/metadirective-6.c
@@ -0,0 +1,31 @@
+/* { dg-do compile } */
+/* { dg-additional-options "-fdump-tree-original" } */
+/* { dg-additional-options "-fdump-tree-gimple" } */
+
+#define N 100
+
+void bar (int a[], int run_parallel, int run_guided)
+{
+ #pragma omp metadirective \
+ when (user={condition(run_parallel)}: parallel)
+ {
+ int i;
+ #pragma omp metadirective \
+ when (construct={parallel}, user={condition(run_guided)}: \
+ for schedule(guided)) \
+ when (construct={parallel}: for schedule(static))
+ for (i = 0; i < N; i++)
+ a[i] = i;
+ }
+ }
+
+/* The outer metadirective should be resolved at parse time. */
+/* The inner metadirective should be resolved during Gimplificiation. */
+
+/* { dg-final { scan-tree-dump-times "#pragma omp metadirective" 2 "original" } } */
+/* { dg-final { scan-tree-dump-times "#pragma omp parallel" 1 "original" } } */
+/* { dg-final { scan-tree-dump-times "#pragma omp for" 4 "original" } } */
+/* { dg-final { scan-tree-dump-times "when \\(construct = .parallel" 4 "original" } } */
+/* { dg-final { scan-tree-dump-times "default:" 2 "original" } } */
+
+/* { dg-final { scan-tree-dump-not "#pragma omp metadirective" "gimple" } } */
diff --git a/gcc/testsuite/c-c++-common/gomp/metadirective-7.c b/gcc/testsuite/c-c++-common/gomp/metadirective-7.c
new file mode 100644
index 00000000000..4e763cd03d4
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/gomp/metadirective-7.c
@@ -0,0 +1,31 @@
+/* { dg-do compile } */
+/* { dg-additional-options "-fdump-tree-gimple" } */
+
+#define N 256
+
+void f (int a[], int num)
+{
+ int i;
+
+ #pragma omp metadirective \
+ when (target_device={device_num(num), kind("gpu"), arch("nvptx")}: \
+ target parallel for map(tofrom: a[0:N])) \
+ when (target_device={device_num(num), kind("gpu"), \
+ arch("amdgcn"), isa("gfx906")}: \
+ target parallel for) \
+ when (target_device={device_num(num), kind("cpu"), arch("x86_64")}: \
+ parallel for)
+ for (i = 0; i < N; i++)
+ a[i] += i;
+
+ #pragma omp metadirective \
+ when (target_device={kind("gpu"), arch("nvptx")}: \
+ target parallel for map(tofrom: a[0:N]))
+ for (i = 0; i < N; i++)
+ a[i] += i;
+}
+
+/* { dg-final { scan-tree-dump "__builtin_GOMP_evaluate_target_device \\(num, &\"gpu.x00\"\\\[0\\\], &\"amdgcn.x00\"\\\[0\\\], &\"gfx906.x00\"\\\[0\\\]\\)" "gimple" } } */
+/* { dg-final { scan-tree-dump "__builtin_GOMP_evaluate_target_device \\(num, &\"gpu.x00\"\\\[0\\\], &\"nvptx.x00\"\\\[0\\\], 0B\\)" "gimple" } } */
+/* { dg-final { scan-tree-dump "__builtin_GOMP_evaluate_target_device \\(num, &\"cpu.x00\"\\\[0\\\], &\"x86_64.x00\"\\\[0\\\], 0B\\)" "gimple" } } */
+/* { dg-final { scan-tree-dump "__builtin_GOMP_evaluate_target_device \\(-2, &\"gpu.x00\"\\\[0\\\], &\"nvptx.x00\"\\\[0\\\], 0B\\)" "gimple" } } */
diff --git a/gcc/testsuite/c-c++-common/gomp/metadirective-8.c b/gcc/testsuite/c-c++-common/gomp/metadirective-8.c
new file mode 100644
index 00000000000..c7d9c31ed73
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/gomp/metadirective-8.c
@@ -0,0 +1,16 @@
+/* { dg-do compile } */
+
+#define N 256
+
+void f ()
+{
+ int i;
+ int a[N];
+
+ #pragma omp metadirective \
+ when( device={kind(nohost)}: nothing ) \
+ when( device={arch("nvptx")}: nothing) \
+ default( parallel for)
+ for (i = 0; i < N; i++)
+ a[i] = i;
+}
diff --git a/gcc/testsuite/c-c++-common/gomp/metadirective-construct.c b/gcc/testsuite/c-c++-common/gomp/metadirective-construct.c
new file mode 100644
index 00000000000..a61966aa899
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/gomp/metadirective-construct.c
@@ -0,0 +1,177 @@
+/* { dg-do compile } */
+/* { dg-additional-options "-foffload=disable -fdump-tree-optimized" } */
+
+#include <stdlib.h>
+
+static void
+init (int n, double *a)
+{
+ for (int i = 0; i < n; i++)
+ a[i] = (double) i;
+}
+
+static void
+check (int n, double *a, double s)
+{
+ for (int i = 0; i < n; i++)
+ if (a[i] != (double) i * s)
+ abort ();
+}
+
+typedef void (transform_fn) (int, double *, double);
+
+static void doit (transform_fn *f, int n, double *a, double s)
+{
+ init (n, a);
+ (*f) (n, a, s);
+ check (n, a, s);
+}
+
+/* Check various combinations for enforcing correct ordering of
+ construct matches. */
+static void
+f1 (int n, double* a, double s)
+{
+#pragma omp target teams
+#pragma omp parallel
+#pragma omp metadirective \
+ when (construct={target} \
+ : for) \
+ default (error at(execution) message("f1 match failed"))
+ for (int i = 0; i < n; i++)
+ a[i] = a[i] * s;
+}
+
+static void
+f2 (int n, double* a, double s)
+{
+#pragma omp target teams
+#pragma omp parallel
+#pragma omp metadirective \
+ when (construct={teams, parallel} \
+ : for) \
+ default (error at(execution) message("f2 match failed"))
+ for (int i = 0; i < n; i++)
+ a[i] = a[i] * s;
+}
+
+static void
+f3 (int n, double* a, double s)
+{
+#pragma omp target teams
+#pragma omp parallel
+#pragma omp metadirective \
+ when (construct={target, teams, parallel} \
+ : for) \
+ default (error at(execution) message("f3 match failed"))
+ for (int i = 0; i < n; i++)
+ a[i] = a[i] * s;
+}
+
+static void
+f4 (int n, double* a, double s)
+{
+#pragma omp target teams
+#pragma omp parallel
+#pragma omp metadirective \
+ when (construct={target, parallel} \
+ : for) \
+ default (error at(execution) message("f4 match failed"))
+ for (int i = 0; i < n; i++)
+ a[i] = a[i] * s;
+}
+
+static void
+f5 (int n, double* a, double s)
+{
+#pragma omp target teams
+#pragma omp parallel
+#pragma omp metadirective \
+ when (construct={target, teams} \
+ : for) \
+ default (error at(execution) message("f5 match failed"))
+ for (int i = 0; i < n; i++)
+ a[i] = a[i] * s;
+}
+
+/* Next batch is for things where the construct doesn't match the context. */
+static void
+f6 (int n, double* a, double s)
+{
+#pragma omp target
+#pragma omp teams
+#pragma omp metadirective \
+ when (construct={parallel} \
+ : error at(execution) message("f6 match failed")) \
+ default (parallel for)
+ for (int i = 0; i < n; i++)
+ a[i] = a[i] * s;
+}
+
+static void
+f7 (int n, double* a, double s)
+{
+#pragma omp target
+#pragma omp teams
+#pragma omp metadirective \
+ when (construct={target, parallel} \
+ : error at(execution) message("f7 match failed")) \
+ default (parallel for)
+ for (int i = 0; i < n; i++)
+ a[i] = a[i] * s;
+}
+
+static void
+f8 (int n, double* a, double s)
+{
+#pragma omp target
+#pragma omp teams
+#pragma omp metadirective \
+ when (construct={parallel, target} \
+ : error at(execution) message("f8 match failed")) \
+ default (parallel for)
+ for (int i = 0; i < n; i++)
+ a[i] = a[i] * s;
+}
+
+/* Next test choosing the best alternative when there are multiple
+ matches. */
+static void
+f9 (int n, double* a, double s)
+{
+#pragma omp target teams
+#pragma omp parallel
+#pragma omp metadirective \
+ when (construct={teams, parallel} \
+ : error at(execution) message("f9 match incorrect 1")) \
+ when (construct={target, teams, parallel} \
+ : for) \
+ when (construct={target, teams} \
+ : error at(execution) message("f9 match incorrect 2")) \
+ default (error at(execution) message("f9 match failed"))
+ for (int i = 0; i < n; i++)
+ a[i] = a[i] * s;
+}
+
+/* Note there are no tests for the matching the extended simd clause
+ syntax, which is only useful for "declare variant". */
+
+#define N 10
+#define S 2.0
+
+int main (void)
+{
+ double a[N];
+ doit (f1, N, a, S);
+ doit (f2, N, a, S);
+ doit (f3, N, a, S);
+ doit (f4, N, a, S);
+ doit (f5, N, a, S);
+ doit (f6, N, a, S);
+ doit (f7, N, a, S);
+ doit (f8, N, a, S);
+ doit (f9, N, a, S);
+}
+
+/* All the error calls should be optimized away. */
+/* { dg-final { scan-tree-dump-not "__builtin_GOMP_error" "optimized" } } */
diff --git a/gcc/testsuite/c-c++-common/gomp/metadirective-device.c b/gcc/testsuite/c-c++-common/gomp/metadirective-device.c
new file mode 100644
index 00000000000..9261331260c
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/gomp/metadirective-device.c
@@ -0,0 +1,147 @@
+/* { dg-do compile } */
+/* { dg-additional-options "-foffload=disable -fdump-tree-optimized" } */
+/* { dg-additional-options "-DDEVICE_ARCH=x86_64 -DDEVICE_ISA=sse -msse" { target x86_64-*-* } } */
+
+#include <stdlib.h>
+
+static void
+init (int n, double *a)
+{
+ for (int i = 0; i < n; i++)
+ a[i] = (double) i;
+}
+
+static void
+check (int n, double *a, double s)
+{
+ for (int i = 0; i < n; i++)
+ if (a[i] != (double) i * s)
+ abort ();
+}
+
+typedef void (transform_fn) (int, double *, double);
+
+static void doit (transform_fn *f, int n, double *a, double s)
+{
+ init (n, a);
+ (*f) (n, a, s);
+ check (n, a, s);
+}
+
+/* Check kind=host matches (with offloading disabled). */
+static void
+f1 (int n, double* a, double s)
+{
+#pragma omp metadirective \
+ when (device={kind(host)} \
+ : parallel for) \
+ default (error at(execution) message("f1 match failed"))
+ for (int i = 0; i < n; i++)
+ a[i] = a[i] * s;
+}
+
+/* Check kind=nohost does not match (with offloading disabled). */
+static void
+f2 (int n, double* a, double s)
+{
+#pragma omp metadirective \
+ when (device={kind(nohost)} \
+ : error at(execution) message("f2 match failed")) \
+ default (parallel for)
+ for (int i = 0; i < n; i++)
+ a[i] = a[i] * s;
+}
+
+/* Check arch. Either DEVICE_ARCH is defined by command-line option,
+ or we know it is not x86_64. */
+#ifdef DEVICE_ARCH
+static void
+f3 (int n, double* a, double s)
+{
+#pragma omp metadirective \
+ when (device={arch(DEVICE_ARCH)} \
+ : parallel for) \
+ default (error at(execution) message("f3 match failed"))
+ for (int i = 0; i < n; i++)
+ a[i] = a[i] * s;
+}
+#else
+static void
+f3 (int n, double* a, double s)
+{
+#pragma omp metadirective \
+ when (device={arch("x86_64")} \
+ : error at(execution) message("f3 match failed")) \
+ default (parallel for)
+ for (int i = 0; i < n; i++)
+ a[i] = a[i] * s;
+}
+#endif
+
+/* Check both kind and arch together. */
+#ifdef DEVICE_ARCH
+static void
+f4 (int n, double* a, double s)
+{
+#pragma omp metadirective \
+ when (device={arch(DEVICE_ARCH), kind(host)} \
+ : parallel for) \
+ default (error at(execution) message("f4 match failed"))
+ for (int i = 0; i < n; i++)
+ a[i] = a[i] * s;
+}
+#else
+static void
+f4 (int n, double* a, double s)
+{
+#pragma omp metadirective \
+ when (device={arch("x86_64"), kind(host)} \
+ : error at(execution) message("f4 match failed")) \
+ default (parallel for)
+ for (int i = 0; i < n; i++)
+ a[i] = a[i] * s;
+}
+#endif
+
+/* Check kind, arch, and ISA together. */
+#if defined(DEVICE_ARCH) && defined(DEVICE_ISA)
+static void
+f5 (int n, double* a, double s)
+{
+#pragma omp metadirective \
+ when (device={arch(DEVICE_ARCH), kind(host), isa(DEVICE_ISA)} \
+ : parallel for) \
+ default (error at(execution) message("f5 match failed"))
+ for (int i = 0; i < n; i++)
+ a[i] = a[i] * s;
+}
+#else
+static void
+f5 (int n, double* a, double s)
+{
+#pragma omp metadirective \
+ when (device={arch("x86_64"), kind(host), isa("sse")} \
+ : error at(execution) message("f5 match failed")) \
+ default (parallel for)
+ for (int i = 0; i < n; i++)
+ a[i] = a[i] * s;
+}
+#endif
+
+#define N 10
+#define S 2.0
+
+int main (void)
+{
+ double a[N];
+ doit (f1, N, a, S);
+ doit (f2, N, a, S);
+ doit (f3, N, a, S);
+ doit (f4, N, a, S);
+ doit (f5, N, a, S);
+}
+
+/* All the metadirectives involving the device selector should be
+ fully resolved and the error calls optimized away. */
+
+/* { dg-final { scan-tree-dump-not "__builtin_GOMP_error" "optimized" } } */
diff --git a/gcc/testsuite/c-c++-common/gomp/metadirective-no-score.c b/gcc/testsuite/c-c++-common/gomp/metadirective-no-score.c
new file mode 100644
index 00000000000..1f1053eaffa
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/gomp/metadirective-no-score.c
@@ -0,0 +1,95 @@
+/* { dg-do compile { target x86_64-*-* } } */
+/* { dg-additional-options "-foffload=disable" } */
+
+/* This test is expected to fail with compile-time errors:
+ "A trait-score cannot be specified in traits from the construct,
+ device or target_device trait-selector-sets." */
+
+/* Define this to avoid dependence on libgomp header files. */
+
+#define omp_initial_device -1
+
+void
+f1 (int n, double *a, double s)
+{
+#pragma omp metadirective \
+ when (device={kind (score(5) : host)} \
+ : parallel for)
+ /* { dg-error ".score. cannot be specified in traits in the .device. trait-selector-set" "" { target *-*-*} .-2 } */
+ for (int i = 0; i < n; i++)
+ a[i] = a[i] * s;
+}
+
+void
+f2 (int n, double *a, double s)
+{
+#pragma omp metadirective \
+ when (device={kind (host), arch (score(6) : x86_64), isa (avx512f)} \
+ : parallel for)
+ /* { dg-error ".score. cannot be specified in traits in the .device. trait-selector-set" "" { target *-*-*} .-2 } */
+ for (int i = 0; i < n; i++)
+ a[i] = a[i] * s;
+}
+
+void
+f3 (int n, double *a, double s)
+{
+#pragma omp metadirective \
+ when (device={kind (host), arch (score(6) : x86_64), \
+ isa (score(7): avx512f)} \
+ : parallel for)
+ /* { dg-error ".score. cannot be specified in traits in the .device. trait-selector-set" "" { target *-*-*} .-3 } */
+ /* { dg-error ".score. cannot be specified in traits in the .device. trait-selector-set" "" { target *-*-*} .-3 } */
+ for (int i = 0; i < n; i++)
+ a[i] = a[i] * s;
+}
+
+void
+f4 (int n, double *a, double s)
+{
+#pragma omp metadirective \
+ when (target_device={device_num (score(42) : omp_initial_device), \
+ kind (host)} \
+ : parallel for)
+ /* { dg-error ".score. cannot be specified in traits in the .target_device. trait-selector-set" "" { target *-*-*} .-3 } */
+ for (int i = 0; i < n; i++)
+ a[i] = a[i] * s;
+}
+
+void
+f5 (int n, double *a, double s)
+{
+#pragma omp metadirective \
+ when (target_device={device_num(omp_initial_device), \
+ kind (score(5) : host)} \
+ : parallel for)
+ /* { dg-error ".score. cannot be specified in traits in the .target_device. trait-selector-set" "" { target *-*-*} .-2 } */
+ for (int i = 0; i < n; i++)
+ a[i] = a[i] * s;
+}
+
+void
+f6 (int n, double *a, double s)
+{
+#pragma omp metadirective \
+ when (target_device={device_num(omp_initial_device), kind (host), \
+ arch (score(6) : x86_64), isa (avx512f)} \
+ : parallel for)
+ /* { dg-error ".score. cannot be specified in traits in the .target_device. trait-selector-set" "" { target *-*-*} .-2 } */
+ for (int i = 0; i < n; i++)
+ a[i] = a[i] * s;
+}
+
+void
+f7 (int n, double *a, double s)
+{
+#pragma omp metadirective \
+ when (target_device={device_num(omp_initial_device), kind (host), \
+ arch (score(6) : x86_64), \
+ isa (score(7): avx512f)} \
+ : parallel for)
+ /* { dg-error ".score. cannot be specified in traits in the .target_device. trait-selector-set" "" { target *-*-*} .-3 } */
+ /* { dg-error ".score. cannot be specified in traits in the .target_device. trait-selector-set" "" { target *-*-*} .-3 } */
+ for (int i = 0; i < n; i++)
+ a[i] = a[i] * s;
+}
diff --git a/gcc/testsuite/c-c++-common/gomp/metadirective-target-device.c b/gcc/testsuite/c-c++-common/gomp/metadirective-target-device.c
new file mode 100644
index 00000000000..335db416a4b
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/gomp/metadirective-target-device.c
@@ -0,0 +1,147 @@
+/* { dg-do compile } */
+/* { dg-additional-options "-foffload=disable -fdump-tree-optimized" } */
+/* { dg-additional-options "-DDEVICE_ARCH=x86_64 -DDEVICE_ISA=mmx -mmmx" { target x86_64-*-* } } */
+
+#include <stdlib.h>
+
+static void
+init (int n, double *a)
+{
+ for (int i = 0; i < n; i++)
+ a[i] = (double) i;
+}
+
+static void
+check (int n, double *a, double s)
+{
+ for (int i = 0; i < n; i++)
+ if (a[i] != (double) i * s)
+ abort ();
+}
+
+typedef void (transform_fn) (int, double *, double);
+
+static void doit (transform_fn *f, int n, double *a, double s)
+{
+ init (n, a);
+ (*f) (n, a, s);
+ check (n, a, s);
+}
+
+/* Check kind=host matches (with offloading disabled). */
+static void
+f1 (int n, double* a, double s)
+{
+#pragma omp metadirective \
+ when (target_device={kind(host)} \
+ : parallel for) \
+ default (error at(execution) message("f1 match failed"))
+ for (int i = 0; i < n; i++)
+ a[i] = a[i] * s;
+}
+
+/* Check kind=nohost does not match (with offloading disabled). */
+static void
+f2 (int n, double* a, double s)
+{
+#pragma omp metadirective \
+ when (target_device={kind(nohost)} \
+ : error at(execution) message("f2 match failed")) \
+ default (parallel for)
+ for (int i = 0; i < n; i++)
+ a[i] = a[i] * s;
+}
+
+/* Check arch. Either DEVICE_ARCH is defined by command-line option,
+ or we know it is not x86_64. */
+#ifdef DEVICE_ARCH
+static void
+f3 (int n, double* a, double s)
+{
+#pragma omp metadirective \
+ when (target_device={arch(DEVICE_ARCH)} \
+ : parallel for) \
+ default (error at(execution) message("f3 match failed"))
+ for (int i = 0; i < n; i++)
+ a[i] = a[i] * s;
+}
+#else
+static void
+f3 (int n, double* a, double s)
+{
+#pragma omp metadirective \
+ when (target_device={arch("x86_64")} \
+ : error at(execution) message("f3 match failed")) \
+ default (parallel for)
+ for (int i = 0; i < n; i++)
+ a[i] = a[i] * s;
+}
+#endif
+
+/* Check both kind and arch together. */
+#ifdef DEVICE_ARCH
+static void
+f4 (int n, double* a, double s)
+{
+#pragma omp metadirective \
+ when (target_device={arch(DEVICE_ARCH), kind(host)} \
+ : parallel for) \
+ default (error at(execution) message("f4 match failed"))
+ for (int i = 0; i < n; i++)
+ a[i] = a[i] * s;
+}
+#else
+static void
+f4 (int n, double* a, double s)
+{
+#pragma omp metadirective \
+ when (target_device={arch("x86_64"), kind(host)} \
+ : error at(execution) message("f4 match failed")) \
+ default (parallel for)
+ for (int i = 0; i < n; i++)
+ a[i] = a[i] * s;
+}
+#endif
+
+/* Check kind, arch, and ISA together. */
+#if defined(DEVICE_ARCH) && defined(DEVICE_ISA)
+static void
+f5 (int n, double* a, double s)
+{
+#pragma omp metadirective \
+ when (target_device={arch(DEVICE_ARCH), kind(host), isa(DEVICE_ISA)} \
+ : parallel for) \
+ default (error at(execution) message("f5 match failed"))
+ for (int i = 0; i < n; i++)
+ a[i] = a[i] * s;
+}
+#else
+static void
+f5 (int n, double* a, double s)
+{
+#pragma omp metadirective \
+ when (target_device={arch("x86_64"), kind(host), isa("mmx")} \
+ : error at(execution) message("f5 match failed")) \
+ default (parallel for)
+ for (int i = 0; i < n; i++)
+ a[i] = a[i] * s;
+}
+#endif
+
+#define N 10
+#define S 2.0
+
+int main (void)
+{
+ double a[N];
+ doit (f1, N, a, S);
+ doit (f2, N, a, S);
+ doit (f3, N, a, S);
+ doit (f4, N, a, S);
+ doit (f5, N, a, S);
+}
+
+/* Since the target_device selector is dynamic, none of
+ error checks tests can be optimized away. */
+
+/* { dg-final { scan-tree-dump-times "__builtin_GOMP_error" 5 "optimized" } } */
diff --git a/libgomp/testsuite/libgomp.c-c++-common/metadirective-1.c b/libgomp/testsuite/libgomp.c-c++-common/metadirective-1.c
new file mode 100644
index 00000000000..0de59cbe3d3
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c-c++-common/metadirective-1.c
@@ -0,0 +1,35 @@
+/* { dg-do run } */
+
+#define N 100
+
+void f (int x[], int y[], int z[])
+{
+ int i;
+
+ #pragma omp target map(to: x[0:N], y[0:N]) map(from: z[0:N])
+ #pragma omp metadirective \
+ when (device={arch("nvptx")}: teams loop) \
+ default (parallel loop)
+ for (i = 0; i < N; i++)
+ z[i] = x[i] * y[i];
+}
+
+int main (void)
+{
+ int x[N], y[N], z[N];
+ int i;
+
+ for (i = 0; i < N; i++)
+ {
+ x[i] = i;
+ y[i] = -i;
+ }
+
+ f (x, y, z);
+
+ for (i = 0; i < N; i++)
+ if (z[i] != x[i] * y[i])
+ return 1;
+
+ return 0;
+}
diff --git a/libgomp/testsuite/libgomp.c-c++-common/metadirective-2.c b/libgomp/testsuite/libgomp.c-c++-common/metadirective-2.c
new file mode 100644
index 00000000000..55a6098e525
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c-c++-common/metadirective-2.c
@@ -0,0 +1,41 @@
+/* { dg-do run } */
+
+#include <math.h>
+
+#define N 100
+#define EPSILON 0.001
+
+#pragma omp declare target
+void f(double a[], double x) {
+ int i;
+
+ #pragma omp metadirective \
+ when (construct={target}: distribute parallel for) \
+ default (parallel for simd)
+ for (i = 0; i < N; i++)
+ a[i] = x * i;
+}
+#pragma omp end declare target
+
+ int main()
+{
+ double a[N];
+ int i;
+
+ #pragma omp target teams map(from: a[0:N])
+ f (a, M_PI);
+
+ for (i = 0; i < N; i++)
+ if (fabs (a[i] - (M_PI * i)) > EPSILON)
+ return 1;
+
+ /* TODO: This does not execute a version of f with the default clause
+ active as might be expected. */
+ f (a, M_E); /* { dg-warning "direct calls to an offloadable function containing metadirectives with a 'construct={target}' selector may produce unexpected results" } */
+
+ for (i = 0; i < N; i++)
+ if (fabs (a[i] - (M_E * i)) > EPSILON)
+ return 1;
+
+ return 0;
+ }
diff --git a/libgomp/testsuite/libgomp.c-c++-common/metadirective-3.c b/libgomp/testsuite/libgomp.c-c++-common/metadirective-3.c
new file mode 100644
index 00000000000..e31daf2cb64
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c-c++-common/metadirective-3.c
@@ -0,0 +1,34 @@
+/* { dg-do run } */
+
+#define N 100
+
+int f (int a[], int flag)
+{
+ int i;
+ int res = 0;
+
+ #pragma omp metadirective \
+ when (user={condition(!flag)}: \
+ target teams distribute parallel for \
+ map(from: a[0:N]) private(res)) \
+ default (parallel for)
+ for (i = 0; i < N; i++)
+ {
+ a[i] = i;
+ res = 1;
+ }
+
+ return res;
+}
+
+int main (void)
+{
+ int a[N];
+
+ if (f (a, 0))
+ return 1;
+ if (!f (a, 1))
+ return 1;
+
+ return 0;
+}
diff --git a/libgomp/testsuite/libgomp.c-c++-common/metadirective-4.c b/libgomp/testsuite/libgomp.c-c++-common/metadirective-4.c
new file mode 100644
index 00000000000..7fc601eaba6
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c-c++-common/metadirective-4.c
@@ -0,0 +1,52 @@
+/* { dg-do run } */
+
+#include <omp.h>
+
+#define N 100
+
+int f (int a[], int run_parallel, int run_static)
+{
+ int is_parallel = 0;
+ int is_static = 0;
+
+ #pragma omp metadirective \
+ when (user={condition(run_parallel)}: parallel)
+ {
+ int i;
+
+ if (omp_in_parallel ())
+ is_parallel = 1;
+
+ #pragma omp metadirective \
+ when (construct={parallel}, user={condition(!run_static)}: \
+ for schedule(guided) private(is_static)) \
+ when (construct={parallel}: for schedule(static))
+ for (i = 0; i < N; i++)
+ {
+ a[i] = i;
+ is_static = 1;
+ }
+ }
+
+ return (is_parallel << 1) | is_static;
+}
+
+int main (void)
+{
+ int a[N];
+
+ /* is_static is always set if run_parallel is false. */
+ if (f (a, 0, 0) != 1)
+ return 1;
+
+ if (f (a, 0, 1) != 1)
+ return 1;
+
+ if (f (a, 1, 0) != 2)
+ return 1;
+
+ if (f (a, 1, 1) != 3)
+ return 1;
+
+ return 0;
+}
diff --git a/libgomp/testsuite/libgomp.c-c++-common/metadirective-5.c b/libgomp/testsuite/libgomp.c-c++-common/metadirective-5.c
new file mode 100644
index 00000000000..e8ab7ccb166
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c-c++-common/metadirective-5.c
@@ -0,0 +1,46 @@
+/* { dg-do run } */
+
+#define N 100
+
+#include <stdio.h>
+#include <omp.h>
+
+int f(int a[], int num)
+{
+ int on_device = 0;
+ int i;
+
+ #pragma omp metadirective \
+ when (target_device={device_num(num), kind("gpu")}: \
+ target parallel for map(to: a[0:N]), map(from: on_device)) \
+ default (parallel for private (on_device))
+ for (i = 0; i < N; i++)
+ {
+ a[i] += i;
+ on_device = 1;
+ }
+
+ return on_device;
+}
+
+int main (void)
+{
+ int a[N];
+ int on_device_count = 0;
+ int i;
+
+ for (i = 0; i < N; i++)
+ a[i] = i;
+
+ for (i = 0; i <= omp_get_num_devices (); i++)
+ on_device_count += f (a, i);
+
+ if (on_device_count != omp_get_num_devices ())
+ return 1;
+
+ for (i = 0; i < N; i++)
+ if (a[i] != 2 * i)
+ return 2;
+
+ return 0;
+}
--
2.25.1
^ permalink raw reply [flat|nested] 13+ messages in thread
* [PATCH 07/12] OpenMP: Fortran front-end support for metadirectives.
2024-05-04 21:21 [PATCH 00/12] OpenMP: Metadirective support + "declare variant" improvements Sandra Loosemore
` (5 preceding siblings ...)
2024-05-04 21:21 ` [PATCH 06/12] OpenMP: common c/c++ testcases " Sandra Loosemore
@ 2024-05-04 21:21 ` Sandra Loosemore
2024-05-04 21:21 ` [PATCH 08/12] OpenMP: Reject other properties with kind(any) Sandra Loosemore
` (4 subsequent siblings)
11 siblings, 0 replies; 13+ messages in thread
From: Sandra Loosemore @ 2024-05-04 21:21 UTC (permalink / raw)
To: gcc-patches; +Cc: jakub, tburnus
This patch adds support for metadirectives to the Fortran front end.
gcc/fortran/ChangeLog
* decl.cc (gfc_match_end): Handle metadirectives.
* dump-parse-tree.cc (show_omp_node): Likewise.
(show_code_node): Likewise.
* gfortran.h (enum gfc_statement): Add ST_OMP_METADIRECTIVE.
(struct gfc_omp_clauses): Rename target_first_st_is_teams field to
target_first_st_is_teams_or_meta.
(struct gfc_omp_variant): New.
(struct gfc_st_label): Add omp_region field.
(gfc_exec_op): Add EXEC_OMP_METADIRECTIVE.
(struct gfc_code): Add omp_variants field.
(gfc_free_omp_variants): Declare.
(match_omp_directive): Declare.
(is_omp_declarative_stmt): Declare.
* io.cc (format_asterisk): Add initializer for new omp_region field.
* match.h (gfc_match_omp_begin_metadirective): Declare.
(gfc_match_omp_metadirective): Declare.
* openmp.cc (gfc_match_omp_eos): Special case for matching an
OpenMP context selector.
(gfc_free_omp_variants): New.
(gfc_match_omp_clauses): Remove context_selector parameter.
(match_omp): Adjust call to gfc_match_omp_clauses.
(gfc_match_omp_context_selector): Add metadirective_p parameter.
Adjust error-checking logic and calls to gfc_match_omp_clauses.
Set gfc_matching_omp_context_selector.
(gfc_match_omp_context_selector_specification): Generalize to take
a set selector list pointer as parameter, instead of a
declare variant pointer.
(gfc_match_omp_declare_variant): Adjust call to match above change.
(match_omp_metadirective): New.
(gfc_match_omp_begin_metadirective): New.
(gfc_match_omp_metadirective): New.
(resolve_omp_metadirective): New.
(resolve_omp_target): Handle metadirectives.
(gfc_resolve_omp_directive): Handle metadirectives.
* parse.cc (gfc_matching_omp_context_selector): New.
(gfc_in_metadirective_body): New.
(gfc_omp_region_count): New.
(decode_omp_directive): Handle "begin metadirective", "end
metadirective", and "metadirective".
(match_omp_directive): New.
(case_omp_structured_block): New define.
(case_omp_do): New define.
(gfc_ascii_statement): Handle ST_OMP_BEGIN_METADIRECTIVE,
ST_OMP_END_METADIRECTIVE, and ST_OMP_METADIRECTIVE.
(accept_statement): Handle ST_OMP_BEGIN_METADIRECTIVE and
ST_OMP_METADIRECTIVE.
(gfc_omp_end_stmt): New.
(parse_omp_do): Use gfc_omp_end_stmt. Special-case
"omp end metadirective" to end the current construct.
(parse_omp_structured_block): Likewise. Adjust setting of
target_first_st_is_teams_or_meta flag.
(parse_omp_metadirective_body): New.
(parse_executable): Handle metadirectives. Use
case_omp_structured_block and case_omp_do here.
(gfc_parse_file): Initialize gfc_omp_region_count,
gfc_in_metadirective_body, and gfc_matching_omp_context_selector.
(is_omp_declarative_stmt): New.
* parse.h (enum gfc_compile_state): Add metadirective constructs.
(gfc_omp_end_stmt): Declare.
(gfc_matching_omp_context_selector): Declare.
(gfc_in_metadirective_body): Declare.
(gfc_omp_region_count): Declare.
* resolve.cc (gfc_resolve_code): Handle EXEC_OMP_METADIRECTIVE.
* st.cc (gfc_free_statement): Handle EXEC_OMP_METADIRECTIVE.
* symbol.cc (compare_st_labels): Compare omp_region, not just the
value.
(gfc_get_st_label): Likewise. Initialize the omp_region field when
creating a new label.
* trans-decl.cc (gfc_get_label_decl): Encode the omp_region in the
label name.
* trans-openmp.cc (gfc_trans_omp_directive): Handle
EXEC_OMP_METADIRECTIVE.
(gfc_trans_omp_set_selector): New, split from...
(gfc_trans_omp_declare_variant): ...here.
(gfc_trans_omp_metadirective): New.
* trans-stmt.h (gfc_trans_omp_metadirective): Declare.
* trans.cc (trans_code): Handle EXEC_OMP_METADIRECTIVE.
gcc/testsuite/ChangeLog
* gfortran.dg/gomp/metadirective-1.f90: New.
* gfortran.dg/gomp/metadirective-10.f90: New.
* gfortran.dg/gomp/metadirective-11.f90: New.
* gfortran.dg/gomp/metadirective-2.f90: New.
* gfortran.dg/gomp/metadirective-3.f90: New.
* gfortran.dg/gomp/metadirective-4.f90: New.
* gfortran.dg/gomp/metadirective-5.f90: New.
* gfortran.dg/gomp/metadirective-6.f90: New.
* gfortran.dg/gomp/metadirective-7.f90: New.
* gfortran.dg/gomp/metadirective-8.f90: New.
* gfortran.dg/gomp/metadirective-9.f90: New.
* gfortran.dg/gomp/metadirective-construct.f90: New.
* gfortran.dg/gomp/metadirective-no-score.f90: New.
* gfortran.dg/gomp/pure-1.f90: Add metadirective test.
* gfortran.dg/gomp/pure-2.f90: Remove metadirective test.
libgomp/ChangeLog
* testsuite/libgomp.fortran/metadirective-1.f90: New.
* testsuite/libgomp.fortran/metadirective-2.f90: New.
* testsuite/libgomp.fortran/metadirective-3.f90: New.
* testsuite/libgomp.fortran/metadirective-4.f90: New.
* testsuite/libgomp.fortran/metadirective-5.f90: New.
* testsuite/libgomp.fortran/metadirective-6.f90: New.
Co-Authored-By: Kwok Cheung Yeung <kcy@codesourcery.com>
Co-Authored-By: Sandra Loosemore <sandra@codesourcery.com>
Co-Authored-By: Tobias Burnus <tobias@codesourcery.com>
Co-Authored-By: Paul-Antoine Arras <pa@codesourcery.com>
---
gcc/fortran/decl.cc | 29 +
gcc/fortran/dump-parse-tree.cc | 21 +
gcc/fortran/gfortran.h | 20 +-
gcc/fortran/io.cc | 2 +-
gcc/fortran/match.h | 2 +
gcc/fortran/openmp.cc | 294 +++++++--
gcc/fortran/parse.cc | 571 +++++++++++-------
gcc/fortran/parse.h | 8 +-
gcc/fortran/resolve.cc | 6 +
gcc/fortran/st.cc | 4 +
gcc/fortran/symbol.cc | 25 +-
gcc/fortran/trans-decl.cc | 5 +-
gcc/fortran/trans-openmp.cc | 233 ++++---
gcc/fortran/trans-stmt.h | 1 +
gcc/fortran/trans.cc | 1 +
.../gfortran.dg/gomp/metadirective-1.f90 | 55 ++
.../gfortran.dg/gomp/metadirective-10.f90 | 40 ++
.../gfortran.dg/gomp/metadirective-11.f90 | 33 +
.../gfortran.dg/gomp/metadirective-2.f90 | 62 ++
.../gfortran.dg/gomp/metadirective-3.f90 | 34 ++
.../gfortran.dg/gomp/metadirective-4.f90 | 39 ++
.../gfortran.dg/gomp/metadirective-5.f90 | 30 +
.../gfortran.dg/gomp/metadirective-6.f90 | 31 +
.../gfortran.dg/gomp/metadirective-7.f90 | 36 ++
.../gfortran.dg/gomp/metadirective-8.f90 | 22 +
.../gfortran.dg/gomp/metadirective-9.f90 | 30 +
.../gomp/metadirective-construct.f90 | 260 ++++++++
.../gomp/metadirective-no-score.f90 | 122 ++++
gcc/testsuite/gfortran.dg/gomp/pure-1.f90 | 7 +
gcc/testsuite/gfortran.dg/gomp/pure-2.f90 | 8 -
.../libgomp.fortran/metadirective-1.f90 | 61 ++
.../libgomp.fortran/metadirective-2.f90 | 40 ++
.../libgomp.fortran/metadirective-3.f90 | 29 +
.../libgomp.fortran/metadirective-4.f90 | 46 ++
.../libgomp.fortran/metadirective-5.f90 | 44 ++
.../libgomp.fortran/metadirective-6.f90 | 58 ++
36 files changed, 1947 insertions(+), 362 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/gomp/metadirective-1.f90
create mode 100644 gcc/testsuite/gfortran.dg/gomp/metadirective-10.f90
create mode 100644 gcc/testsuite/gfortran.dg/gomp/metadirective-11.f90
create mode 100644 gcc/testsuite/gfortran.dg/gomp/metadirective-2.f90
create mode 100644 gcc/testsuite/gfortran.dg/gomp/metadirective-3.f90
create mode 100644 gcc/testsuite/gfortran.dg/gomp/metadirective-4.f90
create mode 100644 gcc/testsuite/gfortran.dg/gomp/metadirective-5.f90
create mode 100644 gcc/testsuite/gfortran.dg/gomp/metadirective-6.f90
create mode 100644 gcc/testsuite/gfortran.dg/gomp/metadirective-7.f90
create mode 100644 gcc/testsuite/gfortran.dg/gomp/metadirective-8.f90
create mode 100644 gcc/testsuite/gfortran.dg/gomp/metadirective-9.f90
create mode 100644 gcc/testsuite/gfortran.dg/gomp/metadirective-construct.f90
create mode 100644 gcc/testsuite/gfortran.dg/gomp/metadirective-no-score.f90
create mode 100644 libgomp/testsuite/libgomp.fortran/metadirective-1.f90
create mode 100644 libgomp/testsuite/libgomp.fortran/metadirective-2.f90
create mode 100644 libgomp/testsuite/libgomp.fortran/metadirective-3.f90
create mode 100644 libgomp/testsuite/libgomp.fortran/metadirective-4.f90
create mode 100644 libgomp/testsuite/libgomp.fortran/metadirective-5.f90
create mode 100644 libgomp/testsuite/libgomp.fortran/metadirective-6.f90
diff --git a/gcc/fortran/decl.cc b/gcc/fortran/decl.cc
index b8308aeee55..b6633a913e7 100644
--- a/gcc/fortran/decl.cc
+++ b/gcc/fortran/decl.cc
@@ -8422,6 +8422,7 @@ gfc_match_end (gfc_statement *st)
case COMP_CONTAINS:
case COMP_DERIVED_CONTAINS:
+ case COMP_OMP_BEGIN_METADIRECTIVE:
state = gfc_state_stack->previous->state;
block_name = gfc_state_stack->previous->sym == NULL
? NULL : gfc_state_stack->previous->sym->name;
@@ -8429,6 +8430,28 @@ gfc_match_end (gfc_statement *st)
&& gfc_state_stack->previous->sym->abr_modproc_decl;
break;
+ case COMP_OMP_METADIRECTIVE:
+ {
+ /* Metadirectives can be nested, so we need to drill down to the
+ first state that is not COMP_OMP_METADIRECTIVE. */
+ gfc_state_data *state_data = gfc_state_stack;
+
+ do
+ {
+ state_data = state_data->previous;
+ state = state_data->state;
+ block_name = (state_data->sym == NULL
+ ? NULL : state_data->sym->name);
+ abbreviated_modproc_decl = (state_data->sym
+ && state_data->sym->abr_modproc_decl);
+ }
+ while (state == COMP_OMP_METADIRECTIVE);
+
+ if (block_name && startswith (block_name, "block@"))
+ block_name = NULL;
+ }
+ break;
+
default:
break;
}
@@ -8574,6 +8597,12 @@ gfc_match_end (gfc_statement *st)
gfc_free_enum_history ();
break;
+ case COMP_OMP_BEGIN_METADIRECTIVE:
+ *st = ST_OMP_END_METADIRECTIVE;
+ target = " metadirective";
+ eos_ok = 0;
+ break;
+
default:
gfc_error ("Unexpected END statement at %C");
goto cleanup;
diff --git a/gcc/fortran/dump-parse-tree.cc b/gcc/fortran/dump-parse-tree.cc
index 87a65036a3d..28dfdbb1a32 100644
--- a/gcc/fortran/dump-parse-tree.cc
+++ b/gcc/fortran/dump-parse-tree.cc
@@ -2173,6 +2173,7 @@ show_omp_node (int level, gfc_code *c)
case EXEC_OMP_MASTER: name = "MASTER"; break;
case EXEC_OMP_MASTER_TASKLOOP: name = "MASTER TASKLOOP"; break;
case EXEC_OMP_MASTER_TASKLOOP_SIMD: name = "MASTER TASKLOOP SIMD"; break;
+ case EXEC_OMP_METADIRECTIVE: name = "METADIRECTIVE"; break;
case EXEC_OMP_ORDERED: name = "ORDERED"; break;
case EXEC_OMP_DEPOBJ: name = "DEPOBJ"; break;
case EXEC_OMP_PARALLEL: name = "PARALLEL"; break;
@@ -2370,6 +2371,25 @@ show_omp_node (int level, gfc_code *c)
d = d->block;
}
}
+ else if (c->op == EXEC_OMP_METADIRECTIVE)
+ {
+ gfc_omp_variant *variant
+ = c->ext.omp_variants;
+
+ while (variant)
+ {
+ code_indent (level + 1, 0);
+ if (variant->selectors)
+ fputs ("WHEN ()\n", dumpfile);
+ else
+ fputs ("DEFAULT ()\n", dumpfile);
+ /* TODO: Print selector. */
+ show_code (level + 2, variant->code);
+ if (variant->next)
+ fputs ("\n", dumpfile);
+ variant = variant->next;
+ }
+ }
else
show_code (level + 1, c->block->next);
if (c->op == EXEC_OMP_ATOMIC)
@@ -3513,6 +3533,7 @@ show_code_node (int level, gfc_code *c)
case EXEC_OMP_MASTER:
case EXEC_OMP_MASTER_TASKLOOP:
case EXEC_OMP_MASTER_TASKLOOP_SIMD:
+ case EXEC_OMP_METADIRECTIVE:
case EXEC_OMP_ORDERED:
case EXEC_OMP_PARALLEL:
case EXEC_OMP_PARALLEL_DO:
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 58505446bac..ae5fcf8f847 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -317,6 +317,7 @@ enum gfc_statement
ST_OMP_END_PARALLEL_MASKED_TASKLOOP_SIMD, ST_OMP_MASKED_TASKLOOP,
ST_OMP_END_MASKED_TASKLOOP, ST_OMP_MASKED_TASKLOOP_SIMD,
ST_OMP_END_MASKED_TASKLOOP_SIMD, ST_OMP_SCOPE, ST_OMP_END_SCOPE,
+ ST_OMP_METADIRECTIVE, ST_OMP_BEGIN_METADIRECTIVE, ST_OMP_END_METADIRECTIVE,
ST_OMP_ERROR, ST_OMP_ASSUME, ST_OMP_END_ASSUME, ST_OMP_ASSUMES,
ST_OMP_ALLOCATE, ST_OMP_ALLOCATE_EXEC,
ST_OMP_ALLOCATORS, ST_OMP_END_ALLOCATORS,
@@ -1588,7 +1589,7 @@ typedef struct gfc_omp_clauses
unsigned order_unconstrained:1, order_reproducible:1, capture:1;
unsigned grainsize_strict:1, num_tasks_strict:1, compare:1, weak:1;
unsigned non_rectangular:1, order_concurrent:1;
- unsigned contains_teams_construct:1, target_first_st_is_teams:1;
+ unsigned contains_teams_construct:1, target_first_st_is_teams_or_meta:1;
unsigned contained_in_target_construct:1, indirect:1;
ENUM_BITFIELD (gfc_omp_sched_kind) sched_kind:3;
ENUM_BITFIELD (gfc_omp_device_type) device_type:2;
@@ -1708,6 +1709,17 @@ typedef struct gfc_omp_declare_variant
gfc_omp_declare_variant;
#define gfc_get_omp_declare_variant() XCNEW (gfc_omp_declare_variant)
+typedef struct gfc_omp_variant
+{
+ struct gfc_omp_variant *next;
+ locus where; /* Where the metadirective clause occurred. */
+
+ gfc_omp_set_selector *selectors;
+ enum gfc_statement stmt;
+ struct gfc_code *code;
+
+} gfc_omp_variant;
+#define gfc_get_omp_variant() XCNEW (gfc_omp_variant)
typedef struct gfc_omp_udr
{
@@ -1756,6 +1768,7 @@ typedef struct gfc_st_label
locus where;
gfc_namespace *ns;
+ int omp_region;
}
gfc_st_label;
@@ -3028,6 +3041,7 @@ enum gfc_exec_op
EXEC_OMP_TARGET_TEAMS_LOOP, EXEC_OMP_MASKED, EXEC_OMP_PARALLEL_MASKED,
EXEC_OMP_PARALLEL_MASKED_TASKLOOP, EXEC_OMP_PARALLEL_MASKED_TASKLOOP_SIMD,
EXEC_OMP_MASKED_TASKLOOP, EXEC_OMP_MASKED_TASKLOOP_SIMD, EXEC_OMP_SCOPE,
+ EXEC_OMP_METADIRECTIVE,
EXEC_OMP_ERROR, EXEC_OMP_ALLOCATE, EXEC_OMP_ALLOCATORS
};
@@ -3086,6 +3100,7 @@ typedef struct gfc_code
gfc_omp_clauses *omp_clauses;
const char *omp_name;
gfc_omp_namelist *omp_namelist;
+ gfc_omp_variant *omp_variants;
bool omp_bool;
}
ext; /* Points to additional structures required by statement */
@@ -3686,6 +3701,7 @@ void gfc_free_omp_declare_variant_list (gfc_omp_declare_variant *list);
void gfc_free_omp_declare_simd (gfc_omp_declare_simd *);
void gfc_free_omp_declare_simd_list (gfc_omp_declare_simd *);
void gfc_free_omp_udr (gfc_omp_udr *);
+void gfc_free_omp_variants (gfc_omp_variant *);
gfc_omp_udr *gfc_omp_udr_find (gfc_symtree *, gfc_typespec *);
void gfc_resolve_omp_allocate (gfc_namespace *, gfc_omp_namelist *);
void gfc_resolve_omp_assumptions (gfc_omp_assumptions *);
@@ -3970,6 +3986,8 @@ void debug (gfc_expr *);
bool gfc_parse_file (void);
void gfc_global_used (gfc_gsymbol *, locus *);
gfc_namespace* gfc_build_block_ns (gfc_namespace *);
+gfc_statement match_omp_directive (void);
+bool is_omp_declarative_stmt (gfc_statement);
/* dependency.cc */
int gfc_dep_compare_functions (gfc_expr *, gfc_expr *, bool);
diff --git a/gcc/fortran/io.cc b/gcc/fortran/io.cc
index 6fd69f7c9a8..9dfb4e1ef25 100644
--- a/gcc/fortran/io.cc
+++ b/gcc/fortran/io.cc
@@ -29,7 +29,7 @@ along with GCC; see the file COPYING3. If not see
gfc_st_label
format_asterisk = {0, NULL, NULL, -1, ST_LABEL_FORMAT, ST_LABEL_FORMAT, NULL,
- 0, {NULL, NULL}, NULL};
+ 0, {NULL, NULL}, NULL, 0};
typedef struct
{
diff --git a/gcc/fortran/match.h b/gcc/fortran/match.h
index b09921357fd..b0f5528ee72 100644
--- a/gcc/fortran/match.h
+++ b/gcc/fortran/match.h
@@ -155,6 +155,7 @@ match gfc_match_omp_assume (void);
match gfc_match_omp_assumes (void);
match gfc_match_omp_atomic (void);
match gfc_match_omp_barrier (void);
+match gfc_match_omp_begin_metadirective (void);
match gfc_match_omp_cancel (void);
match gfc_match_omp_cancellation_point (void);
match gfc_match_omp_critical (void);
@@ -178,6 +179,7 @@ match gfc_match_omp_masked_taskloop_simd (void);
match gfc_match_omp_master (void);
match gfc_match_omp_master_taskloop (void);
match gfc_match_omp_master_taskloop_simd (void);
+match gfc_match_omp_metadirective (void);
match gfc_match_omp_nothing (void);
match gfc_match_omp_ordered (void);
match gfc_match_omp_ordered_depend (void);
diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc
index 315ec68f259..c40205853f8 100644
--- a/gcc/fortran/openmp.cc
+++ b/gcc/fortran/openmp.cc
@@ -113,7 +113,8 @@ static const struct gfc_omp_directive gfc_omp_directives[] = {
/* Match an end of OpenMP directive. End of OpenMP directive is optional
- whitespace, followed by '\n' or comment '!'. */
+ whitespace, followed by '\n' or comment '!'. In the special case where a
+ context selector is being matched, match against ')' instead. */
static match
gfc_match_omp_eos (void)
@@ -124,17 +125,25 @@ gfc_match_omp_eos (void)
old_loc = gfc_current_locus;
gfc_gobble_whitespace ();
- c = gfc_next_ascii_char ();
- switch (c)
+ if (gfc_matching_omp_context_selector)
{
- case '!':
- do
- c = gfc_next_ascii_char ();
- while (c != '\n');
- /* Fall through */
+ if (gfc_peek_ascii_char () == ')')
+ return MATCH_YES;
+ }
+ else
+ {
+ c = gfc_next_ascii_char ();
+ switch (c)
+ {
+ case '!':
+ do
+ c = gfc_next_ascii_char ();
+ while (c != '\n');
+ /* Fall through */
- case '\n':
- return MATCH_YES;
+ case '\n':
+ return MATCH_YES;
+ }
}
gfc_current_locus = old_loc;
@@ -340,6 +349,19 @@ gfc_free_omp_udr (gfc_omp_udr *omp_udr)
}
}
+/* Free variants of an !$omp metadirective construct. */
+
+void
+gfc_free_omp_variants (gfc_omp_variant *variant)
+{
+ while (variant)
+ {
+ gfc_omp_variant *next_variant = variant->next;
+ gfc_free_omp_set_selector_list (variant->selectors);
+ free (variant);
+ variant = next_variant;
+ }
+}
static gfc_omp_udr *
gfc_find_omp_udr (gfc_namespace *ns, const char *name, gfc_typespec *ts)
@@ -1868,8 +1890,7 @@ gfc_match_dupl_atomic (bool not_dupl, const char *name)
static match
gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
bool first = true, bool needs_space = true,
- bool openacc = false, bool context_selector = false,
- bool openmp_target = false)
+ bool openacc = false, bool openmp_target = false)
{
bool error = false;
gfc_omp_clauses *c = gfc_get_omp_clauses ();
@@ -3831,9 +3852,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
}
end:
- if (error
- || (context_selector && gfc_peek_ascii_char () != ')')
- || (!context_selector && gfc_match_omp_eos () != MATCH_YES))
+ if (error || gfc_match_omp_eos () != MATCH_YES)
{
if (!gfc_error_flag_test ())
gfc_error ("Failed to match clause at %C");
@@ -4536,7 +4555,7 @@ static match
match_omp (gfc_exec_op op, const omp_mask mask)
{
gfc_omp_clauses *c;
- if (gfc_match_omp_clauses (&c, mask, true, true, false, false,
+ if (gfc_match_omp_clauses (&c, mask, true, true, false,
op == EXEC_OMP_TARGET) != MATCH_YES)
return MATCH_ERROR;
new_st.op = op;
@@ -5717,7 +5736,8 @@ gfc_ignore_trait_property_extension_list (void)
score(score-expression) */
match
-gfc_match_omp_context_selector (gfc_omp_set_selector *oss)
+gfc_match_omp_context_selector (gfc_omp_set_selector *oss,
+ bool metadirective_p)
{
do
{
@@ -5877,14 +5897,27 @@ gfc_match_omp_context_selector (gfc_omp_set_selector *oss)
|| (property_kind == OMP_TRAIT_PROPERTY_DEV_NUM_EXPR
&& otp->expr->ts.type != BT_INTEGER)
|| otp->expr->rank != 0
- || otp->expr->expr_type != EXPR_CONSTANT)
+ || (!metadirective_p
+ && otp->expr->expr_type != EXPR_CONSTANT))
{
- if (property_kind == OMP_TRAIT_PROPERTY_BOOL_EXPR)
- gfc_error ("property must be a constant logical expression "
- "at %C");
+ if (metadirective_p)
+ {
+ if (property_kind == OMP_TRAIT_PROPERTY_BOOL_EXPR)
+ gfc_error ("property must be a "
+ "logical expression at %C");
+ else
+ gfc_error ("property must be an "
+ "integer expression at %C");
+ }
else
- gfc_error ("property must be a constant integer expression "
- "at %C");
+ {
+ if (property_kind == OMP_TRAIT_PROPERTY_BOOL_EXPR)
+ gfc_error ("property must be a constant "
+ "logical expression at %C");
+ else
+ gfc_error ("property must be a constant "
+ "integer expression at %C");
+ }
return MATCH_ERROR;
}
/* Device number must be conforming, which includes
@@ -5904,14 +5937,17 @@ gfc_match_omp_context_selector (gfc_omp_set_selector *oss)
{
if (os->code == OMP_TRAIT_CONSTRUCT_SIMD)
{
+ gfc_matching_omp_context_selector = true;
if (gfc_match_omp_clauses (&otp->clauses,
OMP_DECLARE_SIMD_CLAUSES,
- true, false, false, true)
+ true, false, false)
!= MATCH_YES)
{
+ gfc_matching_omp_context_selector = false;
gfc_error ("expected simd clause at %C");
return MATCH_ERROR;
}
+ gfc_matching_omp_context_selector = false;
}
else if (os->code == OMP_TRAIT_IMPLEMENTATION_REQUIRES)
{
@@ -5968,7 +6004,8 @@ gfc_match_omp_context_selector (gfc_omp_set_selector *oss)
user */
match
-gfc_match_omp_context_selector_specification (gfc_omp_declare_variant *odv)
+gfc_match_omp_context_selector_specification (gfc_omp_set_selector **oss_head,
+ bool metadirective_p)
{
do
{
@@ -6001,11 +6038,11 @@ gfc_match_omp_context_selector_specification (gfc_omp_declare_variant *odv)
}
gfc_omp_set_selector *oss = gfc_get_omp_set_selector ();
- oss->next = odv->set_selectors;
+ oss->next = *oss_head;
oss->code = set;
- odv->set_selectors = oss;
+ *oss_head = oss;
- if (gfc_match_omp_context_selector (oss) != MATCH_YES)
+ if (gfc_match_omp_context_selector (oss, metadirective_p) != MATCH_YES)
return MATCH_ERROR;
m = gfc_match (" }");
@@ -6104,7 +6141,9 @@ gfc_match_omp_declare_variant (void)
return MATCH_ERROR;
}
- if (gfc_match_omp_context_selector_specification (odv) != MATCH_YES)
+ if (gfc_match_omp_context_selector_specification (&odv->set_selectors,
+ false)
+ != MATCH_YES)
return MATCH_ERROR;
if (gfc_match (" )") != MATCH_YES)
@@ -6120,6 +6159,154 @@ gfc_match_omp_declare_variant (void)
}
+static match
+match_omp_metadirective (bool begin_p)
+{
+ locus old_loc = gfc_current_locus;
+ gfc_omp_variant *variants_head;
+ gfc_omp_variant **next_variant = &variants_head;
+ bool default_seen = false;
+
+ /* Parse the context selectors. */
+ for (;;)
+ {
+ bool default_p = false;
+ gfc_omp_set_selector *selectors = NULL;
+ locus variant_locus = gfc_current_locus;
+
+ if (gfc_match (" default ( ") == MATCH_YES)
+ default_p = true;
+ else if (gfc_match (" otherwise ( ") == MATCH_YES)
+ default_p = true;
+ else if (gfc_match_eos () == MATCH_YES)
+ break;
+ else if (gfc_match (" when ( ") != MATCH_YES)
+ {
+ gfc_error ("expected %<when%>, %<otherwise%>, or %<default%> at %C");
+ gfc_current_locus = old_loc;
+ return MATCH_ERROR;
+ }
+
+ if (default_p && default_seen)
+ {
+ gfc_error ("too many %<otherwise%> or %<default%> clauses "
+ "in %<metadirective%> at %C");
+ gfc_current_locus = old_loc;
+ return MATCH_ERROR;
+ }
+
+ if (!default_p)
+ {
+ if (gfc_match_omp_context_selector_specification (&selectors, true)
+ != MATCH_YES)
+ return MATCH_ERROR;
+
+ if (gfc_match (" : ") != MATCH_YES)
+ {
+ gfc_error ("expected %<:%> at %C");
+ gfc_current_locus = old_loc;
+ return MATCH_ERROR;
+ }
+
+ gfc_commit_symbols ();
+ }
+
+ gfc_matching_omp_context_selector = true;
+ gfc_statement directive = match_omp_directive ();
+ gfc_matching_omp_context_selector = false;
+
+ if (is_omp_declarative_stmt (directive))
+ sorry ("declarative directive variants are not supported");
+
+ if (gfc_error_flag_test ())
+ {
+ gfc_current_locus = old_loc;
+ return MATCH_ERROR;
+ }
+
+ if (gfc_match (" )") != MATCH_YES)
+ {
+ gfc_error ("Expected %<)%> at %C");
+ gfc_current_locus = old_loc;
+ return MATCH_ERROR;
+ }
+
+ gfc_commit_symbols ();
+
+ if (begin_p && directive != ST_NONE
+ && gfc_omp_end_stmt (directive) == ST_NONE)
+ {
+ gfc_error ("variant directive used in OMP BEGIN METADIRECTIVE "
+ "at %C must have a corresponding end directive");
+ gfc_current_locus = old_loc;
+ return MATCH_ERROR;
+ }
+
+ if (default_p)
+ default_seen = true;
+
+ gfc_omp_variant *omv = gfc_get_omp_variant ();
+ omv->selectors = selectors;
+ omv->stmt = directive;
+ omv->where = variant_locus;
+
+ if (directive == ST_NONE)
+ {
+ /* The directive was a 'nothing' directive. */
+ omv->code = gfc_get_code (EXEC_CONTINUE);
+ omv->code->ext.omp_clauses = NULL;
+ }
+ else
+ {
+ omv->code = gfc_get_code (new_st.op);
+ omv->code->ext.omp_clauses = new_st.ext.omp_clauses;
+ /* Prevent the OpenMP clauses from being freed via NEW_ST. */
+ new_st.ext.omp_clauses = NULL;
+ }
+
+ *next_variant = omv;
+ next_variant = &omv->next;
+ }
+
+ if (gfc_match_omp_eos () != MATCH_YES)
+ {
+ gfc_error ("Unexpected junk after OMP METADIRECTIVE at %C");
+ gfc_current_locus = old_loc;
+ return MATCH_ERROR;
+ }
+
+ /* Add a 'default (nothing)' clause if no default is explicitly given. */
+ if (!default_seen)
+ {
+ gfc_omp_variant *omv = gfc_get_omp_variant ();
+ omv->stmt = ST_NONE;
+ omv->code = gfc_get_code (EXEC_CONTINUE);
+ omv->code->ext.omp_clauses = NULL;
+ omv->where = old_loc;
+ omv->selectors = NULL;
+
+ *next_variant = omv;
+ next_variant = &omv->next;
+ }
+
+ new_st.op = EXEC_OMP_METADIRECTIVE;
+ new_st.ext.omp_variants = variants_head;
+
+ return MATCH_YES;
+}
+
+match
+gfc_match_omp_begin_metadirective (void)
+{
+ return match_omp_metadirective (true);
+}
+
+match
+gfc_match_omp_metadirective (void)
+{
+ return match_omp_metadirective (false);
+}
+
match
gfc_match_omp_threadprivate (void)
{
@@ -11013,6 +11200,19 @@ resolve_omp_do (gfc_code *code)
restructure_intervening_code (&(code->block->next), code, count);
}
+static void
+resolve_omp_metadirective (gfc_code *code, gfc_namespace *ns)
+{
+ gfc_omp_variant *variant = code->ext.omp_variants;
+
+ while (variant)
+ {
+ gfc_code *variant_code = variant->code;
+ gfc_resolve_code (variant_code, ns);
+ variant = variant->next;
+ }
+}
+
static gfc_statement
omp_code_to_statement (gfc_code *code)
@@ -11556,13 +11756,32 @@ resolve_omp_target (gfc_code *code)
gfc_code *c = code->block->next;
if (c->op == EXEC_BLOCK)
c = c->ext.block.ns->code;
- if (code->ext.omp_clauses->target_first_st_is_teams
- && ((GFC_IS_TEAMS_CONSTRUCT (c->op) && c->next == NULL)
- || (c->op == EXEC_BLOCK
- && c->next
- && GFC_IS_TEAMS_CONSTRUCT (c->next->op)
- && c->next->next == NULL)))
- return;
+ if (code->ext.omp_clauses->target_first_st_is_teams_or_meta)
+ {
+ if (c->op == EXEC_OMP_METADIRECTIVE)
+ {
+ struct gfc_omp_variant *mc
+ = c->ext.omp_variants;
+ /* All mc->(next...->)code should be identical with regards
+ to the diagnostic below. */
+ do
+ {
+ if (mc->stmt != ST_NONE
+ && GFC_IS_TEAMS_CONSTRUCT (mc->code->op))
+ {
+ if (c->next == NULL && mc->code->next == NULL)
+ return;
+ c = mc->code;
+ break;
+ }
+ mc = mc->next;
+ }
+ while (mc);
+ }
+ else if (GFC_IS_TEAMS_CONSTRUCT (c->op) && c->next == NULL)
+ return;
+ }
+
while (c && !GFC_IS_TEAMS_CONSTRUCT (c->op))
c = c->next;
if (c)
@@ -11689,6 +11908,9 @@ gfc_resolve_omp_directive (gfc_code *code, gfc_namespace *ns)
code->ext.omp_clauses->if_present = false;
resolve_omp_clauses (code, code->ext.omp_clauses, ns);
break;
+ case EXEC_OMP_METADIRECTIVE:
+ resolve_omp_metadirective (code, ns);
+ break;
default:
break;
}
diff --git a/gcc/fortran/parse.cc b/gcc/fortran/parse.cc
index 79c810c86ba..24a444cb542 100644
--- a/gcc/fortran/parse.cc
+++ b/gcc/fortran/parse.cc
@@ -48,6 +48,10 @@ gfc_state_data *gfc_state_stack;
static bool last_was_use_stmt = false;
bool in_exec_part;
+bool gfc_matching_omp_context_selector;
+bool gfc_in_metadirective_body;
+int gfc_omp_region_count;
+
/* TODO: Re-order functions to kill these forward decls. */
static void check_statement_label (gfc_statement);
static void undo_new_statement (void);
@@ -1041,6 +1045,8 @@ decode_omp_directive (void)
break;
case 'b':
matcho ("barrier", gfc_match_omp_barrier, ST_OMP_BARRIER);
+ matcho ("begin metadirective", gfc_match_omp_begin_metadirective,
+ ST_OMP_BEGIN_METADIRECTIVE);
break;
case 'c':
matcho ("cancellation% point", gfc_match_omp_cancellation_point,
@@ -1085,6 +1091,8 @@ decode_omp_directive (void)
matcho ("end master taskloop", gfc_match_omp_eos_error,
ST_OMP_END_MASTER_TASKLOOP);
matcho ("end master", gfc_match_omp_eos_error, ST_OMP_END_MASTER);
+ matcho ("end metadirective", gfc_match_omp_eos_error,
+ ST_OMP_END_METADIRECTIVE);
matchs ("end ordered", gfc_match_omp_eos_error, ST_OMP_END_ORDERED);
matchs ("end parallel do simd", gfc_match_omp_eos_error,
ST_OMP_END_PARALLEL_DO_SIMD);
@@ -1168,6 +1176,8 @@ decode_omp_directive (void)
matcho ("master taskloop", gfc_match_omp_master_taskloop,
ST_OMP_MASTER_TASKLOOP);
matcho ("master", gfc_match_omp_master, ST_OMP_MASTER);
+ matcho ("metadirective", gfc_match_omp_metadirective,
+ ST_OMP_METADIRECTIVE);
break;
case 'n':
matcho ("nothing", gfc_match_omp_nothing, ST_NONE);
@@ -1296,6 +1306,10 @@ decode_omp_directive (void)
gfc_error_now ("Unclassifiable OpenMP directive at %C");
}
+ /* If parsing a metadirective, let the caller deal with the cleanup. */
+ if (gfc_matching_omp_context_selector)
+ return ST_NONE;
+
reject_statement ();
gfc_error_recovery ();
@@ -1413,6 +1427,12 @@ decode_omp_directive (void)
return ST_GET_FCN_CHARACTERISTICS;
}
+gfc_statement
+match_omp_directive (void)
+{
+ return decode_omp_directive ();
+}
+
static gfc_statement
decode_gcc_attribute (void)
{
@@ -1936,6 +1956,43 @@ next_statement (void)
case ST_OMP_DECLARE_VARIANT: case ST_OMP_ALLOCATE: case ST_OMP_ASSUMES: \
case ST_OMP_REQUIRES: case ST_OACC_ROUTINE: case ST_OACC_DECLARE
+/* OpenMP statements that are followed by a structured block. */
+
+#define case_omp_structured_block case ST_OMP_ASSUME: case ST_OMP_PARALLEL: \
+ case ST_OMP_PARALLEL_MASKED: case ST_OMP_PARALLEL_MASTER: \
+ case ST_OMP_PARALLEL_SECTIONS: case ST_OMP_ORDERED: \
+ case ST_OMP_CRITICAL: case ST_OMP_MASKED: case ST_OMP_MASTER: \
+ case ST_OMP_SCOPE: case ST_OMP_SECTIONS: case ST_OMP_SINGLE: \
+ case ST_OMP_TARGET: case ST_OMP_TARGET_DATA: case ST_OMP_TARGET_PARALLEL: \
+ case ST_OMP_TARGET_TEAMS: case ST_OMP_TEAMS: case ST_OMP_TASK: \
+ case ST_OMP_TASKGROUP: \
+ case ST_OMP_WORKSHARE: case ST_OMP_PARALLEL_WORKSHARE
+
+/* OpenMP statements that are followed by a do loop. */
+
+#define case_omp_do case ST_OMP_DISTRIBUTE: \
+ case ST_OMP_DISTRIBUTE_PARALLEL_DO: \
+ case ST_OMP_DISTRIBUTE_PARALLEL_DO_SIMD: case ST_OMP_DISTRIBUTE_SIMD: \
+ case ST_OMP_DO: case ST_OMP_DO_SIMD: case ST_OMP_LOOP: \
+ case ST_OMP_PARALLEL_DO: case ST_OMP_PARALLEL_DO_SIMD: \
+ case ST_OMP_PARALLEL_LOOP: case ST_OMP_PARALLEL_MASKED_TASKLOOP: \
+ case ST_OMP_PARALLEL_MASKED_TASKLOOP_SIMD: \
+ case ST_OMP_PARALLEL_MASTER_TASKLOOP: \
+ case ST_OMP_PARALLEL_MASTER_TASKLOOP_SIMD: \
+ case ST_OMP_MASKED_TASKLOOP: case ST_OMP_MASKED_TASKLOOP_SIMD: \
+ case ST_OMP_MASTER_TASKLOOP: case ST_OMP_MASTER_TASKLOOP_SIMD: \
+ case ST_OMP_SIMD: \
+ case ST_OMP_TARGET_PARALLEL_DO: case ST_OMP_TARGET_PARALLEL_DO_SIMD: \
+ case ST_OMP_TARGET_PARALLEL_LOOP: case ST_OMP_TARGET_SIMD: \
+ case ST_OMP_TARGET_TEAMS_DISTRIBUTE: \
+ case ST_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO: \
+ case ST_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: \
+ case ST_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD: case ST_OMP_TARGET_TEAMS_LOOP: \
+ case ST_OMP_TASKLOOP: case ST_OMP_TASKLOOP_SIMD: \
+ case ST_OMP_TEAMS_DISTRIBUTE: case ST_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO: \
+ case ST_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: \
+ case ST_OMP_TEAMS_DISTRIBUTE_SIMD: case ST_OMP_TEAMS_LOOP
+
/* Block end statements. Errors associated with interchanging these
are detected in gfc_match_end(). */
@@ -2573,6 +2630,9 @@ gfc_ascii_statement (gfc_statement st, bool strip_sentinel)
case ST_OMP_BARRIER:
p = "!$OMP BARRIER";
break;
+ case ST_OMP_BEGIN_METADIRECTIVE:
+ p = "!$OMP BEGIN METADIRECTIVE";
+ break;
case ST_OMP_CANCEL:
p = "!$OMP CANCEL";
break;
@@ -2672,6 +2732,9 @@ gfc_ascii_statement (gfc_statement st, bool strip_sentinel)
case ST_OMP_END_MASTER_TASKLOOP_SIMD:
p = "!$OMP END MASTER TASKLOOP SIMD";
break;
+ case ST_OMP_END_METADIRECTIVE:
+ p = "!$OMP END METADIRECTIVE";
+ break;
case ST_OMP_END_ORDERED:
p = "!$OMP END ORDERED";
break;
@@ -2816,6 +2879,9 @@ gfc_ascii_statement (gfc_statement st, bool strip_sentinel)
case ST_OMP_MASTER_TASKLOOP_SIMD:
p = "!$OMP MASTER TASKLOOP SIMD";
break;
+ case ST_OMP_METADIRECTIVE:
+ p = "!$OMP METADIRECTIVE";
+ break;
case ST_OMP_ORDERED:
case ST_OMP_ORDERED_DEPEND:
p = "!$OMP ORDERED";
@@ -3076,6 +3142,8 @@ accept_statement (gfc_statement st)
break;
case ST_ENTRY:
+ case ST_OMP_METADIRECTIVE:
+ case ST_OMP_BEGIN_METADIRECTIVE:
case_executable:
case_exec_markers:
add_statement ();
@@ -5437,6 +5505,140 @@ loop:
accept_statement (st);
}
+/* Get the corresponding ending statement type for the OpenMP directive
+ OMP_ST. If it does not have one, return ST_NONE. */
+
+gfc_statement
+gfc_omp_end_stmt (gfc_statement omp_st,
+ bool omp_do_p, bool omp_structured_p)
+{
+ if (omp_do_p)
+ {
+ switch (omp_st)
+ {
+ case ST_OMP_DISTRIBUTE: return ST_OMP_END_DISTRIBUTE;
+ case ST_OMP_DISTRIBUTE_PARALLEL_DO:
+ return ST_OMP_END_DISTRIBUTE_PARALLEL_DO;
+ case ST_OMP_DISTRIBUTE_PARALLEL_DO_SIMD:
+ return ST_OMP_END_DISTRIBUTE_PARALLEL_DO_SIMD;
+ case ST_OMP_DISTRIBUTE_SIMD:
+ return ST_OMP_END_DISTRIBUTE_SIMD;
+ case ST_OMP_DO: return ST_OMP_END_DO;
+ case ST_OMP_DO_SIMD: return ST_OMP_END_DO_SIMD;
+ case ST_OMP_LOOP: return ST_OMP_END_LOOP;
+ case ST_OMP_PARALLEL_DO: return ST_OMP_END_PARALLEL_DO;
+ case ST_OMP_PARALLEL_DO_SIMD:
+ return ST_OMP_END_PARALLEL_DO_SIMD;
+ case ST_OMP_PARALLEL_LOOP:
+ return ST_OMP_END_PARALLEL_LOOP;
+ case ST_OMP_SIMD: return ST_OMP_END_SIMD;
+ case ST_OMP_TARGET_PARALLEL_DO:
+ return ST_OMP_END_TARGET_PARALLEL_DO;
+ case ST_OMP_TARGET_PARALLEL_DO_SIMD:
+ return ST_OMP_END_TARGET_PARALLEL_DO_SIMD;
+ case ST_OMP_TARGET_PARALLEL_LOOP:
+ return ST_OMP_END_TARGET_PARALLEL_LOOP;
+ case ST_OMP_TARGET_SIMD: return ST_OMP_END_TARGET_SIMD;
+ case ST_OMP_TARGET_TEAMS_DISTRIBUTE:
+ return ST_OMP_END_TARGET_TEAMS_DISTRIBUTE;
+ case ST_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO:
+ return ST_OMP_END_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO;
+ case ST_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
+ return ST_OMP_END_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD;
+ case ST_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD:
+ return ST_OMP_END_TARGET_TEAMS_DISTRIBUTE_SIMD;
+ case ST_OMP_TARGET_TEAMS_LOOP:
+ return ST_OMP_END_TARGET_TEAMS_LOOP;
+ case ST_OMP_TASKLOOP: return ST_OMP_END_TASKLOOP;
+ case ST_OMP_TASKLOOP_SIMD: return ST_OMP_END_TASKLOOP_SIMD;
+ case ST_OMP_MASKED_TASKLOOP: return ST_OMP_END_MASKED_TASKLOOP;
+ case ST_OMP_MASKED_TASKLOOP_SIMD:
+ return ST_OMP_END_MASKED_TASKLOOP_SIMD;
+ case ST_OMP_MASTER_TASKLOOP: return ST_OMP_END_MASTER_TASKLOOP;
+ case ST_OMP_MASTER_TASKLOOP_SIMD:
+ return ST_OMP_END_MASTER_TASKLOOP_SIMD;
+ case ST_OMP_PARALLEL_MASKED_TASKLOOP:
+ return ST_OMP_END_PARALLEL_MASKED_TASKLOOP;
+ case ST_OMP_PARALLEL_MASKED_TASKLOOP_SIMD:
+ return ST_OMP_END_PARALLEL_MASKED_TASKLOOP_SIMD;
+ case ST_OMP_PARALLEL_MASTER_TASKLOOP:
+ return ST_OMP_END_PARALLEL_MASTER_TASKLOOP;
+ case ST_OMP_PARALLEL_MASTER_TASKLOOP_SIMD:
+ return ST_OMP_END_PARALLEL_MASTER_TASKLOOP_SIMD;
+ case ST_OMP_TEAMS_DISTRIBUTE:
+ return ST_OMP_END_TEAMS_DISTRIBUTE;
+ case ST_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO:
+ return ST_OMP_END_TEAMS_DISTRIBUTE_PARALLEL_DO;
+ case ST_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
+ return ST_OMP_END_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD;
+ case ST_OMP_TEAMS_DISTRIBUTE_SIMD:
+ return ST_OMP_END_TEAMS_DISTRIBUTE_SIMD;
+ case ST_OMP_TEAMS_LOOP:
+ return ST_OMP_END_TEAMS_LOOP;
+ default:
+ break;
+ }
+ }
+
+ if (omp_structured_p)
+ {
+ switch (omp_st)
+ {
+ case ST_OMP_ASSUME:
+ return ST_OMP_END_ASSUME;
+ case ST_OMP_PARALLEL:
+ return ST_OMP_END_PARALLEL;
+ case ST_OMP_PARALLEL_MASKED:
+ return ST_OMP_END_PARALLEL_MASKED;
+ case ST_OMP_PARALLEL_MASTER:
+ return ST_OMP_END_PARALLEL_MASTER;
+ case ST_OMP_PARALLEL_SECTIONS:
+ return ST_OMP_END_PARALLEL_SECTIONS;
+ case ST_OMP_SCOPE:
+ return ST_OMP_END_SCOPE;
+ case ST_OMP_SECTIONS:
+ return ST_OMP_END_SECTIONS;
+ case ST_OMP_ORDERED:
+ return ST_OMP_END_ORDERED;
+ case ST_OMP_CRITICAL:
+ return ST_OMP_END_CRITICAL;
+ case ST_OMP_MASKED:
+ return ST_OMP_END_MASKED;
+ case ST_OMP_MASTER:
+ return ST_OMP_END_MASTER;
+ case ST_OMP_SINGLE:
+ return ST_OMP_END_SINGLE;
+ case ST_OMP_TARGET:
+ return ST_OMP_END_TARGET;
+ case ST_OMP_TARGET_DATA:
+ return ST_OMP_END_TARGET_DATA;
+ case ST_OMP_TARGET_PARALLEL:
+ return ST_OMP_END_TARGET_PARALLEL;
+ case ST_OMP_TARGET_TEAMS:
+ return ST_OMP_END_TARGET_TEAMS;
+ case ST_OMP_TASK:
+ return ST_OMP_END_TASK;
+ case ST_OMP_TASKGROUP:
+ return ST_OMP_END_TASKGROUP;
+ case ST_OMP_TEAMS:
+ return ST_OMP_END_TEAMS;
+ case ST_OMP_TEAMS_DISTRIBUTE:
+ return ST_OMP_END_TEAMS_DISTRIBUTE;
+ case ST_OMP_DISTRIBUTE:
+ return ST_OMP_END_DISTRIBUTE;
+ case ST_OMP_WORKSHARE:
+ return ST_OMP_END_WORKSHARE;
+ case ST_OMP_PARALLEL_WORKSHARE:
+ return ST_OMP_END_PARALLEL_WORKSHARE;
+ case ST_OMP_BEGIN_METADIRECTIVE:
+ return ST_OMP_END_METADIRECTIVE;
+ default:
+ break;
+ }
+ }
+
+ return ST_NONE;
+}
/* Parse the statements of OpenMP do/parallel do. */
@@ -5487,94 +5689,16 @@ parse_omp_do (gfc_statement omp_st)
pop_state ();
st = next_statement ();
- gfc_statement omp_end_st = ST_OMP_END_DO;
- switch (omp_st)
- {
- case ST_OMP_DISTRIBUTE: omp_end_st = ST_OMP_END_DISTRIBUTE; break;
- case ST_OMP_DISTRIBUTE_PARALLEL_DO:
- omp_end_st = ST_OMP_END_DISTRIBUTE_PARALLEL_DO;
- break;
- case ST_OMP_DISTRIBUTE_PARALLEL_DO_SIMD:
- omp_end_st = ST_OMP_END_DISTRIBUTE_PARALLEL_DO_SIMD;
- break;
- case ST_OMP_DISTRIBUTE_SIMD:
- omp_end_st = ST_OMP_END_DISTRIBUTE_SIMD;
- break;
- case ST_OMP_DO: omp_end_st = ST_OMP_END_DO; break;
- case ST_OMP_DO_SIMD: omp_end_st = ST_OMP_END_DO_SIMD; break;
- case ST_OMP_LOOP: omp_end_st = ST_OMP_END_LOOP; break;
- case ST_OMP_PARALLEL_DO: omp_end_st = ST_OMP_END_PARALLEL_DO; break;
- case ST_OMP_PARALLEL_DO_SIMD:
- omp_end_st = ST_OMP_END_PARALLEL_DO_SIMD;
- break;
- case ST_OMP_PARALLEL_LOOP:
- omp_end_st = ST_OMP_END_PARALLEL_LOOP;
- break;
- case ST_OMP_SIMD: omp_end_st = ST_OMP_END_SIMD; break;
- case ST_OMP_TARGET_PARALLEL_DO:
- omp_end_st = ST_OMP_END_TARGET_PARALLEL_DO;
- break;
- case ST_OMP_TARGET_PARALLEL_DO_SIMD:
- omp_end_st = ST_OMP_END_TARGET_PARALLEL_DO_SIMD;
- break;
- case ST_OMP_TARGET_PARALLEL_LOOP:
- omp_end_st = ST_OMP_END_TARGET_PARALLEL_LOOP;
- break;
- case ST_OMP_TARGET_SIMD: omp_end_st = ST_OMP_END_TARGET_SIMD; break;
- case ST_OMP_TARGET_TEAMS_DISTRIBUTE:
- omp_end_st = ST_OMP_END_TARGET_TEAMS_DISTRIBUTE;
- break;
- case ST_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO:
- omp_end_st = ST_OMP_END_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO;
- break;
- case ST_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
- omp_end_st = ST_OMP_END_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD;
- break;
- case ST_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD:
- omp_end_st = ST_OMP_END_TARGET_TEAMS_DISTRIBUTE_SIMD;
- break;
- case ST_OMP_TARGET_TEAMS_LOOP:
- omp_end_st = ST_OMP_END_TARGET_TEAMS_LOOP;
- break;
- case ST_OMP_TASKLOOP: omp_end_st = ST_OMP_END_TASKLOOP; break;
- case ST_OMP_TASKLOOP_SIMD: omp_end_st = ST_OMP_END_TASKLOOP_SIMD; break;
- case ST_OMP_MASKED_TASKLOOP: omp_end_st = ST_OMP_END_MASKED_TASKLOOP; break;
- case ST_OMP_MASKED_TASKLOOP_SIMD:
- omp_end_st = ST_OMP_END_MASKED_TASKLOOP_SIMD;
- break;
- case ST_OMP_MASTER_TASKLOOP: omp_end_st = ST_OMP_END_MASTER_TASKLOOP; break;
- case ST_OMP_MASTER_TASKLOOP_SIMD:
- omp_end_st = ST_OMP_END_MASTER_TASKLOOP_SIMD;
- break;
- case ST_OMP_PARALLEL_MASKED_TASKLOOP:
- omp_end_st = ST_OMP_END_PARALLEL_MASKED_TASKLOOP;
- break;
- case ST_OMP_PARALLEL_MASKED_TASKLOOP_SIMD:
- omp_end_st = ST_OMP_END_PARALLEL_MASKED_TASKLOOP_SIMD;
- break;
- case ST_OMP_PARALLEL_MASTER_TASKLOOP:
- omp_end_st = ST_OMP_END_PARALLEL_MASTER_TASKLOOP;
- break;
- case ST_OMP_PARALLEL_MASTER_TASKLOOP_SIMD:
- omp_end_st = ST_OMP_END_PARALLEL_MASTER_TASKLOOP_SIMD;
- break;
- case ST_OMP_TEAMS_DISTRIBUTE:
- omp_end_st = ST_OMP_END_TEAMS_DISTRIBUTE;
- break;
- case ST_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO:
- omp_end_st = ST_OMP_END_TEAMS_DISTRIBUTE_PARALLEL_DO;
- break;
- case ST_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
- omp_end_st = ST_OMP_END_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD;
- break;
- case ST_OMP_TEAMS_DISTRIBUTE_SIMD:
- omp_end_st = ST_OMP_END_TEAMS_DISTRIBUTE_SIMD;
- break;
- case ST_OMP_TEAMS_LOOP:
- omp_end_st = ST_OMP_END_TEAMS_LOOP;
- break;
- default: gcc_unreachable ();
- }
+ gfc_statement omp_end_st = gfc_omp_end_stmt (omp_st, true, false);
+ if (omp_st == ST_NONE)
+ gcc_unreachable ();
+
+ /* If handling a metadirective variant, treat 'omp end metadirective'
+ as the expected end statement for the current construct. */
+ if (st == ST_OMP_END_METADIRECTIVE
+ && gfc_state_stack->state == COMP_OMP_BEGIN_METADIRECTIVE)
+ st = omp_end_st;
+
if (st == omp_end_st)
{
if (new_st.op == EXEC_OMP_END_NOWAIT)
@@ -5886,80 +6010,15 @@ parse_omp_structured_block (gfc_statement omp_st, bool workshare_stmts_only)
np->op = cp->op;
np->block = NULL;
- switch (omp_st)
- {
- case ST_OMP_ASSUME:
- omp_end_st = ST_OMP_END_ASSUME;
- break;
- case ST_OMP_PARALLEL:
- omp_end_st = ST_OMP_END_PARALLEL;
- break;
- case ST_OMP_PARALLEL_MASKED:
- omp_end_st = ST_OMP_END_PARALLEL_MASKED;
- break;
- case ST_OMP_PARALLEL_MASTER:
- omp_end_st = ST_OMP_END_PARALLEL_MASTER;
- break;
- case ST_OMP_PARALLEL_SECTIONS:
- omp_end_st = ST_OMP_END_PARALLEL_SECTIONS;
- break;
- case ST_OMP_SCOPE:
- omp_end_st = ST_OMP_END_SCOPE;
- break;
- case ST_OMP_SECTIONS:
- omp_end_st = ST_OMP_END_SECTIONS;
- break;
- case ST_OMP_ORDERED:
- omp_end_st = ST_OMP_END_ORDERED;
- break;
- case ST_OMP_CRITICAL:
- omp_end_st = ST_OMP_END_CRITICAL;
- break;
- case ST_OMP_MASKED:
- omp_end_st = ST_OMP_END_MASKED;
- break;
- case ST_OMP_MASTER:
- omp_end_st = ST_OMP_END_MASTER;
- break;
- case ST_OMP_SINGLE:
- omp_end_st = ST_OMP_END_SINGLE;
- break;
- case ST_OMP_TARGET:
- omp_end_st = ST_OMP_END_TARGET;
- break;
- case ST_OMP_TARGET_DATA:
- omp_end_st = ST_OMP_END_TARGET_DATA;
- break;
- case ST_OMP_TARGET_PARALLEL:
- omp_end_st = ST_OMP_END_TARGET_PARALLEL;
- break;
- case ST_OMP_TARGET_TEAMS:
- omp_end_st = ST_OMP_END_TARGET_TEAMS;
- break;
- case ST_OMP_TASK:
- omp_end_st = ST_OMP_END_TASK;
- break;
- case ST_OMP_TASKGROUP:
- omp_end_st = ST_OMP_END_TASKGROUP;
- break;
- case ST_OMP_TEAMS:
- omp_end_st = ST_OMP_END_TEAMS;
- break;
- case ST_OMP_TEAMS_DISTRIBUTE:
- omp_end_st = ST_OMP_END_TEAMS_DISTRIBUTE;
- break;
- case ST_OMP_DISTRIBUTE:
- omp_end_st = ST_OMP_END_DISTRIBUTE;
- break;
- case ST_OMP_WORKSHARE:
- omp_end_st = ST_OMP_END_WORKSHARE;
- break;
- case ST_OMP_PARALLEL_WORKSHARE:
- omp_end_st = ST_OMP_END_PARALLEL_WORKSHARE;
- break;
- default:
- gcc_unreachable ();
- }
+ omp_end_st = gfc_omp_end_stmt (omp_st, false, true);
+ if (omp_end_st == ST_NONE)
+ gcc_unreachable ();
+
+ /* If handling a metadirective variant, treat 'omp end metadirective'
+ as the expected end statement for the current construct. */
+ if (gfc_state_stack->previous != NULL
+ && gfc_state_stack->previous->state == COMP_OMP_BEGIN_METADIRECTIVE)
+ omp_end_st = ST_OMP_END_METADIRECTIVE;
bool block_construct = false;
gfc_namespace *my_ns = NULL;
@@ -6005,11 +6064,13 @@ parse_omp_structured_block (gfc_statement omp_st, bool workshare_stmts_only)
case ST_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO:
case ST_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
case ST_OMP_TEAMS_LOOP:
+ case ST_OMP_METADIRECTIVE:
+ case ST_OMP_BEGIN_METADIRECTIVE:
{
gfc_state_data *stk = gfc_state_stack->previous;
if (stk->state == COMP_OMP_STRICTLY_STRUCTURED_BLOCK)
stk = stk->previous;
- stk->tail->ext.omp_clauses->target_first_st_is_teams = true;
+ stk->tail->ext.omp_clauses->target_first_st_is_teams_or_meta = true;
break;
}
default:
@@ -6182,6 +6243,88 @@ parse_omp_structured_block (gfc_statement omp_st, bool workshare_stmts_only)
return st;
}
+static gfc_statement
+parse_omp_metadirective_body (gfc_statement omp_st)
+{
+ gfc_omp_variant *variant
+ = new_st.ext.omp_variants;
+ locus body_locus = gfc_current_locus;
+
+ accept_statement (omp_st);
+
+ gfc_statement next_st = ST_NONE;
+
+ while (variant)
+ {
+ gfc_current_locus = body_locus;
+ gfc_state_data s;
+ bool workshare_p
+ = (variant->stmt == ST_OMP_WORKSHARE
+ || variant->stmt == ST_OMP_PARALLEL_WORKSHARE);
+ enum gfc_compile_state new_state
+ = (omp_st == ST_OMP_METADIRECTIVE
+ ? COMP_OMP_METADIRECTIVE : COMP_OMP_BEGIN_METADIRECTIVE);
+
+ new_st = *variant->code;
+ push_state (&s, new_state, NULL);
+
+ gfc_statement st;
+ bool old_in_metadirective_body = gfc_in_metadirective_body;
+ gfc_in_metadirective_body = true;
+
+ gfc_omp_region_count++;
+ switch (variant->stmt)
+ {
+ case_omp_structured_block:
+ st = parse_omp_structured_block (variant->stmt, workshare_p);
+ break;
+ case_omp_do:
+ st = parse_omp_do (variant->stmt);
+ /* TODO: Does st == ST_IMPLIED_ENDDO need special handling? */
+ break;
+ default:
+ accept_statement (variant->stmt);
+ st = parse_executable (next_statement ());
+ break;
+ }
+
+ if (gfc_state_stack->state == COMP_OMP_METADIRECTIVE
+ && startswith (gfc_ascii_statement (st), "!$OMP END "))
+ {
+ for (gfc_state_data *p = gfc_state_stack; p; p = p->previous)
+ if (p->state == COMP_OMP_STRUCTURED_BLOCK
+ || p->state == COMP_OMP_BEGIN_METADIRECTIVE)
+ goto finish;
+ gfc_error (
+ "Unexpected %s statement in an OMP METADIRECTIVE block at %C",
+ gfc_ascii_statement (st));
+ reject_statement ();
+ st = next_statement ();
+ }
+ finish:
+
+ gfc_in_metadirective_body = old_in_metadirective_body;
+
+ if (gfc_state_stack->head)
+ *variant->code = *gfc_state_stack->head;
+ pop_state ();
+
+ gfc_commit_symbols ();
+ gfc_warning_check ();
+ if (variant->next)
+ gfc_clear_new_st ();
+
+ /* Sanity-check that each variant finishes parsing at the same place. */
+ if (next_st == ST_NONE)
+ next_st = st;
+ else
+ gcc_assert (st == next_st);
+
+ variant = variant->next;
+ }
+
+ return next_st;
+}
/* Accept a series of executable statements. We return the first
statement that doesn't fit to the caller. Any block statements are
@@ -6192,6 +6335,7 @@ static gfc_statement
parse_executable (gfc_statement st)
{
int close_flag;
+ bool one_stmt_p = false;
in_exec_part = true;
if (st == ST_NONE)
@@ -6199,6 +6343,12 @@ parse_executable (gfc_statement st)
for (;;)
{
+ /* Only parse one statement for the form of metadirective without
+ an explicit begin..end. */
+ if (gfc_state_stack->state == COMP_OMP_METADIRECTIVE && one_stmt_p)
+ return st;
+ one_stmt_p = true;
+
close_flag = check_do_closure ();
if (close_flag)
switch (st)
@@ -6308,68 +6458,13 @@ parse_executable (gfc_statement st)
st = parse_openmp_allocate_block (st);
continue;
- case ST_OMP_ASSUME:
- case ST_OMP_PARALLEL:
- case ST_OMP_PARALLEL_MASKED:
- case ST_OMP_PARALLEL_MASTER:
- case ST_OMP_PARALLEL_SECTIONS:
- case ST_OMP_ORDERED:
- case ST_OMP_CRITICAL:
- case ST_OMP_MASKED:
- case ST_OMP_MASTER:
- case ST_OMP_SCOPE:
- case ST_OMP_SECTIONS:
- case ST_OMP_SINGLE:
- case ST_OMP_TARGET:
- case ST_OMP_TARGET_DATA:
- case ST_OMP_TARGET_PARALLEL:
- case ST_OMP_TARGET_TEAMS:
- case ST_OMP_TEAMS:
- case ST_OMP_TASK:
- case ST_OMP_TASKGROUP:
- st = parse_omp_structured_block (st, false);
+ case_omp_structured_block:
+ st = parse_omp_structured_block (st,
+ st == ST_OMP_WORKSHARE
+ || st == ST_OMP_PARALLEL_WORKSHARE);
continue;
- case ST_OMP_WORKSHARE:
- case ST_OMP_PARALLEL_WORKSHARE:
- st = parse_omp_structured_block (st, true);
- continue;
-
- case ST_OMP_DISTRIBUTE:
- case ST_OMP_DISTRIBUTE_PARALLEL_DO:
- case ST_OMP_DISTRIBUTE_PARALLEL_DO_SIMD:
- case ST_OMP_DISTRIBUTE_SIMD:
- case ST_OMP_DO:
- case ST_OMP_DO_SIMD:
- case ST_OMP_LOOP:
- case ST_OMP_PARALLEL_DO:
- case ST_OMP_PARALLEL_DO_SIMD:
- case ST_OMP_PARALLEL_LOOP:
- case ST_OMP_PARALLEL_MASKED_TASKLOOP:
- case ST_OMP_PARALLEL_MASKED_TASKLOOP_SIMD:
- case ST_OMP_PARALLEL_MASTER_TASKLOOP:
- case ST_OMP_PARALLEL_MASTER_TASKLOOP_SIMD:
- case ST_OMP_MASKED_TASKLOOP:
- case ST_OMP_MASKED_TASKLOOP_SIMD:
- case ST_OMP_MASTER_TASKLOOP:
- case ST_OMP_MASTER_TASKLOOP_SIMD:
- case ST_OMP_SIMD:
- case ST_OMP_TARGET_PARALLEL_DO:
- case ST_OMP_TARGET_PARALLEL_DO_SIMD:
- case ST_OMP_TARGET_PARALLEL_LOOP:
- case ST_OMP_TARGET_SIMD:
- case ST_OMP_TARGET_TEAMS_DISTRIBUTE:
- case ST_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO:
- case ST_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
- case ST_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD:
- case ST_OMP_TARGET_TEAMS_LOOP:
- case ST_OMP_TASKLOOP:
- case ST_OMP_TASKLOOP_SIMD:
- case ST_OMP_TEAMS_DISTRIBUTE:
- case ST_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO:
- case ST_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
- case ST_OMP_TEAMS_DISTRIBUTE_SIMD:
- case ST_OMP_TEAMS_LOOP:
+ case_omp_do:
st = parse_omp_do (st);
if (st == ST_IMPLIED_ENDDO)
return st;
@@ -6383,6 +6478,19 @@ parse_executable (gfc_statement st)
st = parse_omp_oacc_atomic (true);
continue;
+ case ST_OMP_METADIRECTIVE:
+ case ST_OMP_BEGIN_METADIRECTIVE:
+ st = parse_omp_metadirective_body (st);
+ continue;
+
+ case ST_OMP_END_METADIRECTIVE:
+ if (gfc_state_stack->state == COMP_OMP_BEGIN_METADIRECTIVE)
+ {
+ st = next_statement ();
+ return st;
+ }
+ /* FALLTHRU */
+
default:
return st;
}
@@ -7148,6 +7256,10 @@ gfc_parse_file (void)
gfc_statement_label = NULL;
+ gfc_omp_region_count = 0;
+ gfc_in_metadirective_body = false;
+ gfc_matching_omp_context_selector = false;
+
if (setjmp (eof_buf))
return false; /* Come here on unexpected EOF */
@@ -7460,3 +7572,16 @@ is_oacc (gfc_state_data *sd)
return false;
}
}
+
+/* Return true if ST is a declarative OpenMP statement. */
+bool
+is_omp_declarative_stmt (gfc_statement st)
+{
+ switch (st)
+ {
+ case_omp_decl:
+ return true;
+ default:
+ return false;
+ }
+}
diff --git a/gcc/fortran/parse.h b/gcc/fortran/parse.h
index ce19d4deb07..2c5b3adec3b 100644
--- a/gcc/fortran/parse.h
+++ b/gcc/fortran/parse.h
@@ -31,7 +31,8 @@ enum gfc_compile_state
COMP_STRUCTURE, COMP_UNION, COMP_MAP,
COMP_DO, COMP_SELECT, COMP_FORALL, COMP_WHERE, COMP_CONTAINS, COMP_ENUM,
COMP_SELECT_TYPE, COMP_SELECT_RANK, COMP_OMP_STRUCTURED_BLOCK, COMP_CRITICAL,
- COMP_DO_CONCURRENT, COMP_OMP_STRICTLY_STRUCTURED_BLOCK
+ COMP_DO_CONCURRENT, COMP_OMP_STRICTLY_STRUCTURED_BLOCK,
+ COMP_OMP_METADIRECTIVE, COMP_OMP_BEGIN_METADIRECTIVE
};
/* Stack element for the current compilation state. These structures
@@ -67,10 +68,15 @@ bool gfc_check_do_variable (gfc_symtree *);
bool gfc_find_state (gfc_compile_state);
gfc_state_data *gfc_enclosing_unit (gfc_compile_state *);
const char *gfc_ascii_statement (gfc_statement, bool strip_sentinel = false) ;
+gfc_statement gfc_omp_end_stmt (gfc_statement, bool = true, bool = true);
match gfc_match_enum (void);
match gfc_match_enumerator_def (void);
void gfc_free_enum_history (void);
extern bool gfc_matching_function;
+extern bool gfc_matching_omp_context_selector;
+extern bool gfc_in_metadirective_body;
+extern int gfc_omp_region_count;
+
match gfc_match_prefix (gfc_typespec *);
bool is_oacc (gfc_state_data *);
#endif /* GFC_PARSE_H */
diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index 4368627041e..16c20ada92a 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -12527,6 +12527,11 @@ gfc_resolve_code (gfc_code *code, gfc_namespace *ns)
gfc_resolve_forall (code, ns, forall_save);
forall_flag = 2;
}
+ else if (code->op == EXEC_OMP_METADIRECTIVE)
+ for (gfc_omp_variant *variant
+ = code->ext.omp_variants;
+ variant; variant = variant->next)
+ gfc_resolve_code (variant->code, ns);
else if (code->block)
{
omp_workshare_save = -1;
@@ -13059,6 +13064,7 @@ start:
case EXEC_OMP_MASKED:
case EXEC_OMP_MASKED_TASKLOOP:
case EXEC_OMP_MASKED_TASKLOOP_SIMD:
+ case EXEC_OMP_METADIRECTIVE:
case EXEC_OMP_ORDERED:
case EXEC_OMP_SCAN:
case EXEC_OMP_SCOPE:
diff --git a/gcc/fortran/st.cc b/gcc/fortran/st.cc
index 6a605ad91d4..cc1e8e7448b 100644
--- a/gcc/fortran/st.cc
+++ b/gcc/fortran/st.cc
@@ -299,6 +299,10 @@ gfc_free_statement (gfc_code *p)
case EXEC_OMP_TASKYIELD:
break;
+ case EXEC_OMP_METADIRECTIVE:
+ gfc_free_omp_variants (p->ext.omp_variants);
+ break;
+
default:
gfc_internal_error ("gfc_free_statement(): Bad statement");
}
diff --git a/gcc/fortran/symbol.cc b/gcc/fortran/symbol.cc
index 8f7deac1d1e..ce9a3bd065e 100644
--- a/gcc/fortran/symbol.cc
+++ b/gcc/fortran/symbol.cc
@@ -2704,10 +2704,13 @@ free_components (gfc_component *p)
static int
compare_st_labels (void *a1, void *b1)
{
- int a = ((gfc_st_label *) a1)->value;
- int b = ((gfc_st_label *) b1)->value;
+ gfc_st_label *a = (gfc_st_label *) a1;
+ gfc_st_label *b = (gfc_st_label *) b1;
- return (b - a);
+ if (a->omp_region == b->omp_region)
+ return b->value - a->value;
+ else
+ return b->omp_region - a->omp_region;
}
@@ -2757,6 +2760,7 @@ gfc_get_st_label (int labelno)
{
gfc_st_label *lp;
gfc_namespace *ns;
+ int omp_region = gfc_in_metadirective_body ? gfc_omp_region_count : 0;
if (gfc_current_state () == COMP_DERIVED)
ns = gfc_current_block ()->f2k_derived;
@@ -2773,10 +2777,16 @@ gfc_get_st_label (int labelno)
lp = ns->st_labels;
while (lp)
{
- if (lp->value == labelno)
- return lp;
-
- if (lp->value < labelno)
+ if (lp->omp_region == omp_region)
+ {
+ if (lp->value == labelno)
+ return lp;
+ if (lp->value < labelno)
+ lp = lp->left;
+ else
+ lp = lp->right;
+ }
+ else if (lp->omp_region < omp_region)
lp = lp->left;
else
lp = lp->right;
@@ -2788,6 +2798,7 @@ gfc_get_st_label (int labelno)
lp->defined = ST_LABEL_UNKNOWN;
lp->referenced = ST_LABEL_UNKNOWN;
lp->ns = ns;
+ lp->omp_region = omp_region;
gfc_insert_bbt (&ns->st_labels, lp, compare_st_labels);
diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index 301439baaf5..16c6fc904c6 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -327,7 +327,10 @@ gfc_get_label_decl (gfc_st_label * lp)
gcc_assert (lp != NULL && lp->value <= MAX_LABEL_VALUE);
/* Build a mangled name for the label. */
- sprintf (label_name, "__label_%.6d", lp->value);
+ if (lp->omp_region)
+ sprintf (label_name, "__label_%d_%.6d", lp->omp_region, lp->value);
+ else
+ sprintf (label_name, "__label_%.6d", lp->value);
/* Build the LABEL_DECL node. */
label_decl = gfc_build_label_decl (get_identifier (label_name));
diff --git a/gcc/fortran/trans-openmp.cc b/gcc/fortran/trans-openmp.cc
index 99ec0320258..854d3ac14f0 100644
--- a/gcc/fortran/trans-openmp.cc
+++ b/gcc/fortran/trans-openmp.cc
@@ -8240,6 +8240,8 @@ gfc_trans_omp_directive (gfc_code *code)
case EXEC_OMP_MASTER_TASKLOOP:
case EXEC_OMP_MASTER_TASKLOOP_SIMD:
return gfc_trans_omp_master_masked_taskloop (code, code->op);
+ case EXEC_OMP_METADIRECTIVE:
+ return gfc_trans_omp_metadirective (code);
case EXEC_OMP_ORDERED:
return gfc_trans_omp_ordered (code);
case EXEC_OMP_PARALLEL:
@@ -8331,6 +8333,100 @@ gfc_trans_omp_declare_simd (gfc_namespace *ns)
}
}
+/* Translate the context selector list GFC_SELECTORS, using WHERE as the
+ locus for error messages. */
+
+static tree
+gfc_trans_omp_set_selector (gfc_omp_set_selector *gfc_selectors, locus where)
+{
+ tree set_selectors = NULL_TREE;
+ gfc_omp_set_selector *oss;
+
+ for (oss = gfc_selectors; oss; oss = oss->next)
+ {
+ tree selectors = NULL_TREE;
+ gfc_omp_selector *os;
+ enum omp_tss_code set = oss->code;
+ gcc_assert (set != OMP_TRAIT_SET_INVALID);
+
+ for (os = oss->trait_selectors; os; os = os->next)
+ {
+ tree scoreval = NULL_TREE;
+ tree properties = NULL_TREE;
+ gfc_omp_trait_property *otp;
+ enum omp_ts_code sel = os->code;
+
+ /* Per the spec, "Implementations can ignore specified
+ selectors that are not those described in this section";
+ however, we must record such selectors because they
+ cause match failures. */
+ if (sel == OMP_TRAIT_INVALID)
+ {
+ selectors = make_trait_selector (sel, NULL_TREE, NULL_TREE,
+ selectors);
+ continue;
+ }
+
+ for (otp = os->properties; otp; otp = otp->next)
+ {
+ switch (otp->property_kind)
+ {
+ case OMP_TRAIT_PROPERTY_DEV_NUM_EXPR:
+ case OMP_TRAIT_PROPERTY_BOOL_EXPR:
+ {
+ tree expr = NULL_TREE;
+ gfc_se se;
+ gfc_init_se (&se, NULL);
+ gfc_conv_expr (&se, otp->expr);
+ expr = se.expr;
+ properties = make_trait_property (NULL_TREE, expr,
+ properties);
+ }
+ break;
+ case OMP_TRAIT_PROPERTY_ID:
+ properties
+ = make_trait_property (get_identifier (otp->name),
+ NULL_TREE, properties);
+ break;
+ case OMP_TRAIT_PROPERTY_NAME_LIST:
+ {
+ tree prop = OMP_TP_NAMELIST_NODE;
+ tree value = NULL_TREE;
+ if (otp->is_name)
+ value = get_identifier (otp->name);
+ else
+ value = gfc_conv_constant_to_tree (otp->expr);
+
+ properties = make_trait_property (prop, value,
+ properties);
+ }
+ break;
+ case OMP_TRAIT_PROPERTY_CLAUSE_LIST:
+ properties = gfc_trans_omp_clauses (NULL, otp->clauses,
+ where, true);
+ break;
+ default:
+ gcc_unreachable ();
+ }
+ }
+
+ if (os->score)
+ {
+ gfc_se se;
+ gfc_init_se (&se, NULL);
+ gfc_conv_expr (&se, os->score);
+ scoreval = se.expr;
+ }
+
+ selectors = make_trait_selector (sel, scoreval,
+ properties, selectors);
+ }
+ set_selectors = make_trait_set_selector (set, selectors, set_selectors);
+ }
+ return set_selectors;
+}
+
+
void
gfc_trans_omp_declare_variant (gfc_namespace *ns)
{
@@ -8406,90 +8502,8 @@ gfc_trans_omp_declare_variant (gfc_namespace *ns)
&& strcmp (odv->base_proc_symtree->name, ns->proc_name->name)))
continue;
- tree set_selectors = NULL_TREE;
- gfc_omp_set_selector *oss;
-
- for (oss = odv->set_selectors; oss; oss = oss->next)
- {
- tree selectors = NULL_TREE;
- gfc_omp_selector *os;
- enum omp_tss_code set = oss->code;
- gcc_assert (set != OMP_TRAIT_SET_INVALID);
-
- for (os = oss->trait_selectors; os; os = os->next)
- {
- tree scoreval = NULL_TREE;
- tree properties = NULL_TREE;
- gfc_omp_trait_property *otp;
- enum omp_ts_code sel = os->code;
-
- /* Per the spec, "Implementations can ignore specified
- selectors that are not those described in this section";
- however, we must record such selectors because they
- cause match failures. */
- if (sel == OMP_TRAIT_INVALID)
- {
- selectors = make_trait_selector (sel, NULL_TREE, NULL_TREE,
- selectors);
- continue;
- }
-
- for (otp = os->properties; otp; otp = otp->next)
- {
- switch (otp->property_kind)
- {
- case OMP_TRAIT_PROPERTY_DEV_NUM_EXPR:
- case OMP_TRAIT_PROPERTY_BOOL_EXPR:
- {
- gfc_se se;
- gfc_init_se (&se, NULL);
- gfc_conv_expr (&se, otp->expr);
- properties = make_trait_property (NULL_TREE, se.expr,
- properties);
- }
- break;
- case OMP_TRAIT_PROPERTY_ID:
- properties
- = make_trait_property (get_identifier (otp->name),
- NULL_TREE, properties);
- break;
- case OMP_TRAIT_PROPERTY_NAME_LIST:
- {
- tree prop = OMP_TP_NAMELIST_NODE;
- tree value = NULL_TREE;
- if (otp->is_name)
- value = get_identifier (otp->name);
- else
- value = gfc_conv_constant_to_tree (otp->expr);
-
- properties = make_trait_property (prop, value,
- properties);
- }
- break;
- case OMP_TRAIT_PROPERTY_CLAUSE_LIST:
- properties = gfc_trans_omp_clauses (NULL, otp->clauses,
- odv->where, true);
- break;
- default:
- gcc_unreachable ();
- }
- }
-
- if (os->score)
- {
- gfc_se se;
- gfc_init_se (&se, NULL);
- gfc_conv_expr (&se, os->score);
- scoreval = se.expr;
- }
-
- selectors = make_trait_selector (sel, scoreval,
- properties, selectors);
- }
- set_selectors = make_trait_set_selector (set, selectors,
- set_selectors);
- }
-
+ tree set_selectors = gfc_trans_omp_set_selector (odv->set_selectors,
+ odv->where);
const char *variant_proc_name = odv->variant_proc_symtree->name;
gfc_symbol *variant_proc_sym = odv->variant_proc_symtree->n.sym;
if (variant_proc_sym == NULL || variant_proc_sym->attr.implicit_type)
@@ -8590,3 +8604,54 @@ gfc_omp_call_is_alloc (tree ptr)
}
return build_call_expr_loc (input_location, fn, 1, ptr);
}
+
+tree
+gfc_trans_omp_metadirective (gfc_code *code)
+{
+ gfc_omp_variant *variant = code->ext.omp_variants;
+
+ tree metadirective_tree = make_node (OMP_METADIRECTIVE);
+ SET_EXPR_LOCATION (metadirective_tree, gfc_get_location (&code->loc));
+ TREE_TYPE (metadirective_tree) = void_type_node;
+ OMP_METADIRECTIVE_VARIANTS (metadirective_tree) = NULL_TREE;
+
+ tree tree_body = NULL_TREE;
+
+ while (variant)
+ {
+ tree ctx = gfc_trans_omp_set_selector (variant->selectors,
+ variant->where);
+ ctx = omp_check_context_selector (gfc_get_location (&variant->where),
+ ctx, true);
+ if (ctx == error_mark_node)
+ return error_mark_node;
+
+ /* If the selector doesn't match, drop the whole variant. */
+ if (!omp_context_selector_matches (ctx, true, true))
+ {
+ variant = variant->next;
+ continue;
+ }
+
+ gfc_code *next_code = variant->code->next;
+ if (next_code && tree_body == NULL_TREE)
+ tree_body = gfc_trans_code (next_code);
+
+ if (next_code)
+ variant->code->next = NULL;
+ tree directive = gfc_trans_code (variant->code);
+ if (next_code)
+ variant->code->next = next_code;
+
+ tree body = next_code ? tree_body : NULL_TREE;
+ tree omp_variant = make_omp_metadirective_variant (ctx, directive, body);
+ OMP_METADIRECTIVE_VARIANTS (metadirective_tree)
+ = chainon (OMP_METADIRECTIVE_VARIANTS (metadirective_tree),
+ omp_variant);
+ variant = variant->next;
+ }
+
+ /* TODO: Resolve the metadirective here if possible. */
+
+ return metadirective_tree;
+}
diff --git a/gcc/fortran/trans-stmt.h b/gcc/fortran/trans-stmt.h
index 0f0f99931ca..d19e161cf11 100644
--- a/gcc/fortran/trans-stmt.h
+++ b/gcc/fortran/trans-stmt.h
@@ -71,6 +71,7 @@ tree gfc_trans_deallocate (gfc_code *);
tree gfc_trans_omp_directive (gfc_code *);
void gfc_trans_omp_declare_simd (gfc_namespace *);
void gfc_trans_omp_declare_variant (gfc_namespace *);
+tree gfc_trans_omp_metadirective (gfc_code *code);
tree gfc_trans_oacc_directive (gfc_code *);
tree gfc_trans_oacc_declare (gfc_namespace *);
diff --git a/gcc/fortran/trans.cc b/gcc/fortran/trans.cc
index badad6ae892..25255a8b43e 100644
--- a/gcc/fortran/trans.cc
+++ b/gcc/fortran/trans.cc
@@ -2611,6 +2611,7 @@ trans_code (gfc_code * code, tree cond)
case EXEC_OMP_MASTER:
case EXEC_OMP_MASTER_TASKLOOP:
case EXEC_OMP_MASTER_TASKLOOP_SIMD:
+ case EXEC_OMP_METADIRECTIVE:
case EXEC_OMP_ORDERED:
case EXEC_OMP_PARALLEL:
case EXEC_OMP_PARALLEL_DO:
diff --git a/gcc/testsuite/gfortran.dg/gomp/metadirective-1.f90 b/gcc/testsuite/gfortran.dg/gomp/metadirective-1.f90
new file mode 100644
index 00000000000..c5b3946341d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/metadirective-1.f90
@@ -0,0 +1,55 @@
+! { dg-do compile }
+
+program main
+ integer, parameter :: N = 10
+ integer, dimension(N) :: a
+ integer, dimension(N) :: b
+ integer, dimension(N) :: c
+ integer :: i
+
+ do i = 1, N
+ a(i) = i * 2
+ b(i) = i * 3
+ end do
+
+ !$omp metadirective &
+ !$omp& default (teams loop) &
+ !$omp& default (parallel loop) ! { dg-error "too many 'otherwise' or 'default' clauses in 'metadirective' at .1." }
+ do i = 1, N
+ c(i) = a(i) * b(i)
+ end do
+
+ !$omp metadirective &
+ !$omp& otherwise (teams loop) &
+ !$omp& default (parallel loop) ! { dg-error "too many 'otherwise' or 'default' clauses in 'metadirective' at .1." }
+ do i = 1, N
+ c(i) = a(i) * b(i)
+ end do
+
+ !$omp metadirective &
+ !$omp& otherwise (teams loop) &
+ !$omp& otherwise (parallel loop) ! { dg-error "too many 'otherwise' or 'default' clauses in 'metadirective' at .1." }
+ do i = 1, N
+ c(i) = a(i) * b(i)
+ end do
+
+ !$omp metadirective default (xyz) ! { dg-error "Unclassifiable OpenMP directive at .1." }
+ do i = 1, N
+ c(i) = a(i) * b(i)
+ end do
+
+ !$omp metadirective &
+ !$omp& default (teams loop) & ! { dg-error "expected 'when', 'otherwise', or 'default' at .1." }
+ !$omp& where (device={arch("nvptx")}: parallel loop)
+ do i = 1, N
+ c(i) = a(i) * b(i)
+ end do
+
+ !$omp begin metadirective &
+ !$omp& when (device={arch("nvptx")}: parallel do) &
+ !$omp& default (barrier) ! { dg-error "variant directive used in OMP BEGIN METADIRECTIVE at .1. must have a corresponding end directive" }
+ do i = 1, N
+ c(i) = a(i) * b(i)
+ end do
+ !$omp end metadirective ! { dg-error "Unexpected !.OMP END METADIRECTIVE statement at .1." }
+end program
diff --git a/gcc/testsuite/gfortran.dg/gomp/metadirective-10.f90 b/gcc/testsuite/gfortran.dg/gomp/metadirective-10.f90
new file mode 100644
index 00000000000..5dad5d29eb6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/metadirective-10.f90
@@ -0,0 +1,40 @@
+! { dg-do compile }
+
+program metadirectives
+ implicit none
+ logical :: UseDevice
+
+ !$OMP metadirective &
+ !$OMP when ( user = { condition ( UseDevice ) } &
+ !$OMP : parallel ) &
+ !$OMP default ( parallel )
+ block
+ call bar()
+ end block
+
+ !$OMP metadirective &
+ !$OMP when ( user = { condition ( UseDevice ) } &
+ !$OMP : parallel ) &
+ !$OMP default ( parallel )
+ call bar()
+ !$omp end parallel ! Accepted, because all cases have 'parallel'
+
+ !$OMP begin metadirective &
+ !$OMP when ( user = { condition ( UseDevice ) } &
+ !$OMP : nothing ) &
+ !$OMP default ( parallel )
+ call bar()
+ block
+ call foo()
+ end block
+ !$OMP end metadirective
+
+ !$OMP begin metadirective &
+ !$OMP when ( user = { condition ( UseDevice ) } &
+ !$OMP : parallel ) &
+ !$OMP default ( parallel )
+ call bar()
+ !$omp end parallel ! { dg-error "Unexpected !.OMP END PARALLEL statement at .1." }
+end program ! { dg-error "Unexpected END statement at .1." }
+
+! { dg-error "Unexpected end of file" "" { target *-*-* } 0 }
diff --git a/gcc/testsuite/gfortran.dg/gomp/metadirective-11.f90 b/gcc/testsuite/gfortran.dg/gomp/metadirective-11.f90
new file mode 100644
index 00000000000..e7de70e6259
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/metadirective-11.f90
@@ -0,0 +1,33 @@
+! { dg-do compile }
+! { dg-ice "Statements following a block in a metadirective" }
+! PR fortran/107067
+
+program metadirectives
+ implicit none
+ logical :: UseDevice
+
+ !$OMP begin metadirective &
+ !$OMP when ( user = { condition ( UseDevice ) } &
+ !$OMP : nothing ) &
+ !$OMP default ( parallel )
+ block
+ call foo()
+ end block
+ call bar() ! FIXME/XFAIL ICE in parse_omp_metadirective_body()
+ !$omp end metadirective
+
+
+ !$OMP begin metadirective &
+ !$OMP when ( user = { condition ( UseDevice ) } &
+ !$OMP : nothing ) &
+ !$OMP default ( parallel )
+ block
+ call bar()
+ end block
+ block ! FIXME/XFAIL ICE in parse_omp_metadirective_body()
+ call foo()
+ end block
+ !$omp end metadirective
+end program
+
+
diff --git a/gcc/testsuite/gfortran.dg/gomp/metadirective-2.f90 b/gcc/testsuite/gfortran.dg/gomp/metadirective-2.f90
new file mode 100644
index 00000000000..cdd5e85068e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/metadirective-2.f90
@@ -0,0 +1,62 @@
+! { dg-do compile }
+
+program main
+ integer, parameter :: N = 100
+ integer :: x = 0
+ integer :: y = 0
+ integer :: i
+
+ ! Test implicit default directive
+ !$omp metadirective &
+ !$omp& when (device={arch("nvptx")}: barrier)
+ x = 1
+
+ ! Test implicit default directive combined with a directive that takes a
+ ! do loop.
+ !$omp metadirective &
+ !$omp& when (device={arch("nvptx")}: parallel do)
+ do i = 1, N
+ x = x + i
+ end do
+
+ ! Test with multiple standalone directives.
+ !$omp metadirective &
+ !$omp& when (device={arch("nvptx")}: barrier) &
+ !$omp& default (flush)
+ x = 1
+
+ ! Test combining a standalone directive with one that takes a do loop.
+ !$omp metadirective &
+ !$omp& when (device={arch("nvptx")}: parallel do) &
+ !$omp& default (barrier)
+ do i = 1, N
+ x = x + i
+ end do
+
+ ! Test combining a directive that takes a do loop with one that takes
+ ! a statement body.
+ !$omp begin metadirective &
+ !$omp& when (device={arch("nvptx")}: parallel do) &
+ !$omp& default (parallel)
+ do i = 1, N
+ x = x + i
+ end do
+ !$omp end metadirective
+
+ ! Test labels in the body.
+ !$omp begin metadirective &
+ !$omp& when (device={arch("nvptx")}: parallel do) &
+ !$omp& when (device={arch("gcn")}: parallel)
+ do i = 1, N
+ x = x + i
+ if (x .gt. N/2) goto 10
+10 x = x + 1
+ goto 20
+ x = x + 2
+20 continue
+ end do
+ !$omp end metadirective
+
+ ! Test empty metadirective.
+ !$omp metadirective
+end program
diff --git a/gcc/testsuite/gfortran.dg/gomp/metadirective-3.f90 b/gcc/testsuite/gfortran.dg/gomp/metadirective-3.f90
new file mode 100644
index 00000000000..eca389a7842
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/metadirective-3.f90
@@ -0,0 +1,34 @@
+! { dg-do compile }
+! { dg-additional-options "-fdump-tree-original" }
+! { dg-additional-options "-fdump-tree-gimple" }
+! { dg-additional-options "-fdump-tree-optimized" }
+
+module test
+ integer, parameter :: N = 100
+contains
+ subroutine f (x, y, z)
+ integer :: x(N), y(N), z(N)
+
+ !$omp target map (to: v1, v2) map(from: v3)
+ !$omp metadirective &
+ !$omp& when(device={arch("nvptx")}: teams loop) &
+ !$omp& default(parallel loop)
+ do i = 1, N
+ z(i) = x(i) * y(i)
+ enddo
+ !$omp end target
+ end subroutine
+end module
+
+! The metadirective should be resolved after Gimplification.
+
+! { dg-final { scan-tree-dump-times "#pragma omp metadirective" 1 "original" } }
+! { dg-final { scan-tree-dump-times "when \\(device =.*arch.*nvptx.*\\):" 1 "original" } }
+! { dg-final { scan-tree-dump-times "#pragma omp teams" 1 "original" } }
+! { dg-final { scan-tree-dump-times "default:" 1 "original" } }
+! { dg-final { scan-tree-dump-times "#pragma omp parallel" 1 "original" } }
+! { dg-final { scan-tree-dump-times "#pragma omp loop" 2 "original" } }
+
+! { dg-final { scan-tree-dump-times "#pragma omp metadirective" 1 "gimple" } }
+
+! { dg-final { scan-tree-dump-not "#pragma omp metadirective" "optimized" } }
diff --git a/gcc/testsuite/gfortran.dg/gomp/metadirective-4.f90 b/gcc/testsuite/gfortran.dg/gomp/metadirective-4.f90
new file mode 100644
index 00000000000..2fdc7f3c515
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/metadirective-4.f90
@@ -0,0 +1,39 @@
+! { dg-do compile }
+! { dg-additional-options "-fdump-tree-original" }
+! { dg-additional-options "-fdump-tree-gimple" }
+
+program test
+ implicit none
+ integer, parameter :: N = 100
+ real :: a(N)
+
+ !$omp target map(from: a)
+ call f (a, 3.14159)
+ !$omp end target
+
+ ! TODO: This does not execute a version of f with the default clause
+ ! active as might be expected.
+ call f (a, 2.71828) ! { dg-warning "direct calls to an offloadable function containing metadirectives with a 'construct={target}' selector may produce unexpected results" }
+contains
+ subroutine f (a, x)
+ integer :: i
+ real :: a(N), x
+ !$omp declare target
+
+ !$omp metadirective &
+ !$omp& when (construct={target}: distribute parallel do ) &
+ !$omp& default(parallel do simd)
+ do i = 1, N
+ a(i) = x * i
+ end do
+ end subroutine
+end program
+
+! The metadirective should be resolved during Gimplification.
+
+! { dg-final { scan-tree-dump-times "#pragma omp metadirective" 1 "original" } }
+! { dg-final { scan-tree-dump-times "when \\(construct = .*target.*\\):" 1 "original" } }
+! { dg-final { scan-tree-dump-times "default:" 1 "original" } }
+! { dg-final { scan-tree-dump-times "#pragma omp parallel" 2 "original" } }
+
+! { dg-final { scan-tree-dump-not "#pragma omp metadirective" "gimple" } }
diff --git a/gcc/testsuite/gfortran.dg/gomp/metadirective-5.f90 b/gcc/testsuite/gfortran.dg/gomp/metadirective-5.f90
new file mode 100644
index 00000000000..03970393eb4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/metadirective-5.f90
@@ -0,0 +1,30 @@
+! { dg-do compile }
+! { dg-additional-options "-fdump-tree-gimple" }
+
+module test
+ integer, parameter :: N = 100
+contains
+ subroutine f (a, flag)
+ integer :: a(N)
+ logical :: flag
+ integer :: i
+
+ !$omp metadirective &
+ !$omp& when (user={condition(flag)}: &
+ !$omp& target teams distribute parallel do map(from: a(1:N))) &
+ !$omp& default(parallel do)
+ do i = 1, N
+ a(i) = i
+ end do
+ end subroutine
+end module
+
+! The metadirective should be resolved at parse time, but is currently
+! resolved during Gimplification
+
+! { dg-final { scan-tree-dump-not "#pragma omp metadirective" "gimple" } }
+! { dg-final { scan-tree-dump-times "#pragma omp target" 1 "gimple" } }
+! { dg-final { scan-tree-dump-times "#pragma omp teams" 1 "gimple" } }
+! { dg-final { scan-tree-dump-times "#pragma omp distribute" 1 "gimple" } }
+! { dg-final { scan-tree-dump-times "#pragma omp parallel" 2 "gimple" } }
+! { dg-final { scan-tree-dump-times "#pragma omp for" 2 "gimple" } }
diff --git a/gcc/testsuite/gfortran.dg/gomp/metadirective-6.f90 b/gcc/testsuite/gfortran.dg/gomp/metadirective-6.f90
new file mode 100644
index 00000000000..9b6c371296f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/metadirective-6.f90
@@ -0,0 +1,31 @@
+! { dg-do compile }
+! { dg-additional-options "-fdump-tree-gimple" }
+
+module test
+ integer, parameter :: N = 100
+contains
+ subroutine f (a, run_parallel, run_guided)
+ integer :: a(N)
+ logical :: run_parallel, run_guided
+ integer :: i
+
+ !$omp begin metadirective when(user={condition(run_parallel)}: parallel)
+ !$omp metadirective &
+ !$omp& when(construct={parallel}, user={condition(run_guided)}: &
+ !$omp& do schedule(guided)) &
+ !$omp& when(construct={parallel}: do schedule(static))
+ do i = 1, N
+ a(i) = i
+ end do
+ !$omp end metadirective
+ end subroutine
+end module
+
+! The outer metadirective should be resolved at parse time, but is
+! currently resolved during Gimplification.
+
+! The inner metadirective should be resolved during Gimplificiation.
+
+! { dg-final { scan-tree-dump-not "#pragma omp metadirective" "gimple" } }
+! { dg-final { scan-tree-dump-times "#pragma omp parallel" 1 "gimple" } }
+! { dg-final { scan-tree-dump-times "#pragma omp for" 2 "gimple" } }
diff --git a/gcc/testsuite/gfortran.dg/gomp/metadirective-7.f90 b/gcc/testsuite/gfortran.dg/gomp/metadirective-7.f90
new file mode 100644
index 00000000000..31a44c47359
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/metadirective-7.f90
@@ -0,0 +1,36 @@
+! { dg-do compile }
+! { dg-additional-options "-fdump-tree-gimple" }
+
+program main
+ integer, parameter :: N = 256
+contains
+ subroutine f (a, num)
+ integer :: a(N)
+ integer :: num
+ integer :: i
+
+ !$omp metadirective &
+ !$omp& when (target_device={device_num(num), kind("gpu"), arch("nvptx")}: &
+ !$omp& target parallel do map(tofrom: a(1:N))) &
+ !$omp& when (target_device={device_num(num), kind("gpu"), &
+ !$omp& arch("amdgcn"), isa("gfx906")}: &
+ !$omp& target parallel do) &
+ !$omp& when (target_device={device_num(num), kind("cpu"), arch("x86_64")}: &
+ !$omp& parallel do)
+ do i = 1, N
+ a(i) = a(i) + i
+ end do
+
+ !$omp metadirective &
+ !$omp& when (target_device={kind("gpu"), arch("nvptx")}: &
+ !$omp& target parallel do map(tofrom: a(1:N)))
+ do i = 1, N
+ a(i) = a(i) + i
+ end do
+ end subroutine
+end program
+
+! { dg-final { scan-tree-dump "__builtin_GOMP_evaluate_target_device \\(.+, &\"gpu.x00\"\\\[0\\\], &\"amdgcn.x00\"\\\[0\\\], &\"gfx906.x00\"\\\[0\\\]\\)" "gimple" } }
+! { dg-final { scan-tree-dump "__builtin_GOMP_evaluate_target_device \\(.+, &\"gpu.x00\"\\\[0\\\], &\"nvptx.x00\"\\\[0\\\], 0B\\)" "gimple" } }
+! { dg-final { scan-tree-dump "__builtin_GOMP_evaluate_target_device \\(.+, &\"cpu.x00\"\\\[0\\\], &\"x86_64.x00\"\\\[0\\\], 0B\\)" "gimple" } }
+! { dg-final { scan-tree-dump "__builtin_GOMP_evaluate_target_device \\(-2, &\"gpu.x00\"\\\[0\\\], &\"nvptx.x00\"\\\[0\\\], 0B\\)" "gimple" } }
diff --git a/gcc/testsuite/gfortran.dg/gomp/metadirective-8.f90 b/gcc/testsuite/gfortran.dg/gomp/metadirective-8.f90
new file mode 100644
index 00000000000..1ebcd33a7be
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/metadirective-8.f90
@@ -0,0 +1,22 @@
+! { dg-do compile }
+
+program test
+ integer :: i
+ integer, parameter :: N = 100
+ integer :: sum = 0
+
+ ! The compiler should never consider a situation where both metadirectives
+ ! match, but that does not matter because the spec says "Replacement of
+ ! the metadirective with the directive variant associated with any of the
+ ! dynamic replacement candidates must result in a conforming OpenMP
+ ! program. So the second metadirective is rejected as not being
+ ! a valid loop-nest even if the first one does not match.
+
+!$omp metadirective when (implementation={vendor("ibm")}: &
+ !$omp& target teams distribute)
+ !$omp metadirective when (implementation={vendor("gnu")}: parallel do) ! { dg-error "Unexpected !.OMP METADIRECTIVE statement" }
+ do i = 1, N
+ sum = sum + i
+ end do
+end program
+
diff --git a/gcc/testsuite/gfortran.dg/gomp/metadirective-9.f90 b/gcc/testsuite/gfortran.dg/gomp/metadirective-9.f90
new file mode 100644
index 00000000000..e6ab3fc0a65
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/metadirective-9.f90
@@ -0,0 +1,30 @@
+! { dg-do compile }
+
+program OpenMP_Metadirective_WrongEnd_Test
+ implicit none
+
+ integer :: &
+ iaVS, iV, jV, kV
+ integer, dimension ( 3 ) :: &
+ lV, uV
+ logical :: &
+ UseDevice
+
+ !$OMP metadirective &
+ !$OMP when ( user = { condition ( UseDevice ) } &
+ !$OMP : target teams distribute parallel do simd collapse ( 3 ) &
+ !$OMP private ( iaVS ) ) &
+ !$OMP default ( parallel do simd collapse ( 3 ) private ( iaVS ) )
+ do kV = lV ( 3 ), uV ( 3 )
+ do jV = lV ( 2 ), uV ( 2 )
+ do iV = lV ( 1 ), uV ( 1 )
+
+
+ end do
+ end do
+ end do
+ !$OMP end target teams distribute parallel do simd ! { dg-error "Unexpected !.OMP END TARGET TEAMS DISTRIBUTE PARALLEL DO SIMD statement in an OMP METADIRECTIVE block at .1." }
+
+
+end program
+
diff --git a/gcc/testsuite/gfortran.dg/gomp/metadirective-construct.f90 b/gcc/testsuite/gfortran.dg/gomp/metadirective-construct.f90
new file mode 100644
index 00000000000..ec1f0ee3d9d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/metadirective-construct.f90
@@ -0,0 +1,260 @@
+! { dg-do compile }
+! { dg-additional-options "-foffload=disable -fdump-tree-original -fdump-tree-gimple" }
+
+program main
+implicit none
+
+integer, parameter :: N = 10
+double precision, parameter :: S = 2.0
+double precision :: a(N)
+
+call init (N, a)
+call f1 (N, a, S)
+call check (N, a, S)
+
+call init (N, a)
+call f2 (N, a, S)
+call check (N, a, S)
+
+call init (N, a)
+call f3 (N, a, S)
+call check (N, a, S)
+
+call init (N, a)
+call f4 (N, a, S)
+call check (N, a, S)
+
+call init (N, a)
+call f5 (N, a, S)
+call check (N, a, S)
+
+call init (N, a)
+call f6 (N, a, S)
+call check (N, a, S)
+
+call init (N, a)
+call f7 (N, a, S)
+call check (N, a, S)
+
+call init (N, a)
+call f8 (N, a, S)
+call check (N, a, S)
+
+call init (N, a)
+call f9 (N, a, S)
+call check (N, a, S)
+
+contains
+
+subroutine init (n, a)
+ implicit none
+ integer :: n
+ double precision :: a(n)
+ integer :: i
+ do i = 1, n
+ a(i) = i
+ end do
+end subroutine
+
+subroutine check (n, a, s)
+ implicit none
+ integer :: n
+ double precision :: a(n)
+ double precision :: s
+ integer :: i
+ do i = 1, n
+ if (a(i) /= i * s) error stop
+ end do
+end subroutine
+
+! Check various combinations for enforcing correct ordering of
+! construct matches.
+subroutine f1 (n, a, s)
+ implicit none
+ integer :: n
+ double precision :: a(n)
+ double precision :: s
+ integer :: i
+!$omp target teams
+!$omp parallel
+!$omp metadirective &
+!$omp & when (construct={target} &
+!$omp & : do) &
+!$omp & default (error at(execution) message("f1 match failed"))
+ do i = 1, n
+ a(i) = a(i) * s
+ end do
+!$omp end parallel
+!$omp end target teams
+end subroutine
+
+subroutine f2 (n, a, s)
+ implicit none
+ integer :: n
+ double precision :: a(n)
+ double precision :: s
+ integer :: i
+!$omp target teams
+!$omp parallel
+!$omp metadirective &
+!$omp & when (construct={teams, parallel} &
+!$omp & : do) &
+!$omp & default (error at(execution) message("f2 match failed"))
+ do i = 1, n
+ a(i) = a(i) * s
+ end do
+!$omp end parallel
+!$omp end target teams
+end subroutine
+
+subroutine f3 (n, a, s)
+ implicit none
+ integer :: n
+ double precision :: a(n)
+ double precision :: s
+ integer :: i
+!$omp target teams
+!$omp parallel
+!$omp metadirective &
+!$omp & when (construct={target, teams, parallel} &
+!$omp & : do) &
+!$omp & default (error at(execution) message("f3 match failed"))
+ do i = 1, n
+ a(i) = a(i) * s
+ end do
+!$omp end parallel
+!$omp end target teams
+end subroutine
+
+subroutine f4 (n, a, s)
+ implicit none
+ integer :: n
+ double precision :: a(n)
+ double precision :: s
+ integer :: i
+!$omp target teams
+!$omp parallel
+!$omp metadirective &
+!$omp & when (construct={target, parallel} &
+!$omp & : do) &
+!$omp & default (error at(execution) message("f4 match failed"))
+ do i = 1, n
+ a(i) = a(i) * s
+ end do
+!$omp end parallel
+!$omp end target teams
+end subroutine
+
+subroutine f5 (n, a, s)
+ implicit none
+ integer :: n
+ double precision :: a(n)
+ double precision :: s
+ integer :: i
+!$omp target teams
+!$omp parallel
+!$omp metadirective &
+!$omp & when (construct={target, teams} &
+!$omp & : do) &
+!$omp & default (error at(execution) message("f5 match failed"))
+ do i = 1, n
+ a(i) = a(i) * s
+ end do
+!$omp end parallel
+!$omp end target teams
+end subroutine
+
+! Next batch is for things where the construct doesn't match the context.
+subroutine f6 (n, a, s)
+ implicit none
+ integer :: n
+ double precision :: a(n)
+ double precision :: s
+ integer :: i
+!$omp target
+!$omp teams
+!$omp metadirective &
+!$omp & when (construct={parallel} &
+!$omp & : error at(execution) message("f6 match failed")) &
+!$omp & default (parallel do)
+ do i = 1, n
+ a(i) = a(i) * s
+ end do
+!$omp end teams
+!$omp end target
+end subroutine
+
+subroutine f7 (n, a, s)
+ implicit none
+ integer :: n
+ double precision :: a(n)
+ double precision :: s
+ integer :: i
+!$omp target
+!$omp teams
+!$omp metadirective &
+!$omp & when (construct={target, parallel} &
+!$omp & : error at(execution) message("f7 match failed")) &
+!$omp & default (parallel do)
+ do i = 1, n
+ a(i) = a(i) * s
+ end do
+!$omp end teams
+!$omp end target
+end subroutine
+
+subroutine f8 (n, a, s)
+ implicit none
+ integer :: n
+ double precision :: a(n)
+ double precision :: s
+ integer :: i
+!$omp target
+!$omp teams
+!$omp metadirective &
+!$omp & when (construct={parallel, target} &
+!$omp & : error at(execution) message("f8 match failed")) &
+!$omp & default (parallel do)
+ do i = 1, n
+ a(i) = a(i) * s
+ end do
+!$omp end teams
+!$omp end target
+end subroutine
+
+! Next test choosing the best alternative when there are multiple
+! matches.
+subroutine f9 (n, a, s)
+ implicit none
+ integer :: n
+ double precision :: a(n)
+ double precision :: s
+ integer :: i
+!$omp target teams
+!$omp parallel
+!$omp metadirective &
+!$omp & when (construct={teams, parallel} &
+!$omp & : error at(execution) message("f9 match incorrect 1")) &
+!$omp & when (construct={target, teams, parallel} &
+!$omp & : do) &
+!$omp & when (construct={target, teams} &
+!$omp & : error at(execution) message("f9 match incorrect 2")) &
+!$omp & default (error at(execution) message("f9 match failed"))
+ do i = 1, n
+ a(i) = a(i) * s
+ end do
+!$omp end parallel
+!$omp end target teams
+end subroutine
+
+end program
+
+! Note there are no tests for the matching the extended simd clause
+! syntax, which is only useful for "declare variant".
+
+
+! After parsing, there should be a runtime error call for each of the
+! failure cases, but they should all be optimized away during OMP
+! lowering.
+! { dg-final { scan-tree-dump-times "__builtin_GOMP_error" 11 "original" } }
+! { dg-final { scan-tree-dump-not "__builtin_GOMP_error" "gimple" } }
diff --git a/gcc/testsuite/gfortran.dg/gomp/metadirective-no-score.f90 b/gcc/testsuite/gfortran.dg/gomp/metadirective-no-score.f90
new file mode 100644
index 00000000000..968ce609b10
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/metadirective-no-score.f90
@@ -0,0 +1,122 @@
+! { dg-do compile { target x86_64-*-* } }
+! { dg-additional-options "-foffload=disable" }
+
+! This test is expected to fail with compile-time errors:
+! "A trait-score cannot be specified in traits from the construct,
+! device or target_device trait-selector-sets."
+
+
+subroutine f1 (n, a, s)
+ implicit none
+ integer :: n
+ double precision :: a(*)
+ double precision :: s
+ integer :: i
+!$omp metadirective &
+!$omp& when (device={kind (score(5) : host)} &
+!$omp& : parallel do)
+ ! { dg-error ".score. cannot be specified in traits in the .device. trait-selector-set" "" { target *-*-*} .-2 }
+ do i = 1, n
+ a(i) = a(i) * s;
+ end do
+end subroutine
+
+subroutine f2 (n, a, s)
+ implicit none
+ integer :: n
+ double precision :: a(*)
+ double precision :: s
+ integer :: i
+!$omp metadirective &
+!$omp& when (device={kind (host), arch (score(6) : x86_64), isa (avx512f)} &
+!$omp& : parallel do)
+ ! { dg-error ".score. cannot be specified in traits in the .device. trait-selector-set" "" { target *-*-*} .-2 }
+ do i = 1, n
+ a(i) = a(i) * s;
+ end do
+end subroutine
+
+subroutine f3 (n, a, s)
+ implicit none
+ integer :: n
+ double precision :: a(*)
+ double precision :: s
+ integer :: i
+!$omp metadirective &
+!$omp& when (device={kind (host), arch (score(6) : x86_64), &
+!$omp& isa (score(7): avx512f)} &
+!$omp& : parallel do)
+ ! { dg-error ".score. cannot be specified in traits in the .device. trait-selector-set" "" { target *-*-*} .-3 }
+ do i = 1, n
+ a(i) = a(i) * s;
+ end do
+end subroutine
+
+subroutine f4 (n, a, s)
+ implicit none
+ integer :: n
+ double precision :: a(*)
+ double precision :: s
+ integer :: i
+ integer, parameter :: omp_initial_device = -1
+!$omp metadirective &
+!$omp& when (target_device={device_num (score(42) : omp_initial_device), &
+!$omp& kind (host)} &
+!$omp& : parallel do)
+ ! { dg-error ".score. cannot be specified in traits in the .target_device. trait-selector-set" "" { target *-*-*} .-3 }
+ do i = 1, n
+ a(i) = a(i) * s;
+ end do
+end subroutine
+
+subroutine f5 (n, a, s)
+ implicit none
+ integer :: n
+ double precision :: a(*)
+ double precision :: s
+ integer :: i
+ integer, parameter :: omp_initial_device = -1
+!$omp metadirective &
+!$omp& when (target_device={device_num(omp_initial_device), &
+!$omp& kind (score(5) : host)} &
+!$omp& : parallel do)
+ ! { dg-error ".score. cannot be specified in traits in the .target_device. trait-selector-set" "" { target *-*-*} .-2 }
+ do i = 1, n
+ a(i) = a(i) * s;
+ end do
+end subroutine
+
+subroutine f6 (n, a, s)
+ implicit none
+ integer :: n
+ double precision :: a(*)
+ double precision :: s
+ integer :: i
+ integer, parameter :: omp_initial_device = -1
+!$omp metadirective &
+!$omp& when (target_device={device_num(omp_initial_device), kind (host), &
+!$omp& arch (score(6) : x86_64), isa (avx512f)} &
+!$omp& : parallel do)
+ ! { dg-error ".score. cannot be specified in traits in the .target_device. trait-selector-set" "" { target *-*-*} .-2 }
+ do i = 1, n
+ a(i) = a(i) * s;
+ end do
+end subroutine
+
+subroutine f7 (n, a, s)
+ implicit none
+ integer :: n
+ double precision :: a(*)
+ double precision :: s
+ integer :: i
+ integer, parameter :: omp_initial_device = -1
+!$omp metadirective &
+!$omp& when (target_device={device_num(omp_initial_device), kind (host), &
+!$omp& arch (score(6) : x86_64), &
+!$omp& isa (score(7): avx512f)} &
+!$omp& : parallel do)
+ ! { dg-error ".score. cannot be specified in traits in the .target_device. trait-selector-set" "" { target *-*-*} .-3 }
+ do i = 1, n
+ a(i) = a(i) * s;
+ end do
+end subroutine
diff --git a/gcc/testsuite/gfortran.dg/gomp/pure-1.f90 b/gcc/testsuite/gfortran.dg/gomp/pure-1.f90
index 598e455d2e9..15681ac604a 100644
--- a/gcc/testsuite/gfortran.dg/gomp/pure-1.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/pure-1.f90
@@ -86,3 +86,10 @@ pure integer function func_simd(n)
end do
func_simd = r
end
+
+!pure logical function func_metadirective()
+logical function func_metadirective()
+ implicit none
+ !$omp metadirective
+ func_metadirective = .false.
+end
diff --git a/gcc/testsuite/gfortran.dg/gomp/pure-2.f90 b/gcc/testsuite/gfortran.dg/gomp/pure-2.f90
index 1e3cf8c9416..25d6069b236 100644
--- a/gcc/testsuite/gfortran.dg/gomp/pure-2.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/pure-2.f90
@@ -26,14 +26,6 @@ logical function func_interchange(n)
end do
end
-
-!pure logical function func_metadirective()
-logical function func_metadirective()
- implicit none
- !$omp metadirective ! { dg-error "Unclassifiable OpenMP directive" }
- func_metadirective = .false.
-end
-
!pure logical function func_reverse(n)
logical function func_reverse(n)
implicit none
diff --git a/libgomp/testsuite/libgomp.fortran/metadirective-1.f90 b/libgomp/testsuite/libgomp.fortran/metadirective-1.f90
new file mode 100644
index 00000000000..7b3e09f7c2a
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/metadirective-1.f90
@@ -0,0 +1,61 @@
+! { dg-do run }
+
+program test
+ implicit none
+
+ integer, parameter :: N = 100
+ integer :: x(N), y(N), z(N)
+ integer :: i
+
+ do i = 1, N
+ x(i) = i;
+ y(i) = -i;
+ end do
+
+ call f (x, y, z)
+
+ do i = 1, N
+ if (z(i) .ne. x(i) * y(i)) stop 1
+ end do
+
+ ! -----
+ do i = 1, N
+ x(i) = i;
+ y(i) = -i;
+ end do
+
+ call g (x, y, z)
+
+ do i = 1, N
+ if (z(i) .ne. x(i) * y(i)) stop 1
+ end do
+
+contains
+ subroutine f (x, y, z)
+ integer :: x(N), y(N), z(N)
+
+ !$omp target map (to: x, y) map(from: z)
+ block
+ !$omp metadirective &
+ !$omp& when(device={arch("nvptx")}: teams loop) &
+ !$omp& default(parallel loop)
+ do i = 1, N
+ z(i) = x(i) * y(i)
+ enddo
+ end block
+ end subroutine
+ subroutine g (x, y, z)
+ integer :: x(N), y(N), z(N)
+
+ !$omp target map (to: x, y) map(from: z)
+ block
+ !$omp metadirective &
+ !$omp& when(device={arch("nvptx")}: teams loop) &
+ !$omp& default(parallel loop)
+ do i = 1, N
+ z(i) = x(i) * y(i)
+ enddo
+ end block
+ !$omp end target
+ end subroutine
+end program
diff --git a/libgomp/testsuite/libgomp.fortran/metadirective-2.f90 b/libgomp/testsuite/libgomp.fortran/metadirective-2.f90
new file mode 100644
index 00000000000..d83474cf2db
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/metadirective-2.f90
@@ -0,0 +1,40 @@
+! { dg-do run }
+
+program test
+ implicit none
+ integer, parameter :: N = 100
+ real, parameter :: PI_CONST = 3.14159
+ real, parameter :: E_CONST = 2.71828
+ real, parameter :: EPSILON = 0.001
+ integer :: i
+ real :: a(N)
+
+ !$omp target map(from: a)
+ call f (a, PI_CONST)
+ !$omp end target
+
+ do i = 1, N
+ if (abs (a(i) - (PI_CONST * i)) .gt. EPSILON) stop 1
+ end do
+
+ ! TODO: This does not execute a version of f with the default clause
+ ! active as might be expected.
+ call f (a, E_CONST) ! { dg-warning "direct calls to an offloadable function containing metadirectives with a 'construct={target}' selector may produce unexpected results" }
+
+ do i = 1, N
+ if (abs (a(i) - (E_CONST * i)) .gt. EPSILON) stop 2
+ end do
+contains
+ subroutine f (a, x)
+ integer :: i
+ real :: a(N), x
+ !$omp declare target
+
+ !$omp metadirective &
+ !$omp& when (construct={target}: distribute parallel do ) &
+ !$omp& default(parallel do simd)
+ do i = 1, N
+ a(i) = x * i
+ end do
+ end subroutine
+end program
diff --git a/libgomp/testsuite/libgomp.fortran/metadirective-3.f90 b/libgomp/testsuite/libgomp.fortran/metadirective-3.f90
new file mode 100644
index 00000000000..693c40bca5a
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/metadirective-3.f90
@@ -0,0 +1,29 @@
+! { dg-do run }
+
+program test
+ implicit none
+
+ integer, parameter :: N = 100
+ integer :: a(N)
+ integer :: res
+
+ if (f (a, .false.)) stop 1
+ if (.not. f (a, .true.)) stop 2
+contains
+ logical function f (a, flag)
+ integer :: a(N)
+ logical :: flag
+ logical :: res = .false.
+ integer :: i
+ f = .false.
+ !$omp metadirective &
+ !$omp& when (user={condition(.not. flag)}: &
+ !$omp& target teams distribute parallel do &
+ !$omp& map(from: a(1:N)) private(res)) &
+ !$omp& default(parallel do)
+ do i = 1, N
+ a(i) = i
+ f = .true.
+ end do
+ end function
+end program
diff --git a/libgomp/testsuite/libgomp.fortran/metadirective-4.f90 b/libgomp/testsuite/libgomp.fortran/metadirective-4.f90
new file mode 100644
index 00000000000..04fdf61489c
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/metadirective-4.f90
@@ -0,0 +1,46 @@
+! { dg-do run }
+
+program test
+ use omp_lib
+
+ implicit none
+ integer, parameter :: N = 100
+ integer :: a(N)
+ logical :: is_parallel, is_static
+
+ ! is_static is always set if run_parallel is false.
+ call f (a, .false., .false., is_parallel, is_static)
+ if (is_parallel .or. .not. is_static) stop 1
+
+ call f (a, .false., .true., is_parallel, is_static)
+ if (is_parallel .or. .not. is_static) stop 2
+
+ call f (a, .true., .false., is_parallel, is_static)
+ if (.not. is_parallel .or. is_static) stop 3
+
+ call f (a, .true., .true., is_parallel, is_static)
+ if (.not. is_parallel .or. .not. is_static) stop 4
+contains
+ subroutine f (a, run_parallel, run_static, is_parallel, is_static)
+ integer :: a(N)
+ logical, intent(in) :: run_parallel, run_static
+ logical, intent(out) :: is_parallel, is_static
+ integer :: i
+
+ is_parallel = .false.
+ is_static = .false.
+
+ !$omp begin metadirective when(user={condition(run_parallel)}: parallel)
+ if (omp_in_parallel ()) is_parallel = .true.
+
+ !$omp metadirective &
+ !$omp& when(construct={parallel}, user={condition(.not. run_static)}: &
+ !$omp& do schedule(guided) private(is_static)) &
+ !$omp& when(construct={parallel}: do schedule(static))
+ do i = 1, N
+ a(i) = i
+ is_static = .true.
+ end do
+ !$omp end metadirective
+ end subroutine
+end program
diff --git a/libgomp/testsuite/libgomp.fortran/metadirective-5.f90 b/libgomp/testsuite/libgomp.fortran/metadirective-5.f90
new file mode 100644
index 00000000000..3992286dc08
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/metadirective-5.f90
@@ -0,0 +1,44 @@
+! { dg-do run }
+
+program main
+ use omp_lib
+
+ implicit none
+
+ integer, parameter :: N = 100
+ integer :: a(N)
+ integer :: on_device_count = 0
+ integer :: i
+
+ do i = 1, N
+ a(i) = i
+ end do
+
+ do i = 0, omp_get_num_devices ()
+ on_device_count = on_device_count + f (a, i)
+ end do
+
+ if (on_device_count .ne. omp_get_num_devices ()) stop 1
+
+ do i = 1, N
+ if (a(i) .ne. 2 * i) stop 2;
+ end do
+contains
+ integer function f (a, num)
+ integer, intent(inout) :: a(N)
+ integer, intent(in) :: num
+ integer :: on_device
+ integer :: i
+
+ on_device = 0
+ !$omp metadirective &
+ !$omp& when (target_device={device_num(num), kind("gpu")}: &
+ !$omp& target parallel do map(to: a(1:N)), map(from: on_device)) &
+ !$omp& default (parallel do private(on_device))
+ do i = 1, N
+ a(i) = a(i) + i
+ on_device = 1
+ end do
+ f = on_device;
+ end function
+end program
diff --git a/libgomp/testsuite/libgomp.fortran/metadirective-6.f90 b/libgomp/testsuite/libgomp.fortran/metadirective-6.f90
new file mode 100644
index 00000000000..436fdbade2f
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/metadirective-6.f90
@@ -0,0 +1,58 @@
+! { dg-do compile }
+
+program test
+ implicit none
+
+ integer, parameter :: N = 100
+ integer :: x(N), y(N), z(N)
+ integer :: i
+
+contains
+ subroutine f (x, y, z)
+ integer :: x(N), y(N), z(N)
+
+ !$omp target map (to: x, y) map(from: z) ! { dg-error "OMP TARGET region at .1. with a nested TEAMS at .2. may not contain any other statement, declaration or directive outside of the single TEAMS construct" }
+ block
+ !$omp metadirective &
+ !$omp& when(device={arch("nvptx")}: teams loop) &
+ !$omp& default(parallel loop) ! { dg-error "\\(1\\)" }
+ ! FIXME: The line above should be the same error as above but some fails here with -fno-diagnostics-show-caret
+ ! Seems as if some gcc/testsuite/ fix is missing for libgomp/testsuite
+ do i = 1, N
+ z(i) = x(i) * y(i)
+ enddo
+ z(N) = z(N) + 1 ! <<< invalid
+ end block
+ end subroutine
+
+ subroutine f2 (x, y, z)
+ integer :: x(N), y(N), z(N)
+
+ !$omp target map (to: x, y) map(from: z) ! { dg-error "OMP TARGET region at .1. with a nested TEAMS may not contain any other statement, declaration or directive outside of the single TEAMS construct" }
+ block
+ integer :: i ! << invalid
+ !$omp metadirective &
+ !$omp& when(device={arch("nvptx")}: teams loop) &
+ !$omp& default(parallel loop)
+ do i = 1, N
+ z(i) = x(i) * y(i)
+ enddo
+ end block
+ end subroutine
+ subroutine g (x, y, z)
+ integer :: x(N), y(N), z(N)
+
+ !$omp target map (to: x, y) map(from: z) ! { dg-error "OMP TARGET region at .1. with a nested TEAMS may not contain any other statement, declaration or directive outside of the single TEAMS construct" }
+ block
+ !$omp metadirective & ! <<<< invalid
+ !$omp& when(device={arch("nvptx")}: flush) &
+ !$omp& default(nothing)
+ !$omp teams loop
+ do i = 1, N
+ z(i) = x(i) * y(i)
+ enddo
+ end block
+ !$omp end target
+ end subroutine
+
+end program
--
2.25.1
^ permalink raw reply [flat|nested] 13+ messages in thread
* [PATCH 08/12] OpenMP: Reject other properties with kind(any)
2024-05-04 21:21 [PATCH 00/12] OpenMP: Metadirective support + "declare variant" improvements Sandra Loosemore
` (6 preceding siblings ...)
2024-05-04 21:21 ` [PATCH 07/12] OpenMP: Fortran front-end support " Sandra Loosemore
@ 2024-05-04 21:21 ` Sandra Loosemore
2024-05-04 21:21 ` [PATCH 09/12] OpenMP: Extend dynamic selector support to declare variant Sandra Loosemore
` (3 subsequent siblings)
11 siblings, 0 replies; 13+ messages in thread
From: Sandra Loosemore @ 2024-05-04 21:21 UTC (permalink / raw)
To: gcc-patches; +Cc: jakub, tburnus
The OpenMP spec says:
"If trait-property any is specified in the kind trait-selector of the
device selector set or the target_device selector sets, no other
trait-property may be specified in the same selector set."
GCC was not previously enforcing this restriction and several testcases
included such valid constructs. This patch fixes it.
gcc/ChangeLog
* omp-general.cc (omp_check_context_selector): Reject other
properties in the same selector set with kind(any).
gcc/testsuite/ChangeLog
* c-c++-common/gomp/declare-variant-10.c: Fix broken tests.
* c-c++-common/gomp/declare-variant-3.c: Likewise.
* c-c++-common/gomp/declare-variant-9.c: Likewise.
* c-c++-common/gomp/declare-variant-any.c: New.
* gfortran.dg/gomp/declare-variant-10.f90: Fix broken tests.
* gfortran.dg/gomp/declare-variant-3.f90: Likewise.
* gfortran.dg/gomp/declare-variant-9.f90: Likewise.
* gfortran.dg/gomp/declare-variant-any.f90: Likewise.
---
gcc/omp-general.cc | 31 +++++++++++++++++++
.../c-c++-common/gomp/declare-variant-10.c | 4 +--
.../c-c++-common/gomp/declare-variant-3.c | 10 ++----
.../c-c++-common/gomp/declare-variant-9.c | 4 +--
.../c-c++-common/gomp/declare-variant-any.c | 10 ++++++
.../gfortran.dg/gomp/declare-variant-10.f90 | 4 +--
.../gfortran.dg/gomp/declare-variant-3.f90 | 12 ++-----
.../gfortran.dg/gomp/declare-variant-9.f90 | 2 +-
.../gfortran.dg/gomp/declare-variant-any.f90 | 28 +++++++++++++++++
9 files changed, 82 insertions(+), 23 deletions(-)
create mode 100644 gcc/testsuite/c-c++-common/gomp/declare-variant-any.c
create mode 100644 gcc/testsuite/gfortran.dg/gomp/declare-variant-any.f90
diff --git a/gcc/omp-general.cc b/gcc/omp-general.cc
index 6f36b5d163f..23072b10d75 100644
--- a/gcc/omp-general.cc
+++ b/gcc/omp-general.cc
@@ -1277,6 +1277,8 @@ omp_check_context_selector (location_t loc, tree ctx, bool metadirective_p)
for (tree tss = ctx; tss; tss = TREE_CHAIN (tss))
{
enum omp_tss_code tss_code = OMP_TSS_CODE (tss);
+ bool saw_any_prop = false;
+ bool saw_other_prop = false;
/* FIXME: not implemented yet. */
if (!metadirective_p && tss_code == OMP_TRAIT_SET_TARGET_DEVICE)
@@ -1314,6 +1316,27 @@ omp_check_context_selector (location_t loc, tree ctx, bool metadirective_p)
else
ts_seen[ts_code] = true;
+
+ /* If trait-property "any" is specified in the "kind"
+ trait-selector of the "device" selector set or the
+ "target_device" selector sets, no other trait-property
+ may be specified in the same selector set. */
+ if (ts_code == OMP_TRAIT_DEVICE_KIND)
+ for (tree p = OMP_TS_PROPERTIES (ts); p; p = TREE_CHAIN (p))
+ {
+ const char *prop = omp_context_name_list_prop (p);
+ if (!prop)
+ continue;
+ else if (strcmp (prop, "any") == 0)
+ saw_any_prop = true;
+ else
+ saw_other_prop = true;
+ }
+ else if (ts_code == OMP_TRAIT_DEVICE_ARCH
+ || ts_code == OMP_TRAIT_DEVICE_ISA
+ || ts_code == OMP_TRAIT_DEVICE_NUM)
+ saw_other_prop = true;
+
if (omp_ts_map[ts_code].valid_properties == NULL)
continue;
@@ -1366,6 +1389,14 @@ omp_check_context_selector (location_t loc, tree ctx, bool metadirective_p)
break;
}
}
+
+ if (saw_any_prop && saw_other_prop)
+ {
+ error_at (loc,
+ "no other trait-property may be specified "
+ "in the same selector set with %<kind(\"any\")%>");
+ return error_mark_node;
+ }
}
return ctx;
}
diff --git a/gcc/testsuite/c-c++-common/gomp/declare-variant-10.c b/gcc/testsuite/c-c++-common/gomp/declare-variant-10.c
index 2b8a39425b1..e77693430d1 100644
--- a/gcc/testsuite/c-c++-common/gomp/declare-variant-10.c
+++ b/gcc/testsuite/c-c++-common/gomp/declare-variant-10.c
@@ -7,7 +7,7 @@ void f01 (void);
#pragma omp declare variant (f01) match (device={isa(avx512f,avx512bw)})
void f02 (void);
void f03 (void);
-#pragma omp declare variant (f03) match (device={kind("any"),arch(x86_64),isa(avx512f,avx512bw)})
+#pragma omp declare variant (f03) match (device={arch(x86_64),isa(avx512f,avx512bw)})
void f04 (void);
void f05 (void);
#pragma omp declare variant (f05) match (device={kind(gpu)})
@@ -28,7 +28,7 @@ void f15 (void);
#pragma omp declare variant (f15) match (device={isa(sse4,ssse3),arch(i386)})
void f16 (void);
void f17 (void);
-#pragma omp declare variant (f17) match (device={kind(any,fpga)})
+#pragma omp declare variant (f17) match (device={kind(fpga)})
void f18 (void);
#pragma omp declare target
diff --git a/gcc/testsuite/c-c++-common/gomp/declare-variant-3.c b/gcc/testsuite/c-c++-common/gomp/declare-variant-3.c
index f5d7797f458..0d772d7aaab 100644
--- a/gcc/testsuite/c-c++-common/gomp/declare-variant-3.c
+++ b/gcc/testsuite/c-c++-common/gomp/declare-variant-3.c
@@ -29,13 +29,13 @@ void f17 (void);
void f18 (void);
#pragma omp declare variant (f13) match (device={kind(fpga)})
void f19 (void);
-#pragma omp declare variant (f13) match (device={kind(any,any)})
+#pragma omp declare variant (f13) match (device={kind(any)})
void f20 (void);
#pragma omp declare variant (f13) match (device={kind(host,nohost)})
void f21 (void);
#pragma omp declare variant (f13) match (device={kind("cpu","gpu","fpga")})
void f22 (void);
-#pragma omp declare variant (f13) match (device={kind(any,cpu,nohost)})
+#pragma omp declare variant (f13) match (device={kind(cpu,nohost)})
void f23 (void);
#pragma omp declare variant (f13) match (device={isa(avx)})
void f24 (void);
@@ -139,12 +139,8 @@ void f72 (void);
void f73 (void);
#pragma omp declare variant (f13) match (user={condition(score(25):1)})
void f74 (void);
-#pragma omp declare variant (f13) match (device={kind(any,"any")})
+#pragma omp declare variant (f13) match (device={kind("any")})
void f75 (void);
-#pragma omp declare variant (f13) match (device={kind("any","any")})
-void f76 (void);
-#pragma omp declare variant (f13) match (device={kind("any",any)})
-void f77 (void);
#pragma omp declare variant (f13) match (implementation={vendor(nvidia)})
void f78 (void);
#pragma omp declare variant (f13) match (user={condition(score(0):0)})
diff --git a/gcc/testsuite/c-c++-common/gomp/declare-variant-9.c b/gcc/testsuite/c-c++-common/gomp/declare-variant-9.c
index 5ee75892f2d..da96c81eb6f 100644
--- a/gcc/testsuite/c-c++-common/gomp/declare-variant-9.c
+++ b/gcc/testsuite/c-c++-common/gomp/declare-variant-9.c
@@ -7,7 +7,7 @@ void f01 (void);
#pragma omp declare variant (f01) match (device={isa("avx512f",avx512bw)})
void f02 (void);
void f03 (void);
-#pragma omp declare variant (f03) match (device={kind(any),arch(x86_64),isa("avx512f","avx512bw")})
+#pragma omp declare variant (f03) match (device={arch(x86_64),isa("avx512f","avx512bw")})
void f04 (void);
void f05 (void);
#pragma omp declare variant (f05) match (device={kind(gpu)})
@@ -28,7 +28,7 @@ void f15 (void);
#pragma omp declare variant (f15) match (device={isa(sse4,ssse3),arch(i386)})
void f16 (void);
void f17 (void);
-#pragma omp declare variant (f17) match (device={kind("any","fpga")})
+#pragma omp declare variant (f17) match (device={kind("fpga")})
void f18 (void);
void
diff --git a/gcc/testsuite/c-c++-common/gomp/declare-variant-any.c b/gcc/testsuite/c-c++-common/gomp/declare-variant-any.c
new file mode 100644
index 00000000000..ad932109077
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/gomp/declare-variant-any.c
@@ -0,0 +1,10 @@
+extern int f1 (int);
+extern int f2 (int);
+extern int f3 (int);
+extern int f4 (int);
+
+#pragma omp declare variant (f1) match (device={kind(any,gpu)}) /* { dg-error "no other trait-property may be specified" } */
+#pragma omp declare variant (f2) match (device={kind(cpu,"any")}) /* { dg-error "no other trait-property may be specified" } */
+#pragma omp declare variant (f3) match (device={kind("any"),arch(x86_64)}) /* { dg-error "no other trait-property may be specified" } */
+#pragma omp declare variant (f4) match (device={arch(x86_64),kind(any)}) /* { dg-error "no other trait-property may be specified" } */
+int f (int);
diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-variant-10.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-variant-10.f90
index 2f09146a10d..01f59c52808 100644
--- a/gcc/testsuite/gfortran.dg/gomp/declare-variant-10.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/declare-variant-10.f90
@@ -15,7 +15,7 @@ contains
subroutine f03 ()
end subroutine
subroutine f04 ()
- !$omp declare variant (f03) match (device={kind("any"),arch(x86_64),isa(avx512f,avx512bw)})
+ !$omp declare variant (f03) match (device={arch(x86_64),isa(avx512f,avx512bw)})
end subroutine
subroutine f05 ()
end subroutine
@@ -50,7 +50,7 @@ contains
subroutine f17 ()
end subroutine
subroutine f18 ()
- !$omp declare variant (f17) match (device={kind(any,fpga)})
+ !$omp declare variant (f17) match (device={kind(fpga)})
end subroutine
subroutine test1 ()
diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-variant-3.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-variant-3.f90
index 6b23d40e410..30733209e14 100644
--- a/gcc/testsuite/gfortran.dg/gomp/declare-variant-3.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/declare-variant-3.f90
@@ -51,7 +51,7 @@ contains
!$omp declare variant (f13) match (device={kind(fpga)})
end subroutine
subroutine f20 ()
- !$omp declare variant (f13) match (device={kind(any,any)})
+ !$omp declare variant (f13) match (device={kind(any)})
end subroutine
subroutine f21 ()
!$omp declare variant (f13) match (device={kind(host,nohost)})
@@ -60,7 +60,7 @@ contains
!$omp declare variant (f13) match (device={kind("cpu","gpu","fpga")})
end subroutine
subroutine f23 ()
- !$omp declare variant (f13) match (device={kind(any,cpu,nohost)})
+ !$omp declare variant (f13) match (device={kind(cpu,nohost)})
end subroutine
subroutine f24 ()
!$omp declare variant (f13) match (device={isa(avx)})
@@ -219,13 +219,7 @@ contains
!$omp declare variant (f13) match (user={condition(score(25):.true.)})
end subroutine
subroutine f75 ()
- !$omp declare variant (f13) match (device={kind(any,"any")})
- end subroutine
- subroutine f76 ()
- !$omp declare variant (f13) match (device={kind("any","any")})
- end subroutine
- subroutine f77 ()
- !$omp declare variant (f13) match (device={kind("any",any)})
+ !$omp declare variant (f13) match (device={kind("any")})
end subroutine
subroutine f78 ()
!$omp declare variant (f13) match (implementation={vendor(nvidia)})
diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-variant-9.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-variant-9.f90
index ebd066609f3..297bff97d5e 100644
--- a/gcc/testsuite/gfortran.dg/gomp/declare-variant-9.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/declare-variant-9.f90
@@ -38,7 +38,7 @@ contains
subroutine f17 ()
end subroutine
subroutine f18 ()
- !$omp declare variant (f17) match (device={kind("any","fpga")})
+ !$omp declare variant (f17) match (device={kind("fpga")})
end subroutine
subroutine test1 ()
diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-variant-any.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-variant-any.f90
new file mode 100644
index 00000000000..01540008724
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/declare-variant-any.f90
@@ -0,0 +1,28 @@
+integer function f1 (x)
+ integer, intent(in) :: x
+ f1 = x + 1
+end function
+integer function f2 (x)
+ integer, intent(in) :: x
+ f2 = x + 2
+end function
+integer function f3 (x)
+ integer, intent(in) :: x
+ f3 = x + 3
+end function
+integer function f4 (x)
+ integer, intent(in) :: x
+ f4 = x + 4
+end function
+
+integer function f (x)
+ integer, intent(in) :: x
+
+ !$omp declare variant (f1) match (device={kind(any,gpu)}) ! { dg-error "no other trait-property may be specified" }
+ !$omp declare variant (f2) match (device={kind(cpu,"any")}) ! { dg-error "no other trait-property may be specified" }
+ !$omp declare variant (f3) match (device={kind("any"),arch(x86_64)}) ! { dg-error "no other trait-property may be specified" }
+ !$omp declare variant (f4) match (device={arch(x86_64),kind(any)}) ! { dg-error "no other trait-property may be specified" }
+
+ f = x
+end function
+
--
2.25.1
^ permalink raw reply [flat|nested] 13+ messages in thread
* [PATCH 09/12] OpenMP: Extend dynamic selector support to declare variant
2024-05-04 21:21 [PATCH 00/12] OpenMP: Metadirective support + "declare variant" improvements Sandra Loosemore
` (7 preceding siblings ...)
2024-05-04 21:21 ` [PATCH 08/12] OpenMP: Reject other properties with kind(any) Sandra Loosemore
@ 2024-05-04 21:21 ` Sandra Loosemore
2024-05-04 21:21 ` [PATCH 10/12] OpenMP: Remove dead code from declare variant reimplementation Sandra Loosemore
` (2 subsequent siblings)
11 siblings, 0 replies; 13+ messages in thread
From: Sandra Loosemore @ 2024-05-04 21:21 UTC (permalink / raw)
To: gcc-patches; +Cc: jakub, tburnus
This patch extends the mechanisms previously added to support dynamic
selectors in metavariant constructs to also apply to "declare
variant". The front-end mechanisms used to handle "declare variant"
via attributes attached to the function decls remain the same, but the
gimplifier now uses the same internal data structures and helper
functions as metadirective to score and sort "declare variant"
alternatives, and constructs a gomp_metadirective node for variant
calls that cannot be resolved at gimplification time. During late
resolution, this gomp_metadirective is processed in exactly the same
way as for real metadirectives.
During implementation of this functionality, a number of bugs were
discovered in the previous selector scoring and matching code:
* Metadirective resolution was failing to account for scoring in
"declare simd" clones, and was also relying on calling a function to
match construct constructors that's only useful during
gimplification during late resolution long after that pass.
* The construct constructor scoring was previously implemented backwards
from the specification (PR114596); a number of testcases were also broken
in the same way as the implementation.
* The special rules for matching simdlen and aligned properties on simd
selectors were not implemented (nor were these properties on metadirectives
being rejected per the OpenMP spec).
This patch includes a new implementation of this functionality that
has cleaner interfaces and is hopefully(!) easier to correlate to
requirements of the OpenMP specification. Instead of relying on the
gimplifier to score construct selectors, the scoring code has been
consolidated in omp-general.cc with the gimplifier only providing
the OpenMP construct context surrounding the metadirective or variant
call. This is cached on the gomp_metadirective if necessary for late
resolution.
An additional improvement added in this patch is that for both
metadirective and "declare variant", if late resolution is required the
gimplifier now discards all alternatives that are known not to match.
Note that this patch leaves a substantial amount of dead code that
was used to support the former late "declare variant" resolution strategy,
notably the declare_variant_alt and calls_declare_variant_alt flags on
cgraph_node and all the code that touches those fields. The next
patch in this series removes that unused code.
Another issue not addressed in this patch is the special scoping rules
for expressions in "declare variant" dynamic selectors, which is still
under discussion in PR113904. We expect this to be fixed separately.
gcc/c/ChangeLog
* c-parser.c (c_parser_omp_context_selector): Remove metadirective_p
parameter and conditionalization.
(c_parser_omp_context_selector_specification): Remove metadirective_p
parameter and adjust call not to pass it on.
(c_finish_omp_declare_variant): Adjust arguments on calls to
c_parser_omp_context_selector_specification and
omp_context_selector_matches.
(c_parser_omp_metadirective): Likewise.
gcc/cp/ChangeLog
* cp-tree.h (struct saved_scope): Add new field
x_processing_omp_trait_property_expr.
(processing_omp_trait_property_expr): Define
* decl.cc (omp_declare_variant_finalize_one): Adjust arguments
to omp_context_selector_matches.
* parser.cc (cp_parser_omp_context_selector): Remove metadirective_p
argument and conditionalization.
(cp_parser_omp_context_selector_specification): Remove metadirective_p
argument and adjust call not to pass it on.
(cp_finish_omp_declare_variant): Adjust arguments on call to above.
(cp_parser_omp_metadirective): Likewise.
* pt.cc (tsubst_omp_context_selector): Adjust error behavior.
(tsubst_stmt): Adjust call to omp_context_selector_matches.
* semantics.cc (finish_id_expression_1): Do not diagnose error
for use of parameter in declare variant selector here.
gcc/fortran/ChangeLog
* trans-openmp.cc (gfc_trans_omp_declare_variant): Adjust arguments
to omp_context_selector_matches.
(gfc_trans_omp_metadirective): Likewise.
gcc/Changelog
* gimple-streamer-in.cc (input_gimple_stmt): Restore
gomp_metadirective context.
* gimple-streamer-out.cc (output_gimple_stmt): Save
gomp_metadirective context.
* gimple.cc (gimple_build_omp_metadirective): Initialize
gomp_metadirective context.
* gimple.def (GIMPLE_OMP_METADIRECTIVE): Update comments.
* gimple.h (gomp_metadirective): Add context field and update comments.
(gimple_omp_metadirective_context): New.
(gimple_omp_metadirective_set_context): New.
* gimplify.cc (omp_resolved_variant_calls): New.
(gimplify_variant_call_expr): New.
(gimplify_call_expr): Adjust parameters. Call
gimplify_variant_call_expr to handle declare variant substitution.
(omp_construct_selector_matches): Delete.
(omp_get_construct_context): New.
(gimplify_omp_metadirective): Use filtered list of candidates
to construct the gomp_metadirective structure. Save the construct
context.
(gimplify_expr): Adjust arguments to gimplify_call_expr.
(gimplify_function_tree): Initialize and free
omp_resolved_variant_calls around the call to gimplify_body.
* gimplify.h (omp_construct_selector_matches): Delete.
(omp_get_construct_context): New.
* omp-general.cc (omp_construct_traits_to_codes): Delete.
(omp_maybe_offloaded): Add construct_context parameter and comments.
Use construct_context to check for nesting in a target directive
instead of calling omp_construct_selector_matches.
(expr_uses_parm_decl): New.
(omp_check_context_selector): Don't reject target_device selector
for "declare variant". Add missing check for invalid simd properties.
Reject dynamic selectors that reference parameter variables in
"declare variant" with a "sorry".
(omp_construct_traits_match): New.
(omp_context_selector_matches): Adjust parameters to pass in
construct_context. Rewrite construct selector matching to
use omp_construct_traits_match. Replace unnecessary conditionals
checking that traits match the right selector set with asserts.
(omp_construct_simd_compare): Add match_p parameter, use it to
enable additional matching rules for simdlen and align clauses.
(omp_context_selector_set_compare): Make static. Adjust
call to omp_construct_simd_compare).
(omp_dynamic_cond): Clean up code missed in a previously-committed
patch.
(omp_context_compare_score): Adjust parameters, rewrite and add
comments.
(omp_complete_construct_context): New.
(omp_resolve_late_declare_variant): Delete.
(omp_declare_variant_remove_hook): Delete.
(omp_resolve_declare_variant): Delete.
(omp_get_dynamic_candidates): Make non-static and adjust parameters.
Call omp_complete_construct_context and pass the result to
omp_context_selector_matches. Add more comments, debug output,
and logic to allow resolution in some cases where candidates
cannot be scored accurately.
(omp_declare_variant_candidates): New.
(omp_metadirective_candidates): New, split from...
(omp_early_resolve_metadirective): ...here.
(omp_late_resolve_metadirective): Explicitly initialize
dynamic_selector field. Adjust call to omp_get_dynamic_candidates.
* omp-general.h (struct omp_variant): Add comments explaining
how this is used for "declare variant".
(omp_construct_traits_to_codes): Delete.
(omp_context_selector_matches): Adjust parameters.
(omp_context_selector_set_compare): Delete.
(omp_resolve_declare_variant): Delete.
(omp_declare_variant_candidates): Declare.
(omp_metadirective_candidates): Declare.
(omp_get_dynamic_candidates): Declare.
* omp-offload.cc (execute_omp_device_lower): Remove logic
for the old way of handling declare variant.
* tree-inline.cc (remap_gimple_stmt): Copy metadirective context.
gcc/testsuite/ChangeLog
* c-c++-common/gomp/declare-variant-12.c: Adjust expected behavior.
* c-c++-common/gomp/declare-variant-13.c: Likewise.
* c-c++-common/gomp/declare-variant-2.c: Likewise.
* c-c++-common/gomp/declare-variant-arg-exprs.c: New.
* c-c++-common/gomp/declare-dynamic-1.c: New.
* c-c++-common/gomp/declare-dynamic-2.c: New.
* c-c++-common/gomp/metadirective-3.c: Adjust expected behavior.
* g++.dg/gomp/attrs-metadirective-3.C: Likewise.
* g++.dg/gomp/declare-variant-class-1.C: New.
* g++.dg/gomp/declare-variant-class-2.C: New.
* gfortran.dg/gomp/declare-variant-12.f90: Adjust expected behavior.
* gfortran.dg/gomp/declare-variant-13.f90: Likewise.
* gfortran.dg/gomp/metadirective-1.f90: Likewise.
* gfortran.dg/gomp/metadirective-3.f90: Likewise.
---
gcc/c/c-parser.cc | 28 +-
gcc/cp/cp-tree.h | 2 +
gcc/cp/decl.cc | 2 +-
gcc/cp/parser.cc | 54 +-
gcc/cp/pt.cc | 5 +-
gcc/cp/semantics.cc | 3 +-
gcc/fortran/trans-openmp.cc | 5 +-
gcc/gimple-streamer-in.cc | 3 +
gcc/gimple-streamer-out.cc | 8 +-
gcc/gimple.cc | 1 +
gcc/gimple.def | 3 +-
gcc/gimple.h | 26 +-
gcc/gimplify.cc | 402 ++--
gcc/gimplify.h | 2 +-
gcc/omp-general.cc | 1671 ++++++++---------
gcc/omp-general.h | 26 +-
gcc/omp-offload.cc | 12 +-
.../c-c++-common/gomp/declare-variant-12.c | 14 +-
.../c-c++-common/gomp/declare-variant-13.c | 6 +-
.../c-c++-common/gomp/declare-variant-2.c | 4 +-
.../gomp/declare-variant-arg-exprs.c | 29 +
.../gomp/declare-variant-dynamic-1.c | 26 +
.../gomp/declare-variant-dynamic-2.c | 30 +
.../c-c++-common/gomp/metadirective-3.c | 18 +-
.../g++.dg/gomp/attrs-metadirective-3.C | 14 +-
.../g++.dg/gomp/declare-variant-class-1.C | 32 +
.../g++.dg/gomp/declare-variant-class-2.C | 37 +
.../gfortran.dg/gomp/declare-variant-12.f90 | 14 +-
.../gfortran.dg/gomp/declare-variant-13.f90 | 28 +-
.../gfortran.dg/gomp/metadirective-1.f90 | 22 +-
.../gfortran.dg/gomp/metadirective-3.f90 | 18 +-
gcc/tree-inline.cc | 2 +
32 files changed, 1405 insertions(+), 1142 deletions(-)
create mode 100644 gcc/testsuite/c-c++-common/gomp/declare-variant-arg-exprs.c
create mode 100644 gcc/testsuite/c-c++-common/gomp/declare-variant-dynamic-1.c
create mode 100644 gcc/testsuite/c-c++-common/gomp/declare-variant-dynamic-2.c
create mode 100644 gcc/testsuite/g++.dg/gomp/declare-variant-class-1.C
create mode 100644 gcc/testsuite/g++.dg/gomp/declare-variant-class-2.C
diff --git a/gcc/c/c-parser.cc b/gcc/c/c-parser.cc
index e6546bcb32b..562819faea3 100644
--- a/gcc/c/c-parser.cc
+++ b/gcc/c/c-parser.cc
@@ -24635,7 +24635,7 @@ c_parser_omp_declare_simd (c_parser *parser, enum pragma_context context)
static tree
c_parser_omp_context_selector (c_parser *parser, enum omp_tss_code set,
- tree parms, bool metadirective_p)
+ tree parms)
{
tree ret = NULL_TREE;
do
@@ -24782,16 +24782,7 @@ c_parser_omp_context_selector (c_parser *parser, enum omp_tss_code set,
{
mark_exp_read (t);
t = c_fully_fold (t, false, NULL);
- /* FIXME: I believe it is an unimplemented feature rather
- than a user error to have non-constant expressions
- inside "declare variant". */
- if (!metadirective_p
- && (!INTEGRAL_TYPE_P (TREE_TYPE (t))
- || !tree_fits_shwi_p (t)))
- error_at (token->location,
- "property must be constant integer expression");
- else if (metadirective_p
- && !INTEGRAL_TYPE_P (TREE_TYPE (t)))
+ if (!INTEGRAL_TYPE_P (TREE_TYPE (t)))
error_at (token->location,
"property must be integer expression");
else
@@ -24874,8 +24865,7 @@ c_parser_omp_context_selector (c_parser *parser, enum omp_tss_code set,
user */
static tree
-c_parser_omp_context_selector_specification (c_parser *parser, tree parms,
- bool metadirective_p)
+c_parser_omp_context_selector_specification (c_parser *parser, tree parms)
{
tree ret = NULL_TREE;
do
@@ -24900,8 +24890,7 @@ c_parser_omp_context_selector_specification (c_parser *parser, tree parms,
if (!braces.require_open (parser))
return error_mark_node;
- tree selectors = c_parser_omp_context_selector (parser, set, parms,
- metadirective_p);
+ tree selectors = c_parser_omp_context_selector (parser, set, parms);
if (selectors == error_mark_node)
ret = error_mark_node;
else if (ret != error_mark_node)
@@ -24977,8 +24966,7 @@ c_finish_omp_declare_variant (c_parser *parser, tree fndecl, tree parms)
if (parms == NULL_TREE)
parms = error_mark_node;
- tree ctx = c_parser_omp_context_selector_specification (parser,
- parms, false);
+ tree ctx = c_parser_omp_context_selector_specification (parser, parms);
if (ctx == error_mark_node)
goto fail;
ctx = omp_check_context_selector (match_loc, ctx, false);
@@ -25014,7 +25002,7 @@ c_finish_omp_declare_variant (c_parser *parser, tree fndecl, tree parms)
tree construct
= omp_get_context_selector_list (ctx, OMP_TRAIT_SET_CONSTRUCT);
omp_mark_declare_variant (match_loc, variant, construct);
- if (omp_context_selector_matches (ctx, false, true))
+ if (omp_context_selector_matches (ctx, NULL_TREE, false))
{
tree attr
= tree_cons (get_identifier ("omp declare variant base"),
@@ -26688,7 +26676,7 @@ c_parser_omp_metadirective (c_parser *parser, bool *if_p)
if (!default_p)
{
ctx = c_parser_omp_context_selector_specification (parser,
- NULL_TREE, true);
+ NULL_TREE);
if (ctx == error_mark_node)
goto error;
ctx = omp_check_context_selector (match_loc, ctx, true);
@@ -26697,7 +26685,7 @@ c_parser_omp_metadirective (c_parser *parser, bool *if_p)
/* Remove the selector from further consideration if can be
evaluated as a non-match at this point. */
- skip = omp_context_selector_matches (ctx, true, true) == 0;
+ skip = (omp_context_selector_matches (ctx, NULL_TREE, false) == 0);
if (c_parser_next_token_is_not (parser, CPP_COLON))
{
diff --git a/gcc/cp/cp-tree.h b/gcc/cp/cp-tree.h
index bafdf63dc63..3f18f33ab1e 100644
--- a/gcc/cp/cp-tree.h
+++ b/gcc/cp/cp-tree.h
@@ -1891,6 +1891,7 @@ struct GTY(()) saved_scope {
int suppress_location_wrappers;
BOOL_BITFIELD x_processing_explicit_instantiation : 1;
BOOL_BITFIELD need_pop_function_context : 1;
+ BOOL_BITFIELD x_processing_omp_trait_property_expr : 1;
/* Nonzero if we are parsing the discarded statement of a constexpr
if-statement. */
@@ -1962,6 +1963,7 @@ extern GTY(()) struct saved_scope *scope_chain;
#define processing_template_decl scope_chain->x_processing_template_decl
#define processing_specialization scope_chain->x_processing_specialization
#define processing_explicit_instantiation scope_chain->x_processing_explicit_instantiation
+#define processing_omp_trait_property_expr scope_chain->x_processing_omp_trait_property_expr
/* Nonzero if we are parsing the conditional expression of a contract
condition. These expressions appear outside the paramter list (like a
diff --git a/gcc/cp/decl.cc b/gcc/cp/decl.cc
index 2f989b9b869..5aedaebdf28 100644
--- a/gcc/cp/decl.cc
+++ b/gcc/cp/decl.cc
@@ -8328,7 +8328,7 @@ omp_declare_variant_finalize_one (tree decl, tree attr)
tree construct
= omp_get_context_selector_list (ctx, OMP_TRAIT_SET_CONSTRUCT);
omp_mark_declare_variant (match_loc, variant, construct);
- if (!omp_context_selector_matches (ctx, false, true))
+ if (!omp_context_selector_matches (ctx, NULL_TREE, false))
return true;
TREE_PURPOSE (TREE_VALUE (attr)) = variant;
}
diff --git a/gcc/cp/parser.cc b/gcc/cp/parser.cc
index 4bb9b086095..58eef2b3d9f 100644
--- a/gcc/cp/parser.cc
+++ b/gcc/cp/parser.cc
@@ -47939,7 +47939,7 @@ cp_parser_omp_declare_simd (cp_parser *parser, cp_token *pragma_tok,
static tree
cp_parser_omp_context_selector (cp_parser *parser, enum omp_tss_code set,
- bool has_parms_p, bool metadirective_p)
+ bool has_parms_p)
{
tree ret = NULL_TREE;
do
@@ -48100,31 +48100,24 @@ cp_parser_omp_context_selector (cp_parser *parser, enum omp_tss_code set,
break;
case OMP_TRAIT_PROPERTY_DEV_NUM_EXPR:
case OMP_TRAIT_PROPERTY_BOOL_EXPR:
- /* FIXME: I believe it is an unimplemented feature rather
- than a user error to have non-constant expressions
- inside "declare variant". */
- t = metadirective_p
- ? cp_parser_expression (parser)
- : cp_parser_constant_expression (parser);
- if (t != error_mark_node)
+ processing_omp_trait_property_expr = true;
+ /* This actually parses a not-necessarily-constant
+ conditional-expression. */
+ t = cp_parser_constant_expression (parser, true, NULL, false);
+ processing_omp_trait_property_expr = false;
+ if (t == error_mark_node)
+ return error_mark_node;
+ if (!type_dependent_expression_p (t))
{
t = fold_non_dependent_expr (t);
- if (!metadirective_p
- && !value_dependent_expression_p (t)
- && (!INTEGRAL_TYPE_P (TREE_TYPE (t))
- || !tree_fits_shwi_p (t)))
- error_at (token->location, "property must be "
- "constant integer expression");
- if (metadirective_p
- && !INTEGRAL_TYPE_P (TREE_TYPE (t)))
- error_at (token->location,
- "property must be integer expression");
- else
- properties = make_trait_property (NULL_TREE, t,
- properties);
+ if (!INTEGRAL_TYPE_P (TREE_TYPE (t)))
+ {
+ error_at (token->location,
+ "property must be integer expression");
+ return error_mark_node;
+ }
}
- else
- return error_mark_node;
+ properties = make_trait_property (NULL_TREE, t, properties);
break;
case OMP_TRAIT_PROPERTY_CLAUSE_LIST:
if (sel == OMP_TRAIT_CONSTRUCT_SIMD)
@@ -48197,8 +48190,7 @@ cp_parser_omp_context_selector (cp_parser *parser, enum omp_tss_code set,
static tree
cp_parser_omp_context_selector_specification (cp_parser *parser,
- bool has_parms_p,
- bool metadirective_p)
+ bool has_parms_p)
{
tree ret = NULL_TREE;
do
@@ -48225,8 +48217,7 @@ cp_parser_omp_context_selector_specification (cp_parser *parser,
return error_mark_node;
tree selectors
- = cp_parser_omp_context_selector (parser, set, has_parms_p,
- metadirective_p);
+ = cp_parser_omp_context_selector (parser, set, has_parms_p);
if (selectors == error_mark_node)
{
cp_parser_skip_to_closing_brace (parser);
@@ -48536,8 +48527,7 @@ cp_finish_omp_declare_variant (cp_parser *parser, cp_token *pragma_tok,
if (!parens.require_open (parser))
goto fail;
- tree ctx = cp_parser_omp_context_selector_specification (parser, true,
- false);
+ tree ctx = cp_parser_omp_context_selector_specification (parser, true);
if (ctx == error_mark_node)
goto fail;
ctx = omp_check_context_selector (match_loc, ctx, false);
@@ -49326,8 +49316,7 @@ cp_parser_omp_metadirective (cp_parser *parser, cp_token *pragma_tok,
if (!default_p)
{
- ctx = cp_parser_omp_context_selector_specification (parser, false,
- true);
+ ctx = cp_parser_omp_context_selector_specification (parser, false);
if (ctx == error_mark_node)
goto fail;
ctx = omp_check_context_selector (match_loc, ctx, true);
@@ -49339,8 +49328,7 @@ cp_parser_omp_metadirective (cp_parser *parser, cp_token *pragma_tok,
/* FIXME: we could still do this if the context selector
doesn't have any dependent subexpressions. */
skip = (!processing_template_decl
- && omp_context_selector_matches (ctx, true, true) == 0);
-
+ && !omp_context_selector_matches (ctx, NULL_TREE, false));
if (cp_lexer_next_token_is_not (parser->lexer, CPP_COLON))
{
cp_parser_require (parser, CPP_COLON, RT_COLON);
diff --git a/gcc/cp/pt.cc b/gcc/cp/pt.cc
index 409c4df68bc..4acc39e344d 100644
--- a/gcc/cp/pt.cc
+++ b/gcc/cp/pt.cc
@@ -17906,7 +17906,8 @@ tsubst_omp_context_selector (tree ctx, tree args, tsubst_flags_t complain,
if (!INTEGRAL_TYPE_P (TREE_TYPE (t)))
error_at (cp_expr_loc_or_input_loc (t),
"property must be integer expression");
- properties = make_trait_property (NULL_TREE, t, NULL_TREE);
+ else
+ properties = make_trait_property (NULL_TREE, t, NULL_TREE);
break;
case OMP_TRAIT_PROPERTY_CLAUSE_LIST:
if (OMP_TS_CODE (sel) == OMP_TRAIT_CONSTRUCT_SIMD)
@@ -19496,7 +19497,7 @@ tsubst_stmt (tree t, tree args, tsubst_flags_t complain, tree in_decl)
in_decl);
/* Remove the selector from further consideration if it can be
evaluated as a non-match at this point. */
- if (omp_context_selector_matches (ctx, true, true) == 0)
+ if (omp_context_selector_matches (ctx, NULL_TREE, false) == 0)
continue;
}
s = push_stmt_list ();
diff --git a/gcc/cp/semantics.cc b/gcc/cp/semantics.cc
index 02c7c1bf5a4..37d803d9181 100644
--- a/gcc/cp/semantics.cc
+++ b/gcc/cp/semantics.cc
@@ -4384,7 +4384,8 @@ finish_id_expression_1 (tree id_expression,
if (TREE_CODE (decl) == PARM_DECL
&& DECL_CONTEXT (decl) == NULL_TREE
&& !cp_unevaluated_operand
- && !processing_contract_condition)
+ && !processing_contract_condition
+ && !processing_omp_trait_property_expr)
{
*error_msg = G_("use of parameter outside function body");
return error_mark_node;
diff --git a/gcc/fortran/trans-openmp.cc b/gcc/fortran/trans-openmp.cc
index 854d3ac14f0..46a8be8e2bb 100644
--- a/gcc/fortran/trans-openmp.cc
+++ b/gcc/fortran/trans-openmp.cc
@@ -8555,7 +8555,8 @@ gfc_trans_omp_declare_variant (gfc_namespace *ns)
omp_mark_declare_variant (gfc_get_location (&odv->where),
gfc_get_symbol_decl (variant_proc_sym),
construct);
- if (omp_context_selector_matches (set_selectors, false, true))
+ if (omp_context_selector_matches (set_selectors,
+ NULL_TREE, false))
{
tree id = get_identifier ("omp declare variant base");
tree variant = gfc_get_symbol_decl (variant_proc_sym);
@@ -8627,7 +8628,7 @@ gfc_trans_omp_metadirective (gfc_code *code)
return error_mark_node;
/* If the selector doesn't match, drop the whole variant. */
- if (!omp_context_selector_matches (ctx, true, true))
+ if (!omp_context_selector_matches (ctx, NULL_TREE, false))
{
variant = variant->next;
continue;
diff --git a/gcc/gimple-streamer-in.cc b/gcc/gimple-streamer-in.cc
index 1482d34e9a8..e7321189ea0 100644
--- a/gcc/gimple-streamer-in.cc
+++ b/gcc/gimple-streamer-in.cc
@@ -193,6 +193,9 @@ input_gimple_stmt (class lto_input_block *ib, class data_in *data_in,
= dyn_cast <gomp_metadirective*> (stmt))
{
gimple_alloc_omp_metadirective (metadirective_stmt);
+ gimple_omp_metadirective_set_context (metadirective_stmt,
+ stream_read_tree (ib,
+ data_in));
for (i = 0; i < num_ops; i++)
gimple_omp_metadirective_set_label (metadirective_stmt, i,
stream_read_tree (ib,
diff --git a/gcc/gimple-streamer-out.cc b/gcc/gimple-streamer-out.cc
index ccb11fec1da..f2e76051e13 100644
--- a/gcc/gimple-streamer-out.cc
+++ b/gcc/gimple-streamer-out.cc
@@ -171,9 +171,13 @@ output_gimple_stmt (struct output_block *ob, struct function *fn, gimple *stmt)
stream_write_tree (ob, gimple_call_fntype (stmt), true);
}
if (gimple_code (stmt) == GIMPLE_OMP_METADIRECTIVE)
- for (i = 0; i < gimple_num_ops (stmt); i++)
- stream_write_tree (ob, gimple_omp_metadirective_label (stmt, i),
+ {
+ stream_write_tree (ob, gimple_omp_metadirective_context (stmt),
true);
+ for (i = 0; i < gimple_num_ops (stmt); i++)
+ stream_write_tree (ob, gimple_omp_metadirective_label (stmt, i),
+ true);
+ }
break;
diff --git a/gcc/gimple.cc b/gcc/gimple.cc
index 303b1b029ec..ebe4513ca9b 100644
--- a/gcc/gimple.cc
+++ b/gcc/gimple.cc
@@ -1331,6 +1331,7 @@ gimple_build_omp_metadirective (int num_variants)
= as_a <gomp_metadirective *> (gimple_alloc (GIMPLE_OMP_METADIRECTIVE,
num_variants));
gimple_alloc_omp_metadirective (p);
+ gimple_omp_metadirective_set_context (p, NULL);
gimple_omp_metadirective_set_variants (p, NULL);
return p;
diff --git a/gcc/gimple.def b/gcc/gimple.def
index 41e69d56bb4..a1bce89c60f 100644
--- a/gcc/gimple.def
+++ b/gcc/gimple.def
@@ -398,7 +398,8 @@ DEFGSCODE(GIMPLE_OMP_TEAMS, "gimple_omp_teams", GSS_OMP_PARALLEL_LAYOUT)
CLAUSES is an OMP_CLAUSE chain holding the associated clauses. */
DEFGSCODE(GIMPLE_OMP_ORDERED, "gimple_omp_ordered", GSS_OMP_SINGLE_LAYOUT)
-/* GIMPLE_OMP_METADIRECTIVE represents #pragma omp metadirective. */
+/* GIMPLE_OMP_METADIRECTIVE represents both #pragma omp metadirective and
+ a call to a function with "declare variant" variants. */
DEFGSCODE(GIMPLE_OMP_METADIRECTIVE, "gimple_omp_metadirective",
GSS_OMP_METADIRECTIVE)
diff --git a/gcc/gimple.h b/gcc/gimple.h
index b608ccd2ceb..43d4ef2d0ce 100644
--- a/gcc/gimple.h
+++ b/gcc/gimple.h
@@ -856,10 +856,14 @@ struct GTY((tag("GSS_OMP_METADIRECTIVE")))
/* [ WORD 8 ] : a list of bodies associated with the directive variants. */
gomp_variant *variants;
- /* [ WORD 9 ] : label vector. */
+ /* [ WORD 9 ] : the cached OpenMP context for this directive, used for
+ post-gimplification resolution. */
+ tree context;
+
+ /* [ WORD 10 ] : label vector. */
tree * GTY((length ("%h.num_ops"))) labels;
- /* [ WORD 10 ] : operand vector. Used to hold the selectors for the
+ /* [ WORD 11 ] : operand vector. Used to hold the selectors for the
directive variants. */
tree GTY((length ("%h.num_ops"))) op[1];
};
@@ -6692,6 +6696,24 @@ gimple_assume_body (const gimple *gs)
}
+static inline tree
+gimple_omp_metadirective_context (const gimple *g)
+{
+ const gomp_metadirective *omp_metadirective
+ = as_a <const gomp_metadirective *> (g);
+ return omp_metadirective->context;
+}
+
+
+static inline void
+gimple_omp_metadirective_set_context (gimple *g, tree context)
+{
+ gomp_metadirective *omp_metadirective
+ = as_a <gomp_metadirective *> (g);
+ omp_metadirective->context = context;
+}
+
+
static inline tree
gimple_omp_metadirective_label (const gimple *g, unsigned i)
{
diff --git a/gcc/gimplify.cc b/gcc/gimplify.cc
index ccbb5afbec7..19e6d209265 100644
--- a/gcc/gimplify.cc
+++ b/gcc/gimplify.cc
@@ -96,6 +96,11 @@ reset_cond_uid ()
/* Hash set of poisoned variables in a bind expr. */
static hash_set<tree> *asan_poisoned_variables = NULL;
+/* Hash set of already-resolved calls to OpenMP "declare variant"
+ functions. A call can resolve to the original function and
+ we don't want to repeat the resolution multiple times. */
+static hash_set<tree> *omp_resolved_variant_calls = NULL;
+
enum gimplify_omp_var_data
{
GOVD_SEEN = 0x000001,
@@ -3799,12 +3804,185 @@ maybe_fold_stmt (gimple_stmt_iterator *gsi)
return fold_stmt (gsi);
}
+/* Helper function for gimplify_call_expr: handle "declare variant"
+ resolution and expansion. Arguments are as for gimplify_call_expr.
+ If *EXPR_P is unchanged, the return value should be ignored and the
+ normal gimplify_call_expr handling should be applied. Otherwise GS_OK
+ is returned if the new *EXPR_P is something that needs to be further
+ gimplified, or GS_ALL_DONE if *EXPR_P has been translated into a
+ GIMPLE_OMP_METADIRECTIVE. */
+
+static enum gimplify_status
+gimplify_variant_call_expr (tree *expr_p, gimple_seq *pre_p,
+ fallback_t fallback)
+{
+ /* If we've already processed this call, stop now. This can happen
+ if the variant call resolves to the original function, or to
+ a dynamic conditional that includes the default call to the original
+ function. */
+ gcc_assert (omp_resolved_variant_calls != NULL);
+ if (omp_resolved_variant_calls->contains (*expr_p))
+ return GS_OK;
+
+ tree fndecl = get_callee_fndecl (*expr_p);
+ tree fnptrtype = TREE_TYPE (CALL_EXPR_FN (*expr_p));
+ location_t loc = EXPR_LOCATION (*expr_p);
+ tree construct_context = omp_get_construct_context ();
+ vec<struct omp_variant> all_candidates
+ = omp_declare_variant_candidates (fndecl, construct_context);
+ gcc_assert (!all_candidates.is_empty ());
+ vec<struct omp_variant> candidates
+ = omp_get_dynamic_candidates (all_candidates, construct_context);
+
+ /* If the variant call could be resolved now, build a nest of COND_EXPRs
+ if there are dynamic candidates, and/or a new CALL_EXPR for each
+ candidate call. */
+ if (!candidates.is_empty ())
+ {
+ int n = candidates.length ();
+ tree tail = NULL_TREE;
+
+ for (int i = n - 1; i >= 0; i--)
+ {
+ if (tail)
+ gcc_assert (candidates[i].dynamic_selector);
+ else
+ gcc_assert (!candidates[i].dynamic_selector);
+ if (candidates[i].alternative == fndecl)
+ {
+ /* We should only get the original function back as the
+ default. */
+ gcc_assert (!tail);
+ omp_resolved_variant_calls->add (*expr_p);
+ tail = *expr_p;
+ }
+ else
+ {
+ /* Special case: if there are no adjust_args/append_args for
+ the final static selector, we can re-use the old CALL_EXPR
+ and just replace the function. */
+ /* FIXME: also test for adjust_args/append_args. */
+ tree thiscall = tail ? unshare_expr (*expr_p) : *expr_p;
+ CALL_EXPR_FN (thiscall) = build1 (ADDR_EXPR, fnptrtype,
+ candidates[i].alternative);
+ /* FIXME: Handle adjust_args/append_args here too. */
+ if (!tail)
+ tail = thiscall;
+ else
+ tail = build3 (COND_EXPR, TREE_TYPE (*expr_p),
+ candidates[i].dynamic_selector,
+ thiscall, tail);
+ }
+ }
+ *expr_p = tail;
+ return GS_OK;
+ }
+
+ /* If we couldn't resolve the variant call now, replace the call with a
+ GIMPLE_OMP_METADIRECTIVE that has gimplified calls in each of its
+ alternatives. Yes, this is badly named, but the same logic is used
+ to replace both things in the late resolution from the ompdevlow pass. */
+ else
+ {
+ /* If we need a usable return value, we need a temporary
+ and an assignment in each alternative. This logic was borrowed
+ from gimplify_cond_expr. */
+ tree type = TREE_TYPE (*expr_p);
+ bool want_value = (fallback != fb_none && !VOID_TYPE_P (type));
+ bool pointerize = false;
+ tree tmp = NULL_TREE, result = NULL_TREE;
+
+ if (want_value)
+ {
+ /* If either an rvalue is ok or we do not require an lvalue,
+ create the temporary. But we cannot do that if the type is
+ addressable. */
+ if (((fallback & fb_rvalue) || !(fallback & fb_lvalue))
+ && !TREE_ADDRESSABLE (type))
+ {
+ tmp = create_tmp_var (type, "iftmp");
+ result = tmp;
+ }
+
+ /* Otherwise, only create and copy references to the values. */
+ else
+ {
+ pointerize = true;
+ type = build_pointer_type (type);
+ tmp = create_tmp_var (type, "iftmp");
+ result = build_simple_mem_ref_loc (loc, tmp);
+ }
+ }
+
+ /* The following code was more or less stolen from
+ gimplify_omp_metadirective. FIXME: do we also need to copy
+ the "omp metadirective construct target" part too? */
+ gomp_variant *first_variant = NULL;
+ gomp_variant *prev_variant = NULL;
+ gomp_metadirective *stmt
+ = gimple_build_omp_metadirective (all_candidates.length ());
+ tree end_label = create_artificial_label (UNKNOWN_LOCATION);
+
+ for (unsigned int i = 0; i < all_candidates.length (); i++)
+ {
+ tree decl = all_candidates[i].alternative;
+ gimple_set_op (stmt, i, all_candidates[i].selector);
+ gomp_variant *omp_variant
+ = gimple_build_omp_variant (NULL);
+ gimple_seq *directive_p = gimple_omp_body_ptr (omp_variant);
+ tree thiscall;
+
+ /* We need to turn the decl from the candidate into a function
+ call and possible assignment, gimplify it, and stuff that in
+ the directive seq of the gomp_variant. */
+ if (decl == fndecl)
+ {
+ thiscall = *expr_p;
+ omp_resolved_variant_calls->add (*expr_p);
+ }
+ else
+ {
+ /* FIXME: handle adjust_args/append_args here too. */
+ thiscall = unshare_expr (*expr_p);
+ CALL_EXPR_FN (thiscall) = build1 (ADDR_EXPR, fnptrtype, decl);
+ }
+ if (pointerize)
+ thiscall = build_fold_addr_expr_loc (loc, thiscall);
+ if (want_value)
+ thiscall = build2 (INIT_EXPR, type, tmp, thiscall);
+
+ gimplify_stmt (&thiscall, directive_p);
+ gimplify_seq_add_stmt (directive_p, gimple_build_goto (end_label));
+
+ if (!first_variant)
+ first_variant = omp_variant;
+ if (prev_variant)
+ {
+ prev_variant->next = omp_variant;
+ omp_variant->prev = prev_variant;
+ }
+ prev_variant = omp_variant;
+ }
+
+ gimple_omp_metadirective_set_context (stmt, construct_context);
+ gimple_omp_metadirective_set_variants (stmt, first_variant);
+
+ gimplify_seq_add_stmt (pre_p, stmt);
+ gimplify_seq_add_stmt (pre_p, gimple_build_label (end_label));
+ cgraph_node::get (cfun->decl)->has_metadirectives = 1;
+
+ *expr_p = result;
+ return GS_ALL_DONE;
+ }
+}
+
/* Gimplify the CALL_EXPR node *EXPR_P into the GIMPLE sequence PRE_P.
WANT_VALUE is true if the result of the call is desired. */
static enum gimplify_status
-gimplify_call_expr (tree *expr_p, gimple_seq *pre_p, bool want_value)
+gimplify_call_expr (tree *expr_p, gimple_seq *pre_p, fallback_t fallback)
{
+ bool want_value = (fallback != fb_none);
tree fndecl, parms, p, fnptrtype;
enum gimplify_status ret;
int i, nargs;
@@ -3970,14 +4148,23 @@ gimplify_call_expr (tree *expr_p, gimple_seq *pre_p, bool want_value)
/* Remember the original function pointer type. */
fnptrtype = TREE_TYPE (CALL_EXPR_FN (*expr_p));
+ /* Handle "declare variant" substitution. */
if (flag_openmp
&& fndecl
&& cfun
- && (cfun->curr_properties & PROP_gimple_any) == 0)
+ && (cfun->curr_properties & PROP_gimple_any) == 0
+ && lookup_attribute ("omp declare variant base",
+ DECL_ATTRIBUTES (fndecl)))
{
- tree variant = omp_resolve_declare_variant (fndecl);
- if (variant != fndecl)
- CALL_EXPR_FN (*expr_p) = build1 (ADDR_EXPR, fnptrtype, variant);
+ tree orig = *expr_p;
+ enum gimplify_status ret
+ = gimplify_variant_call_expr (expr_p, pre_p, fallback);
+ /* This may resolve to the same call, or the call expr with just
+ the function replaced, in which case we should just continue to
+ gimplify it normally. Otherwise, if we get something else back,
+ stop here. */
+ if (*expr_p != orig)
+ return ret;
}
/* There is a sequence point before the call, so any side effects in
@@ -14634,57 +14821,59 @@ gimplify_adjust_omp_clauses (gimple_seq *pre_p, gimple_seq body, tree *list_p,
delete_omp_context (ctx);
}
-/* Return 0 if CONSTRUCTS selectors don't match the OpenMP context,
- -1 if unknown yet (simd is involved, won't be known until vectorization)
- and 1 if they do. If SCORES is non-NULL, it should point to an array
- of at least 2*NCONSTRUCTS+2 ints, and will be filled with the positions
- of the CONSTRUCTS (position -1 if it will never match) followed by
- number of constructs in the OpenMP context construct trait. If the
- score depends on whether it will be in a declare simd clone or not,
- the function returns 2 and there will be two sets of the scores, the first
- one for the case that it is not in a declare simd clone, the other
- that it is in a declare simd clone. */
+/* Collect a list of traits for enclosing constructs in the current
+ OpenMP context. The list is in the same format as the trait selector
+ list of construct trait sets built by the front ends.
-int
-omp_construct_selector_matches (enum tree_code *constructs, int nconstructs,
- int *scores)
+ Per the OpenMP specification, the construct trait set includes constructs
+ up to an enclosing "target" construct. If there is no "target" construct,
+ then additional things may be added to the construct trait set (simd for
+ simd clones, additional constructs associated with "declare variant",
+ the target trait for "declare target"); those are not handled here.
+ In particular simd clones are not known during gimplification so
+ matching/scoring of context selectors that might involve them needs
+ to be deferred to the omp_device_lower pass. */
+
+tree
+omp_get_construct_context (void)
{
- int matched = 0, cnt = 0;
- bool simd_seen = false;
- bool target_seen = false;
- int declare_simd_cnt = -1;
- auto_vec<enum tree_code, 16> codes;
+ tree result = NULL_TREE;
for (struct gimplify_omp_ctx *ctx = gimplify_omp_ctxp; ctx;)
{
- if (((ctx->region_type & ORT_PARALLEL) && ctx->code == OMP_PARALLEL)
- || ((ctx->region_type & (ORT_TARGET | ORT_IMPLICIT_TARGET | ORT_ACC))
- == ORT_TARGET && ctx->code == OMP_TARGET)
- || ((ctx->region_type & ORT_TEAMS) && ctx->code == OMP_TEAMS)
- || (ctx->region_type == ORT_WORKSHARE && ctx->code == OMP_FOR)
- || (ctx->region_type == ORT_SIMD
- && ctx->code == OMP_SIMD
- && !omp_find_clause (ctx->clauses, OMP_CLAUSE_BIND)))
+ if (((ctx->region_type & (ORT_TARGET | ORT_IMPLICIT_TARGET | ORT_ACC))
+ == ORT_TARGET)
+ && ctx->code == OMP_TARGET)
{
- ++cnt;
- if (scores)
- codes.safe_push (ctx->code);
- else if (matched < nconstructs && ctx->code == constructs[matched])
- {
- if (ctx->code == OMP_SIMD)
- {
- if (matched)
- return 0;
- simd_seen = true;
- }
- ++matched;
- }
- if (ctx->code == OMP_TARGET)
- {
- if (scores == NULL)
- return matched < nconstructs ? 0 : simd_seen ? -1 : 1;
- target_seen = true;
- break;
- }
+ result = make_trait_selector (OMP_TRAIT_CONSTRUCT_TARGET,
+ NULL_TREE, NULL_TREE, result);
+ /* We're not interested in any outer constructs. */
+ break;
+ }
+ else if ((ctx->region_type & ORT_PARALLEL) && ctx->code == OMP_PARALLEL)
+ result = make_trait_selector (OMP_TRAIT_CONSTRUCT_PARALLEL,
+ NULL_TREE, NULL_TREE, result);
+ else if ((ctx->region_type & ORT_TEAMS) && ctx->code == OMP_TEAMS)
+ result = make_trait_selector (OMP_TRAIT_CONSTRUCT_TEAMS,
+ NULL_TREE, NULL_TREE, result);
+ else if (ctx->region_type == ORT_WORKSHARE && ctx->code == OMP_FOR)
+ result = make_trait_selector (OMP_TRAIT_CONSTRUCT_FOR,
+ NULL_TREE, NULL_TREE, result);
+ else if (ctx->region_type == ORT_SIMD
+ && ctx->code == OMP_SIMD
+ && !omp_find_clause (ctx->clauses, OMP_CLAUSE_BIND))
+ {
+ tree props = NULL_TREE;
+ tree *last = &props;
+ for (tree c = ctx->clauses; c; c = OMP_CLAUSE_CHAIN (c))
+ if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_SIMDLEN
+ || OMP_CLAUSE_CODE (c) == OMP_CLAUSE_INBRANCH
+ || OMP_CLAUSE_CODE (c) == OMP_CLAUSE_NOTINBRANCH)
+ {
+ *last = unshare_expr (c);
+ last = &(OMP_CLAUSE_CHAIN (c));
+ }
+ result = make_trait_selector (OMP_TRAIT_CONSTRUCT_SIMD,
+ NULL_TREE, props, result);
}
else if (ctx->region_type == ORT_WORKSHARE
&& ctx->code == OMP_LOOP
@@ -14696,89 +14885,8 @@ omp_construct_selector_matches (enum tree_code *constructs, int nconstructs,
ctx = ctx->outer_context->outer_context;
ctx = ctx->outer_context;
}
- if (!target_seen
- && lookup_attribute ("omp declare simd",
- DECL_ATTRIBUTES (current_function_decl)))
- {
- /* Declare simd is a maybe case, it is supposed to be added only to the
- omp-simd-clone.cc added clones and not to the base function. */
- declare_simd_cnt = cnt++;
- if (scores)
- codes.safe_push (OMP_SIMD);
- else if (cnt == 0
- && constructs[0] == OMP_SIMD)
- {
- gcc_assert (matched == 0);
- simd_seen = true;
- if (++matched == nconstructs)
- return -1;
- }
- }
- if (tree attr = lookup_attribute ("omp declare variant variant",
- DECL_ATTRIBUTES (current_function_decl)))
- {
- tree selectors = TREE_VALUE (attr);
- int variant_nconstructs = list_length (selectors);
- enum tree_code *variant_constructs = NULL;
- if (!target_seen && variant_nconstructs)
- {
- variant_constructs
- = (enum tree_code *) alloca (variant_nconstructs
- * sizeof (enum tree_code));
- omp_construct_traits_to_codes (selectors, variant_nconstructs,
- variant_constructs);
- }
- for (int i = 0; i < variant_nconstructs; i++)
- {
- ++cnt;
- if (scores)
- codes.safe_push (variant_constructs[i]);
- else if (matched < nconstructs
- && variant_constructs[i] == constructs[matched])
- {
- if (variant_constructs[i] == OMP_SIMD)
- {
- if (matched)
- return 0;
- simd_seen = true;
- }
- ++matched;
- }
- }
- }
- if (!target_seen
- && lookup_attribute ("omp declare target block",
- DECL_ATTRIBUTES (current_function_decl)))
- {
- if (scores)
- codes.safe_push (OMP_TARGET);
- else if (matched < nconstructs && constructs[matched] == OMP_TARGET)
- ++matched;
- }
- if (scores)
- {
- for (int pass = 0; pass < (declare_simd_cnt == -1 ? 1 : 2); pass++)
- {
- int j = codes.length () - 1;
- for (int i = nconstructs - 1; i >= 0; i--)
- {
- while (j >= 0
- && (pass != 0 || declare_simd_cnt != j)
- && constructs[i] != codes[j])
- --j;
- if (pass == 0 && declare_simd_cnt != -1 && j > declare_simd_cnt)
- *scores++ = j - 1;
- else
- *scores++ = j;
- }
- *scores++ = ((pass == 0 && declare_simd_cnt != -1)
- ? codes.length () - 1 : codes.length ());
- }
- return declare_simd_cnt == -1 ? 1 : 2;
- }
- if (matched == nconstructs)
- return simd_seen ? -1 : 1;
- return 0;
+
+ return result;
}
/* Gimplify OACC_CACHE. */
@@ -17720,8 +17828,11 @@ gimplify_omp_metadirective (tree *expr_p, gimple_seq *pre_p, gimple_seq *,
}
/* Try to resolve the metadirective. */
+ tree construct_context = omp_get_construct_context ();
+ vec<struct omp_variant> all_candidates
+ = omp_metadirective_candidates (*expr_p, construct_context);
vec<struct omp_variant> candidates
- = omp_early_resolve_metadirective (*expr_p);
+ = omp_get_dynamic_candidates (all_candidates, construct_context);
if (!candidates.is_empty ())
return expand_omp_metadirective (candidates, pre_p);
@@ -17733,12 +17844,11 @@ gimplify_omp_metadirective (tree *expr_p, gimple_seq *pre_p, gimple_seq *,
tree body_label = NULL;
tree end_label = create_artificial_label (UNKNOWN_LOCATION);
- for (tree variant = OMP_METADIRECTIVE_VARIANTS (*expr_p); variant != NULL_TREE;
- variant = TREE_CHAIN (variant))
+ for (unsigned int i = 0; i < all_candidates.length (); i++)
{
- tree selector = OMP_METADIRECTIVE_VARIANT_SELECTOR (variant);
- tree directive = OMP_METADIRECTIVE_VARIANT_DIRECTIVE (variant);
- tree body = OMP_METADIRECTIVE_VARIANT_BODY (variant);
+ tree selector = all_candidates[i].selector;
+ tree directive = all_candidates[i].alternative;
+ tree body = all_candidates[i].body;
selectors.safe_push (selector);
gomp_variant *omp_variant
@@ -17770,6 +17880,7 @@ gimplify_omp_metadirective (tree *expr_p, gimple_seq *pre_p, gimple_seq *,
gomp_metadirective *stmt
= gimple_build_omp_metadirective (selectors.length ());
+ gimple_omp_metadirective_set_context (stmt, construct_context);
gimple_omp_metadirective_set_variants (stmt, first_variant);
tree selector;
@@ -18029,7 +18140,7 @@ gimplify_expr (tree *expr_p, gimple_seq *pre_p, gimple_seq *post_p,
break;
case CALL_EXPR:
- ret = gimplify_call_expr (expr_p, pre_p, fallback != fb_none);
+ ret = gimplify_call_expr (expr_p, pre_p, fallback);
/* C99 code may assign to an array in a structure returned
from a function, and this has undefined behavior only on
@@ -19533,7 +19644,16 @@ gimplify_function_tree (tree fndecl)
if (asan_sanitize_use_after_scope ())
asan_poisoned_variables = new hash_set<tree> ();
+ if (flag_openmp)
+ omp_resolved_variant_calls = new hash_set<tree> ();
+
bind = gimplify_body (fndecl, true);
+
+ if (omp_resolved_variant_calls)
+ {
+ delete omp_resolved_variant_calls;
+ omp_resolved_variant_calls = NULL;
+ }
if (asan_poisoned_variables)
{
delete asan_poisoned_variables;
diff --git a/gcc/gimplify.h b/gcc/gimplify.h
index ac3cc8eb552..8e1b75f528b 100644
--- a/gcc/gimplify.h
+++ b/gcc/gimplify.h
@@ -76,7 +76,7 @@ extern void omp_firstprivatize_variable (struct gimplify_omp_ctx *, tree);
extern enum gimplify_status gimplify_expr (tree *, gimple_seq *, gimple_seq *,
bool (*) (tree), fallback_t);
-int omp_construct_selector_matches (enum tree_code *, int, int *);
+extern tree omp_get_construct_context (void);
extern void gimplify_type_sizes (tree, gimple_seq *);
extern void gimplify_one_sizepos (tree *, gimple_seq *);
diff --git a/gcc/omp-general.cc b/gcc/omp-general.cc
index 23072b10d75..13cf43d272f 100644
--- a/gcc/omp-general.cc
+++ b/gcc/omp-general.cc
@@ -1024,31 +1024,6 @@ omp_max_simt_vf (void)
return 0;
}
-/* Store the construct selectors as tree codes from last to first.
- CTX is a list of trait selectors, nconstructs must be equal to its
- length, and the array CONSTRUCTS holds the output. */
-
-void
-omp_construct_traits_to_codes (tree ctx, int nconstructs,
- enum tree_code *constructs)
-{
- int i = nconstructs - 1;
-
- /* Order must match the OMP_TRAIT_CONSTRUCT_* enumerators in
- enum omp_ts_code. */
- static enum tree_code code_map[]
- = { OMP_TARGET, OMP_TEAMS, OMP_PARALLEL, OMP_FOR, OMP_SIMD };
-
- for (tree ts = ctx; ts; ts = TREE_CHAIN (ts), i--)
- {
- enum omp_ts_code sel = OMP_TS_CODE (ts);
- int j = (int)sel - (int)OMP_TRAIT_CONSTRUCT_TARGET;
- gcc_assert (j >= 0 && (unsigned int) j < ARRAY_SIZE (code_map));
- constructs[i] = code_map[j];
- }
- gcc_assert (i == -1);
-}
-
/* Return true if PROP is possibly present in one of the offloading target's
OpenMP contexts. The format of PROPS string is always offloading target's
name terminated by '\0', followed by properties for that offloading
@@ -1096,29 +1071,36 @@ omp_offload_device_kind_arch_isa (const char *props, const char *prop)
region or when unsure, return false otherwise. */
static bool
-omp_maybe_offloaded (void)
+omp_maybe_offloaded (tree construct_context)
{
+ /* No offload targets available? */
if (!ENABLE_OFFLOADING)
return false;
const char *names = getenv ("OFFLOAD_TARGET_NAMES");
if (names == NULL || *names == '\0')
return false;
+ /* Parsing is too early to tell. */
if (symtab->state == PARSING)
/* Maybe. */
return true;
+
+ /* Late resolution of offloaded code happens in the offload compiler,
+ where it's treated as native code instead. So return false here. */
if (cfun && cfun->after_inlining)
return false;
+
+ /* The function is explicitly offloaded? */
if (current_function_decl
&& lookup_attribute ("omp declare target",
DECL_ATTRIBUTES (current_function_decl)))
return true;
- if (cfun && (cfun->curr_properties & PROP_gimple_any) == 0)
- {
- enum tree_code construct = OMP_TARGET;
- if (omp_construct_selector_matches (&construct, 1, NULL))
- return true;
- }
+
+ /* Check for nesting inside a target directive. */
+ for (tree ts = construct_context; ts; ts = TREE_CHAIN (ts))
+ if (OMP_TS_CODE (ts) == OMP_TRAIT_CONSTRUCT_TARGET)
+ return true;
+
return false;
}
@@ -1265,6 +1247,18 @@ omp_context_name_list_prop (tree prop)
}
}
+
+/* Helper function called via walk_tree, to determine if *TP is a
+ PARM_DECL. */
+static tree
+expr_uses_parm_decl (tree *tp, int *walk_subtrees ATTRIBUTE_UNUSED,
+ void *data ATTRIBUTE_UNUSED)
+{
+ if (TREE_CODE (*tp) == PARM_DECL)
+ return *tp;
+ return NULL_TREE;
+}
+
/* Diagnose errors in an OpenMP context selector, return CTX if
it is correct or error_mark_node otherwise. */
@@ -1280,11 +1274,6 @@ omp_check_context_selector (location_t loc, tree ctx, bool metadirective_p)
bool saw_any_prop = false;
bool saw_other_prop = false;
- /* FIXME: not implemented yet. */
- if (!metadirective_p && tss_code == OMP_TRAIT_SET_TARGET_DEVICE)
- sorry_at (loc, "%<target_device%> selector set is not supported "
- "yet for %<declare variant%>");
-
/* Each trait-set-selector-name can only be specified once. */
if (tss_seen[tss_code])
{
@@ -1337,6 +1326,33 @@ omp_check_context_selector (location_t loc, tree ctx, bool metadirective_p)
|| ts_code == OMP_TRAIT_DEVICE_NUM)
saw_other_prop = true;
+ /* This restriction is documented in the spec in the section
+ for the metadirective "when" clause (7.4.1 in the 5.2 spec). */
+ if (metadirective_p && ts_code == OMP_TRAIT_CONSTRUCT_SIMD)
+ {
+ error_at (loc,
+ "properties must not be specified for the %<simd%> "
+ "selector in a %<metadirective%> context-selector");
+ return error_mark_node;
+ }
+
+ /* Reject expressions that reference parameter variables in
+ "declare variant", as this is not yet implemented. FIXME;
+ see PR middle-end/113094. */
+ if (!metadirective_p
+ && (ts_code == OMP_TRAIT_DEVICE_NUM
+ || ts_code == OMP_TRAIT_USER_CONDITION))
+ {
+ tree exp = OMP_TS_PROPERTIES (ts);
+ if (walk_tree (&exp, expr_uses_parm_decl, NULL, NULL))
+ {
+ sorry_at (loc,
+ "reference to function parameter in "
+ "%<declare variant%> dynamic selector expression");
+ return error_mark_node;
+ }
+ }
+
if (omp_ts_map[ts_code].valid_properties == NULL)
continue;
@@ -1401,6 +1417,9 @@ omp_check_context_selector (location_t loc, tree ctx, bool metadirective_p)
return ctx;
}
+/* Forward declarations. */
+static int omp_context_selector_set_compare (enum omp_tss_code, tree, tree);
+static int omp_construct_simd_compare (tree, tree, bool);
/* Register VARIANT as variant of some base function marked with
#pragma omp declare variant. CONSTRUCT is corresponding list of
@@ -1471,24 +1490,118 @@ make_omp_metadirective_variant (tree selector, tree directive, tree body)
return build_tree_list (selector, build_tree_list (directive, body));
}
+/* If the construct selector traits SELECTOR_TRAITS match the corresponding
+ OpenMP context traits CONTEXT_TRAITS, return true and set *SCORE to the
+ corresponding score if it is non-null. */
+static bool
+omp_construct_traits_match (tree selector_traits, tree context_traits,
+ score_wide_int *score)
+{
+ int slength = list_length (selector_traits);
+ int clength = list_length (context_traits);
-/* Return 1 if context selector matches the current OpenMP context, 0
+ /* Trivial failure: the selector has more traits than the OpenMP context. */
+ if (slength > clength)
+ return false;
+
+ /* There's only one trait in the selector and it doesn't have any properties
+ to match. */
+ if (slength == 1 && !OMP_TS_PROPERTIES (selector_traits))
+ {
+ int p = 0, i = 1;
+ enum omp_ts_code code = OMP_TS_CODE (selector_traits);
+ for (tree t = context_traits; t; t = TREE_CHAIN (t), i++)
+ if (OMP_TS_CODE (t) == code)
+ p = i;
+ if (p != 0)
+ {
+ if (score)
+ *score = wi::shifted_mask <score_wide_int> (p - 1, 1, false);
+ return true;
+ }
+ else
+ return false;
+ }
+
+ /* Now handle the more general cases.
+ Both lists of traits are ordered from outside in, corresponding to
+ the c1, ..., cN numbering for the OpenMP context specified in
+ in section 7.1 of the OpenMP 5.2 spec. Section 7.3 of the spec says
+ "if the traits that correspond to the construct selector set appear
+ multiple times in the OpenMP context, the highest valued subset of
+ context traits that contains all trait selectors in the same order
+ are used". This means that we want to start the search for a match
+ from the end of the list, rather than the beginning. To facilitate
+ that, transfer the lists to temporary arrays to allow random access
+ to the elements (their order remains outside in). */
+ int i, j;
+ tree s, c;
+
+ tree *sarray = (tree *) alloca (slength * sizeof (tree));
+ for (s = selector_traits, i = 0; s; s = TREE_CHAIN (s), i++)
+ sarray[i] = s;
+
+ tree *carray = (tree *) alloca (clength * sizeof (tree));
+ for (c = context_traits, j = 0; c; c = TREE_CHAIN (c), j++)
+ carray[j] = c;
+
+ /* The variable "i" indexes the selector, "j" indexes the OpenMP context.
+ Find the "j" corresponding to each sarray[i]. Note that the spec uses
+ "p" as the 1-based position, but "j" is zero-based, e.g. equal to
+ p - 1. */
+ score_wide_int result = 0;
+ j = clength - 1;
+ for (i = slength - 1; i >= 0; i--)
+ {
+ enum omp_ts_code code = OMP_TS_CODE (sarray[i]);
+ tree props = OMP_TS_PROPERTIES (sarray[i]);
+ for (; j >= 0; j--)
+ {
+ if (OMP_TS_CODE (carray[j]) != code)
+ continue;
+ if (code == OMP_TRAIT_CONSTRUCT_SIMD
+ && props
+ && omp_construct_simd_compare (props,
+ OMP_TS_PROPERTIES (carray[j]),
+ true) > 0)
+ continue;
+ break;
+ }
+ /* If j >= 0, we have a match for this trait at position j. */
+ if (j < 0)
+ return false;
+ result += wi::shifted_mask <score_wide_int> (j, 1, false);
+ j--;
+ }
+ if (score)
+ *score = result;
+ return true;
+}
+
+/* Return 1 if context selector CTX matches the current OpenMP context, 0
if it does not and -1 if it is unknown and need to be determined later.
- Some properties can be checked right away during parsing (this routine),
- others need to wait until the whole TU is parsed, others need to wait until
+ Some properties can be checked right away during parsing, others need
+ to wait until the whole TU is parsed, others need to wait until
IPA, others until vectorization.
- METADIRECTIVE_P is true if this is a metadirective context, and DELAY_P
- is true if it's too early in compilation to determine whether some
- properties match.
+ CONSTRUCT_CONTEXT is a list of construct traits from the OpenMP context,
+ which must be collected by omp_get_construct_context during
+ gimplification. It is ignored (and may be null) if this function is
+ called during parsing. Otherwise COMPLETE_P should indicate whether
+ CONSTRUCT_CONTEXT is known to be complete and not missing constructs
+ filled in later during compilation.
Dynamic properties (which are evaluated at run-time) should always
return 1. */
int
-omp_context_selector_matches (tree ctx, bool metadirective_p, bool delay_p)
+omp_context_selector_matches (tree ctx,
+ tree construct_context,
+ bool complete_p)
{
int ret = 1;
+ bool maybe_offloaded = omp_maybe_offloaded (construct_context);
+
for (tree tss = ctx; tss; tss = TREE_CHAIN (tss))
{
enum omp_tss_code set = OMP_TSS_CODE (tss);
@@ -1502,61 +1615,45 @@ omp_context_selector_matches (tree ctx, bool metadirective_p, bool delay_p)
if (set == OMP_TRAIT_SET_CONSTRUCT)
{
- /* For now, ignore the construct set. While something can be
- determined already during parsing, we don't know until end of TU
- whether additional constructs aren't added through declare variant
- unless "omp declare variant variant" attribute exists already
- (so in most of the cases), and we'd need to maintain set of
- surrounding OpenMP constructs, which is better handled during
- gimplification. */
+ /* We cannot resolve the construct selector during parsing because
+ the OpenMP context (and CONSTRUCT_CONTEXT) isn't available
+ until gimplification. */
if (symtab->state == PARSING)
{
ret = -1;
continue;
}
- int nconstructs = list_length (selectors);
- enum tree_code *constructs = NULL;
- if (nconstructs)
- {
- /* Even though this alloca appears in a loop over selector
- sets, it does not repeatedly grow the stack, because
- there can be only one construct selector set specified.
- This is enforced by omp_check_context_selector. */
- constructs
- = (enum tree_code *) alloca (nconstructs
- * sizeof (enum tree_code));
- omp_construct_traits_to_codes (selectors, nconstructs,
- constructs);
- }
+ gcc_assert (selectors);
- if (cfun && (cfun->curr_properties & PROP_gimple_any) != 0)
+ /* During gimplification, CONSTRUCT_CONTEXT is partial, and doesn't
+ include a construct for "declare simd" that may be added
+ when there is not an enclosing "target" construct. We might
+ be able to find a positive match against the partial context
+ (although we cannot yet score it accurately), but if we can't,
+ treat it as unknown instead of no match. */
+ if (!omp_construct_traits_match (selectors, construct_context, NULL))
{
- if (!cfun->after_inlining)
- {
- ret = -1;
- continue;
- }
- int i;
- for (i = 0; i < nconstructs; ++i)
- if (constructs[i] == OMP_SIMD)
- break;
- if (i < nconstructs)
- {
- ret = -1;
- continue;
- }
- /* If there is no simd, assume it is ok after IPA,
- constructs should have been checked before. */
- continue;
- }
+ /* If we've got a complete context, it's definitely a failed
+ match. */
+ if (complete_p)
+ return 0;
- int r = omp_construct_selector_matches (constructs, nconstructs,
- NULL);
- if (r == 0)
- return 0;
- if (r == -1)
- ret = -1;
+ /* If the selector doesn't include simd, then we don't have
+ to worry about whether "declare simd" would cause it to
+ match; so this is also a definite failure. */
+ bool have_simd = false;
+ for (tree ts = construct_context; ts; ts = TREE_CHAIN (ts))
+ if (OMP_TS_CODE (ts) == OMP_TRAIT_CONSTRUCT_SIMD)
+ {
+ have_simd = true;
+ break;
+ }
+ if (!have_simd)
+ return 0;
+ else
+ ret = -1;
+ }
continue;
}
else if (set == OMP_TRAIT_SET_TARGET_DEVICE)
@@ -1570,302 +1667,293 @@ omp_context_selector_matches (tree ctx, bool metadirective_p, bool delay_p)
switch (sel)
{
case OMP_TRAIT_IMPLEMENTATION_VENDOR:
- if (set == OMP_TRAIT_SET_IMPLEMENTATION)
- for (tree p = OMP_TS_PROPERTIES (ts); p; p = TREE_CHAIN (p))
- {
- const char *prop = omp_context_name_list_prop (p);
- if (prop == NULL)
- return 0;
- if (!strcmp (prop, "gnu"))
- continue;
- return 0;
- }
- break;
- case OMP_TRAIT_IMPLEMENTATION_EXTENSION:
- if (set == OMP_TRAIT_SET_IMPLEMENTATION)
- /* We don't support any extensions right now. */
- return 0;
- break;
- case OMP_TRAIT_IMPLEMENTATION_ADMO:
- if (set == OMP_TRAIT_SET_IMPLEMENTATION)
+ gcc_assert (set == OMP_TRAIT_SET_IMPLEMENTATION);
+ for (tree p = OMP_TS_PROPERTIES (ts); p; p = TREE_CHAIN (p))
{
- if (cfun && (cfun->curr_properties & PROP_gimple_any) != 0)
- break;
-
- enum omp_memory_order omo
- = ((enum omp_memory_order)
- (omp_requires_mask
- & OMP_REQUIRES_ATOMIC_DEFAULT_MEM_ORDER));
- if (omo == OMP_MEMORY_ORDER_UNSPECIFIED)
- {
- /* We don't know yet, until end of TU. */
- if (symtab->state == PARSING)
- {
- ret = -1;
- break;
- }
- else
- omo = OMP_MEMORY_ORDER_RELAXED;
- }
- tree p = OMP_TS_PROPERTIES (ts);
- const char *prop = IDENTIFIER_POINTER (OMP_TP_NAME (p));
- if (!strcmp (prop, "relaxed")
- && omo != OMP_MEMORY_ORDER_RELAXED)
- return 0;
- else if (!strcmp (prop, "seq_cst")
- && omo != OMP_MEMORY_ORDER_SEQ_CST)
- return 0;
- else if (!strcmp (prop, "acq_rel")
- && omo != OMP_MEMORY_ORDER_ACQ_REL)
- return 0;
- else if (!strcmp (prop, "acquire")
- && omo != OMP_MEMORY_ORDER_ACQUIRE)
- return 0;
- else if (!strcmp (prop, "release")
- && omo != OMP_MEMORY_ORDER_RELEASE)
+ const char *prop = omp_context_name_list_prop (p);
+ if (prop == NULL)
return 0;
+ if (!strcmp (prop, "gnu"))
+ continue;
+ return 0;
}
break;
- case OMP_TRAIT_DEVICE_ARCH:
- if (set == OMP_TRAIT_SET_DEVICE)
- for (tree p = OMP_TS_PROPERTIES (ts); p; p = TREE_CHAIN (p))
- {
- const char *arch = omp_context_name_list_prop (p);
- if (arch == NULL)
- return 0;
- if (metadirective_p && delay_p)
- return -1;
+ case OMP_TRAIT_IMPLEMENTATION_EXTENSION:
+ gcc_assert (set == OMP_TRAIT_SET_IMPLEMENTATION);
+ /* We don't support any extensions right now. */
+ return 0;
+ break;
+ case OMP_TRAIT_IMPLEMENTATION_ADMO:
+ gcc_assert (set == OMP_TRAIT_SET_IMPLEMENTATION);
+ if (cfun && (cfun->curr_properties & PROP_gimple_any) != 0)
+ break;
- int r = 0;
- if (targetm.omp.device_kind_arch_isa != NULL)
- r = targetm.omp.device_kind_arch_isa (omp_device_arch,
- arch);
- if (r == 0 || (r == -1 && symtab->state != PARSING))
+ {
+ enum omp_memory_order omo
+ = ((enum omp_memory_order)
+ (omp_requires_mask
+ & OMP_REQUIRES_ATOMIC_DEFAULT_MEM_ORDER));
+ if (omo == OMP_MEMORY_ORDER_UNSPECIFIED)
+ {
+ /* We don't know yet, until end of TU. */
+ if (symtab->state == PARSING)
{
- /* If we are or might be in a target region or
- declare target function, need to take into account
- also offloading values. */
- if (!omp_maybe_offloaded ())
- return 0;
- if (ENABLE_OFFLOADING)
- {
- const char *arches = omp_offload_device_arch;
- if (omp_offload_device_kind_arch_isa (arches,
- arch))
- {
- ret = -1;
- continue;
- }
- }
- return 0;
+ ret = -1;
+ break;
}
- else if (r == -1)
- ret = -1;
- /* If arch matches on the host, it still might not match
- in the offloading region. */
- else if (omp_maybe_offloaded ())
- ret = -1;
+ else
+ omo = OMP_MEMORY_ORDER_RELAXED;
}
+ tree p = OMP_TS_PROPERTIES (ts);
+ const char *prop = IDENTIFIER_POINTER (OMP_TP_NAME (p));
+ if (!strcmp (prop, "relaxed")
+ && omo != OMP_MEMORY_ORDER_RELAXED)
+ return 0;
+ else if (!strcmp (prop, "seq_cst")
+ && omo != OMP_MEMORY_ORDER_SEQ_CST)
+ return 0;
+ else if (!strcmp (prop, "acq_rel")
+ && omo != OMP_MEMORY_ORDER_ACQ_REL)
+ return 0;
+ else if (!strcmp (prop, "acquire")
+ && omo != OMP_MEMORY_ORDER_ACQUIRE)
+ return 0;
+ else if (!strcmp (prop, "release")
+ && omo != OMP_MEMORY_ORDER_RELEASE)
+ return 0;
+ }
+ break;
+ case OMP_TRAIT_DEVICE_ARCH:
+ gcc_assert (set == OMP_TRAIT_SET_DEVICE);
+ for (tree p = OMP_TS_PROPERTIES (ts); p; p = TREE_CHAIN (p))
+ {
+ const char *arch = omp_context_name_list_prop (p);
+ if (arch == NULL)
+ return 0;
+ int r = 0;
+ if (targetm.omp.device_kind_arch_isa != NULL)
+ r = targetm.omp.device_kind_arch_isa (omp_device_arch,
+ arch);
+ if (r == 0 || (r == -1 && symtab->state != PARSING))
+ {
+ /* If we are or might be in a target region or
+ declare target function, need to take into account
+ also offloading values.
+ Note that maybe_offloaded is always false in late
+ resolution; that's handled as native code (the
+ above case) in the offload compiler instead. */
+ if (!maybe_offloaded)
+ return 0;
+ if (ENABLE_OFFLOADING)
+ {
+ const char *arches = omp_offload_device_arch;
+ if (omp_offload_device_kind_arch_isa (arches, arch))
+ {
+ ret = -1;
+ continue;
+ }
+ }
+ return 0;
+ }
+ else if (r == -1)
+ ret = -1;
+ /* If arch matches on the host, it still might not match
+ in the offloading region. */
+ else if (maybe_offloaded)
+ ret = -1;
+ }
break;
case OMP_TRAIT_IMPLEMENTATION_UNIFIED_ADDRESS:
- if (set == OMP_TRAIT_SET_IMPLEMENTATION)
- {
- if (cfun && (cfun->curr_properties & PROP_gimple_any) != 0)
- break;
+ gcc_assert (set == OMP_TRAIT_SET_IMPLEMENTATION);
+ if (cfun && (cfun->curr_properties & PROP_gimple_any) != 0)
+ break;
- if ((omp_requires_mask & OMP_REQUIRES_UNIFIED_ADDRESS) == 0)
- {
- if (symtab->state == PARSING)
- ret = -1;
- else
- return 0;
- }
+ if ((omp_requires_mask & OMP_REQUIRES_UNIFIED_ADDRESS) == 0)
+ {
+ if (symtab->state == PARSING)
+ ret = -1;
+ else
+ return 0;
}
break;
case OMP_TRAIT_IMPLEMENTATION_UNIFIED_SHARED_MEMORY:
- if (set == OMP_TRAIT_SET_IMPLEMENTATION)
- {
- if (cfun && (cfun->curr_properties & PROP_gimple_any) != 0)
- break;
+ gcc_assert (set == OMP_TRAIT_SET_IMPLEMENTATION);
+ if (cfun && (cfun->curr_properties & PROP_gimple_any) != 0)
+ break;
- if ((omp_requires_mask
- & OMP_REQUIRES_UNIFIED_SHARED_MEMORY) == 0)
- {
- if (symtab->state == PARSING)
- ret = -1;
- else
- return 0;
- }
+ if ((omp_requires_mask
+ & OMP_REQUIRES_UNIFIED_SHARED_MEMORY) == 0)
+ {
+ if (symtab->state == PARSING)
+ ret = -1;
+ else
+ return 0;
}
break;
case OMP_TRAIT_IMPLEMENTATION_DYNAMIC_ALLOCATORS:
- if (set == OMP_TRAIT_SET_IMPLEMENTATION)
- {
- if (cfun && (cfun->curr_properties & PROP_gimple_any) != 0)
- break;
+ gcc_assert (set == OMP_TRAIT_SET_IMPLEMENTATION);
+ if (cfun && (cfun->curr_properties & PROP_gimple_any) != 0)
+ break;
- if ((omp_requires_mask
- & OMP_REQUIRES_DYNAMIC_ALLOCATORS) == 0)
- {
- if (symtab->state == PARSING)
- ret = -1;
- else
- return 0;
- }
+ if ((omp_requires_mask
+ & OMP_REQUIRES_DYNAMIC_ALLOCATORS) == 0)
+ {
+ if (symtab->state == PARSING)
+ ret = -1;
+ else
+ return 0;
}
break;
case OMP_TRAIT_IMPLEMENTATION_REVERSE_OFFLOAD:
- if (set == OMP_TRAIT_SET_IMPLEMENTATION)
- {
- if (cfun && (cfun->curr_properties & PROP_gimple_any) != 0)
- break;
+ gcc_assert (set == OMP_TRAIT_SET_IMPLEMENTATION);
+ if (cfun && (cfun->curr_properties & PROP_gimple_any) != 0)
+ break;
- if ((omp_requires_mask & OMP_REQUIRES_REVERSE_OFFLOAD) == 0)
- {
- if (symtab->state == PARSING)
- ret = -1;
- else
- return 0;
- }
+ if ((omp_requires_mask & OMP_REQUIRES_REVERSE_OFFLOAD) == 0)
+ {
+ if (symtab->state == PARSING)
+ ret = -1;
+ else
+ return 0;
}
break;
case OMP_TRAIT_DEVICE_KIND:
- if (set == OMP_TRAIT_SET_DEVICE)
- for (tree p = OMP_TS_PROPERTIES (ts); p; p = TREE_CHAIN (p))
- {
- const char *prop = omp_context_name_list_prop (p);
- if (prop == NULL)
- return 0;
- if (!strcmp (prop, "any"))
- continue;
- if (!strcmp (prop, "host"))
- {
+ gcc_assert (set == OMP_TRAIT_SET_DEVICE);
+ for (tree p = OMP_TS_PROPERTIES (ts); p; p = TREE_CHAIN (p))
+ {
+ const char *prop = omp_context_name_list_prop (p);
+ if (prop == NULL)
+ return 0;
+ if (!strcmp (prop, "any"))
+ continue;
+ if (!strcmp (prop, "host"))
+ {
#ifdef ACCEL_COMPILER
- return 0;
+ return 0;
#else
- if (omp_maybe_offloaded ())
- ret = -1;
- continue;
+ if (maybe_offloaded)
+ ret = -1;
+ continue;
#endif
- }
- if (!strcmp (prop, "nohost"))
- {
+ }
+ if (!strcmp (prop, "nohost"))
+ {
#ifndef ACCEL_COMPILER
- if (omp_maybe_offloaded ())
- ret = -1;
- else
- return 0;
-#endif
- continue;
- }
- if (metadirective_p && delay_p)
- return -1;
-
- int r = 0;
- if (targetm.omp.device_kind_arch_isa != NULL)
- r = targetm.omp.device_kind_arch_isa (omp_device_kind,
- prop);
- else
- r = strcmp (prop, "cpu") == 0;
- if (r == 0 || (r == -1 && symtab->state != PARSING))
- {
- /* If we are or might be in a target region or
- declare target function, need to take into account
- also offloading values. */
- if (!omp_maybe_offloaded ())
- return 0;
- if (ENABLE_OFFLOADING)
- {
- const char *kinds = omp_offload_device_kind;
- if (omp_offload_device_kind_arch_isa (kinds, prop))
- {
- ret = -1;
- continue;
- }
- }
+ if (maybe_offloaded)
+ ret = -1;
+ else
return 0;
- }
- else if (r == -1)
- ret = -1;
- /* If kind matches on the host, it still might not match
- in the offloading region. */
- else if (omp_maybe_offloaded ())
- ret = -1;
- }
+#endif
+ continue;
+ }
+
+ int r = 0;
+ if (targetm.omp.device_kind_arch_isa != NULL)
+ r = targetm.omp.device_kind_arch_isa (omp_device_kind,
+ prop);
+ else
+ r = strcmp (prop, "cpu") == 0;
+ if (r == 0 || (r == -1 && symtab->state != PARSING))
+ {
+ /* If we are or might be in a target region or
+ declare target function, need to take into account
+ also offloading values.
+ Note that maybe_offloaded is always false in late
+ resolution; that's handled as native code (the
+ above case) in the offload compiler instead. */
+ if (!maybe_offloaded)
+ return 0;
+ if (ENABLE_OFFLOADING)
+ {
+ const char *kinds = omp_offload_device_kind;
+ if (omp_offload_device_kind_arch_isa (kinds, prop))
+ {
+ ret = -1;
+ continue;
+ }
+ }
+ return 0;
+ }
+ else if (r == -1)
+ ret = -1;
+ /* If kind matches on the host, it still might not match
+ in the offloading region. */
+ else if (maybe_offloaded)
+ ret = -1;
+ }
break;
case OMP_TRAIT_DEVICE_ISA:
- if (set == OMP_TRAIT_SET_DEVICE)
- for (tree p = OMP_TS_PROPERTIES (ts); p; p = TREE_CHAIN (p))
- {
- const char *isa = omp_context_name_list_prop (p);
- if (isa == NULL)
- return 0;
- if (metadirective_p && delay_p)
- return -1;
-
- int r = 0;
- if (targetm.omp.device_kind_arch_isa != NULL)
- r = targetm.omp.device_kind_arch_isa (omp_device_isa,
- isa);
- if (r == 0 || (r == -1 && symtab->state != PARSING))
- {
- /* If isa is valid on the target, but not in the
- current function and current function has
- #pragma omp declare simd on it, some simd clones
- might have the isa added later on. */
- if (r == -1
- && targetm.simd_clone.compute_vecsize_and_simdlen
- && (cfun == NULL || !cfun->after_inlining))
- {
- tree attrs
- = DECL_ATTRIBUTES (current_function_decl);
- if (lookup_attribute ("omp declare simd", attrs))
- {
- ret = -1;
- continue;
- }
- }
- /* If we are or might be in a target region or
- declare target function, need to take into account
- also offloading values. */
- if (!omp_maybe_offloaded ())
- return 0;
- if (ENABLE_OFFLOADING)
- {
- const char *isas = omp_offload_device_isa;
- if (omp_offload_device_kind_arch_isa (isas, isa))
- {
- ret = -1;
- continue;
- }
- }
+ gcc_assert (set == OMP_TRAIT_SET_DEVICE);
+ for (tree p = OMP_TS_PROPERTIES (ts); p; p = TREE_CHAIN (p))
+ {
+ const char *isa = omp_context_name_list_prop (p);
+ if (isa == NULL)
+ return 0;
+ int r = 0;
+ if (targetm.omp.device_kind_arch_isa != NULL)
+ r = targetm.omp.device_kind_arch_isa (omp_device_isa,
+ isa);
+ if (r == 0 || (r == -1 && symtab->state != PARSING))
+ {
+ /* If isa is valid on the target, but not in the
+ current function and current function has
+ #pragma omp declare simd on it, some simd clones
+ might have the isa added later on. */
+ if (r == -1
+ && targetm.simd_clone.compute_vecsize_and_simdlen
+ && (cfun == NULL || !cfun->after_inlining))
+ {
+ tree attrs
+ = DECL_ATTRIBUTES (current_function_decl);
+ if (lookup_attribute ("omp declare simd", attrs))
+ {
+ ret = -1;
+ continue;
+ }
+ }
+ /* If we are or might be in a target region or
+ declare target function, need to take into account
+ also offloading values.
+ Note that maybe_offloaded is always false in late
+ resolution; that's handled as native code (the
+ above case) in the offload compiler instead. */
+ if (!maybe_offloaded)
return 0;
- }
- else if (r == -1)
- ret = -1;
- /* If isa matches on the host, it still might not match
- in the offloading region. */
- else if (omp_maybe_offloaded ())
- ret = -1;
- }
+ if (ENABLE_OFFLOADING)
+ {
+ const char *isas = omp_offload_device_isa;
+ if (omp_offload_device_kind_arch_isa (isas, isa))
+ {
+ ret = -1;
+ continue;
+ }
+ }
+ return 0;
+ }
+ else if (r == -1)
+ ret = -1;
+ /* If isa matches on the host, it still might not match
+ in the offloading region. */
+ else if (maybe_offloaded)
+ ret = -1;
+ }
break;
case OMP_TRAIT_USER_CONDITION:
- if (set == OMP_TRAIT_SET_USER)
- for (tree p = OMP_TS_PROPERTIES (ts); p; p = TREE_CHAIN (p))
- if (OMP_TP_NAME (p) == NULL_TREE)
- {
- /* OpenMP 5.1 allows non-constant conditions for
- metadirectives. */
- if (metadirective_p
- && !tree_fits_shwi_p (OMP_TP_VALUE (p)))
- break;
+ gcc_assert (set == OMP_TRAIT_SET_USER);
+ for (tree p = OMP_TS_PROPERTIES (ts); p; p = TREE_CHAIN (p))
+ if (OMP_TP_NAME (p) == NULL_TREE)
+ {
+ /* If the expression is not a constant, the selector
+ is dynamic. */
+ if (!tree_fits_shwi_p (OMP_TP_VALUE (p)))
+ break;
- if (integer_zerop (OMP_TP_VALUE (p)))
- return 0;
- if (integer_nonzerop (OMP_TP_VALUE (p)))
- break;
- ret = -1;
- }
+ if (integer_zerop (OMP_TP_VALUE (p)))
+ return 0;
+ if (integer_nonzerop (OMP_TP_VALUE (p)))
+ break;
+ ret = -1;
+ }
break;
default:
break;
@@ -1876,10 +1964,13 @@ omp_context_selector_matches (tree ctx, bool metadirective_p, bool delay_p)
}
/* Compare construct={simd} CLAUSES1 with CLAUSES2, return 0/-1/1/2 as
- in omp_context_selector_set_compare. */
+ in omp_context_selector_set_compare. If MATCH_P is true, additionally
+ apply the special matching rules for the "simdlen" and "aligned" clauses
+ used to determine whether the selector CLAUSES1 is part of matches
+ the OpenMP context containing CLAUSES2. */
static int
-omp_construct_simd_compare (tree clauses1, tree clauses2)
+omp_construct_simd_compare (tree clauses1, tree clauses2, bool match_p)
{
if (clauses1 == NULL_TREE)
return clauses2 == NULL_TREE ? 0 : -1;
@@ -1896,6 +1987,7 @@ omp_construct_simd_compare (tree clauses1, tree clauses2)
: inbranch(false), notinbranch(false), simdlen(NULL_TREE) {}
} data[2];
unsigned int i;
+ tree e0, e1;
for (i = 0; i < 2; i++)
for (tree c = i ? clauses2 : clauses1; c; c = OMP_CLAUSE_CHAIN (c))
{
@@ -1934,10 +2026,23 @@ omp_construct_simd_compare (tree clauses1, tree clauses2)
r |= data[0].inbranch ? 2 : 1;
if (data[0].notinbranch != data[1].notinbranch)
r |= data[0].notinbranch ? 2 : 1;
- if (!simple_cst_equal (data[0].simdlen, data[1].simdlen))
+ e0 = data[0].simdlen;
+ e1 = data[1].simdlen;
+ if (!simple_cst_equal (e0, e1))
{
- if (data[0].simdlen && data[1].simdlen)
- return 2;
+ if (e0 && e1)
+ {
+ if (match_p && tree_fits_uhwi_p (e0) && tree_fits_uhwi_p (e1))
+ {
+ /* The two simdlen clauses match if m is a multiple of n. */
+ unsigned HOST_WIDE_INT n = tree_to_uhwi (e0);
+ unsigned HOST_WIDE_INT m = tree_to_uhwi (e1);
+ if (m % n != 0)
+ return 2;
+ }
+ else
+ return 2;
+ }
r |= data[0].simdlen ? 2 : 1;
}
if (data[0].data_sharing.length () < data[1].data_sharing.length ()
@@ -1978,9 +2083,22 @@ omp_construct_simd_compare (tree clauses1, tree clauses2)
}
if (c1 == NULL_TREE)
continue;
- if (!simple_cst_equal (OMP_CLAUSE_ALIGNED_ALIGNMENT (c1),
- OMP_CLAUSE_ALIGNED_ALIGNMENT (c2)))
- return 2;
+ e0 = OMP_CLAUSE_ALIGNED_ALIGNMENT (c1);
+ e1 = OMP_CLAUSE_ALIGNED_ALIGNMENT (c2);
+ if (!simple_cst_equal (e0, e1))
+ {
+ if (e0 && e1
+ && match_p && tree_fits_uhwi_p (e0) && tree_fits_uhwi_p (e1))
+ {
+ /* The two aligned clauses match if n is a multiple of m. */
+ unsigned HOST_WIDE_INT n = tree_to_uhwi (e0);
+ unsigned HOST_WIDE_INT m = tree_to_uhwi (e1);
+ if (n % m != 0)
+ return 2;
+ }
+ else
+ return 2;
+ }
}
switch (r)
{
@@ -2059,7 +2177,7 @@ omp_context_selector_props_compare (enum omp_tss_code set,
1 if CTX2 is a strict subset of CTX1, or
2 if neither context is a subset of another one. */
-int
+static int
omp_context_selector_set_compare (enum omp_tss_code set, tree ctx1, tree ctx2)
{
@@ -2096,7 +2214,8 @@ omp_context_selector_set_compare (enum omp_tss_code set, tree ctx1, tree ctx2)
int r = 0;
if (OMP_TS_CODE (ts1) == OMP_TRAIT_CONSTRUCT_SIMD)
r = omp_construct_simd_compare (OMP_TS_PROPERTIES (ts1),
- OMP_TS_PROPERTIES (ts2));
+ OMP_TS_PROPERTIES (ts2),
+ false);
if (r == 2 || (ret && r && (ret < 0) != (r < 0)))
return 2;
if (ret == 0)
@@ -2296,11 +2415,9 @@ omp_dynamic_cond (tree ctx)
{
tree expr_list = OMP_TS_PROPERTIES (user);
- gcc_assert (OMP_TP_NAME (expr_list) == NULL_TREE);
-
/* The user condition is not dynamic if it is constant. */
- if (!tree_fits_shwi_p (TREE_VALUE (expr_list)))
- expr = TREE_VALUE (expr_list);
+ if (!tree_fits_shwi_p (OMP_TP_VALUE (expr_list)))
+ expr = OMP_TP_VALUE (expr_list);
}
tree target_device
@@ -2359,86 +2476,145 @@ omp_dynamic_cond (tree ctx)
return expr;
}
+/* Compute *SCORE for context selector CTX, which is already known to match.
+ CONSTRUCT_CONTEXT is the OpenMP construct context; if this is null or
+ incomplete (e.g., during parsing or gimplification) then it may not be
+ possible to compute the score accurately. In this case it does a best
+ guess based on the incomplete context and returns false; otherwise it
+ returns true.
-/* Compute *SCORE for context selector CTX. Return true if the score
- would be different depending on whether it is a declare simd clone or
- not. DECLARE_SIMD should be true for the case when it would be
- a declare simd clone. */
+ Cited text in the comments is from section 7.2 of the OpenMP 5.2
+ specification. */
static bool
-omp_context_compute_score (tree ctx, score_wide_int *score, bool declare_simd)
+omp_context_compute_score (tree ctx, tree construct_context,
+ bool complete_p, score_wide_int *score)
{
- tree selectors
- = omp_get_context_selector_list (ctx, OMP_TRAIT_SET_CONSTRUCT);
- bool has_kind
- = (omp_get_context_selector (ctx, OMP_TRAIT_SET_DEVICE,
- OMP_TRAIT_DEVICE_KIND)
- || omp_get_context_selector (ctx, OMP_TRAIT_SET_TARGET_DEVICE,
- OMP_TRAIT_DEVICE_KIND));
- bool has_arch
- = (omp_get_context_selector (ctx, OMP_TRAIT_SET_DEVICE,
- OMP_TRAIT_DEVICE_ARCH)
- || omp_get_context_selector (ctx, OMP_TRAIT_SET_TARGET_DEVICE,
- OMP_TRAIT_DEVICE_ARCH));
- bool has_isa
- = (omp_get_context_selector (ctx, OMP_TRAIT_SET_DEVICE,
- OMP_TRAIT_DEVICE_ISA)
- || omp_get_context_selector (ctx, OMP_TRAIT_SET_TARGET_DEVICE,
- OMP_TRAIT_DEVICE_ISA));
- bool ret = false;
+ int l = list_length (construct_context);
+ bool retval = true;
+
+ /* "the final score is the sum of the values of all specified selectors
+ plus 1". */
*score = 1;
for (tree tss = ctx; tss; tss = TREE_CHAIN (tss))
- if (OMP_TSS_TRAIT_SELECTORS (tss) != selectors)
- for (tree ts = OMP_TSS_TRAIT_SELECTORS (tss); ts; ts = TREE_CHAIN (ts))
+ {
+ if (OMP_TSS_CODE (tss) == OMP_TRAIT_SET_CONSTRUCT)
{
- tree s = OMP_TS_SCORE (ts);
- if (s && TREE_CODE (s) == INTEGER_CST)
- *score += score_wide_int::from (wi::to_wide (s),
- TYPE_SIGN (TREE_TYPE (s)));
+ /* "Each trait selector for which the corresponding trait appears
+ in the context trait set in the OpenMP context..." */
+ score_wide_int tss_score;
+ omp_construct_traits_match (OMP_TSS_TRAIT_SELECTORS (tss),
+ construct_context, &tss_score);
+ *score += tss_score;
+ if (!complete_p)
+ retval = false;
+ }
+ else if (OMP_TSS_CODE (tss) == OMP_TRAIT_SET_DEVICE
+ || OMP_TSS_CODE (tss) == OMP_TRAIT_SET_TARGET_DEVICE)
+ {
+ /* "The kind, arch, and isa selectors, if specified, are given
+ the values 2**l, 2**(l+1), and 2**(l+2), respectively..."
+ FIXME: the spec isn't clear what should happen if there are
+ both "device" and "target_device" selector sets specified.
+ This implementation adds up the bits rather than ORs them. */
+ for (tree ts = OMP_TSS_TRAIT_SELECTORS (tss); ts;
+ ts = TREE_CHAIN (ts))
+ {
+ enum omp_ts_code code = OMP_TS_CODE (ts);
+ if (code == OMP_TRAIT_DEVICE_KIND)
+ *score += wi::shifted_mask <score_wide_int> (l, 1, false);
+ else if (code == OMP_TRAIT_DEVICE_ARCH)
+ *score += wi::shifted_mask <score_wide_int> (l + 1, 1, false);
+ else if (code == OMP_TRAIT_DEVICE_ISA)
+ *score += wi::shifted_mask <score_wide_int> (l + 2, 1, false);
+ }
+ if (!complete_p)
+ retval = false;
+ }
+ else
+ {
+ /* "Trait selectors for which a trait-score is specified..."
+ Note that there are no implementation-defined selectors, and
+ "other selectors are given a value of zero". */
+ for (tree ts = OMP_TSS_TRAIT_SELECTORS (tss); ts;
+ ts = TREE_CHAIN (ts))
+ {
+ tree s = OMP_TS_SCORE (ts);
+ if (s && TREE_CODE (s) == INTEGER_CST)
+ *score += score_wide_int::from (wi::to_wide (s),
+ TYPE_SIGN (TREE_TYPE (s)));
+ }
+ }
+ }
+ return retval;
+}
+
+/* CONSTRUCT_CONTEXT contains "the directive names, each being a trait,
+ of all enclosing constructs at that point in the program up to a target
+ construct", per section 7.1 of the 5.2 specification. The traits are
+ collected during gimplification and are listed outermost first.
+
+ This function attempts to apply the "if the point in the program is not
+ enclosed by a target construct, the following rules are applied in order"
+ requirements that follow in the same paragraph. This may not be possible,
+ depending on the compilation phase; in particular, "declare simd" clones
+ are not known until late resolution.
+
+ The augmented context is returned, and *COMPLETEP is set to true if
+ the context is known to be complete, false otherwise. */
+static tree
+omp_complete_construct_context (tree construct_context, bool *completep)
+{
+ /* The point in the program is enclosed by a target construct. */
+ if (construct_context
+ && OMP_TS_CODE (construct_context) == OMP_TRAIT_CONSTRUCT_TARGET)
+ *completep = true;
+
+ /* At parse time we have none of the information we need to collect
+ the missing pieces. */
+ else if (symtab->state == PARSING)
+ *completep = false;
+
+ else
+ {
+ tree attributes = DECL_ATTRIBUTES (current_function_decl);
+
+ /* Add simd trait when in a simd clone. This information is only
+ available during late resolution in the omp_device_lower pass,
+ however we can also rule out cases where we know earlier that
+ cfun is not a candidate for cloning. */
+ if (cfun && (cfun->curr_properties & PROP_gimple_any) != 0)
+ {
+ cgraph_node *node = cgraph_node::get (cfun->decl);
+ if (node->simdclone)
+ construct_context = make_trait_selector (OMP_TRAIT_CONSTRUCT_SIMD,
+ NULL_TREE, NULL_TREE,
+ construct_context);
+ *completep = true;
+ }
+ else if (lookup_attribute ("omp declare simd", attributes))
+ *completep = false;
+ else
+ *completep = true;
+
+ /* Add construct selector set within a "declare variant" function. */
+ tree variant_attr
+ = lookup_attribute ("omp declare variant variant", attributes);
+ if (variant_attr)
+ {
+ tree temp = NULL_TREE;
+ for (tree t = TREE_VALUE (variant_attr); t; t = TREE_CHAIN (t))
+ temp = chainon (temp, copy_node (t));
+ construct_context = chainon (temp, construct_context);
}
- if (selectors || has_kind || has_arch || has_isa)
- {
- int nconstructs = list_length (selectors);
- enum tree_code *constructs = NULL;
- if (nconstructs)
- {
- constructs
- = (enum tree_code *) alloca (nconstructs
- * sizeof (enum tree_code));
- omp_construct_traits_to_codes (selectors, nconstructs, constructs);
- }
- int *scores
- = (int *) alloca ((2 * nconstructs + 2) * sizeof (int));
- if (omp_construct_selector_matches (constructs, nconstructs, scores)
- == 2)
- ret = true;
- int b = declare_simd ? nconstructs + 1 : 0;
- if (scores[b + nconstructs] + 4U < score->get_precision ())
- {
- for (int n = 0; n < nconstructs; ++n)
- {
- if (scores[b + n] < 0)
- {
- *score = -1;
- return ret;
- }
- *score += wi::shifted_mask <score_wide_int> (scores[b + n], 1, false);
- }
- if (has_kind)
- *score += wi::shifted_mask <score_wide_int> (scores[b + nconstructs],
- 1, false);
- if (has_arch)
- *score += wi::shifted_mask <score_wide_int> (scores[b + nconstructs] + 1,
- 1, false);
- if (has_isa)
- *score += wi::shifted_mask <score_wide_int> (scores[b + nconstructs] + 2,
- 1, false);
- }
- else /* FIXME: Implement this. */
- gcc_unreachable ();
+ /* Add target trait when in a target variant. */
+ if (lookup_attribute ("omp declare target block", attributes))
+ construct_context = make_trait_selector (OMP_TRAIT_CONSTRUCT_TARGET,
+ NULL_TREE, NULL_TREE,
+ construct_context);
}
- return ret;
+ return construct_context;
}
/* Class describing a single variant. */
@@ -2537,388 +2713,6 @@ omp_declare_variant_alt_hasher::equal (omp_declare_variant_base_entry *x,
static GTY(()) hash_table<omp_declare_variant_alt_hasher>
*omp_declare_variant_alt;
-/* Try to resolve declare variant after gimplification. */
-
-static tree
-omp_resolve_late_declare_variant (tree alt)
-{
- cgraph_node *node = cgraph_node::get (alt);
- cgraph_node *cur_node = cgraph_node::get (cfun->decl);
- if (node == NULL
- || !node->declare_variant_alt
- || !cfun->after_inlining)
- return alt;
-
- omp_declare_variant_base_entry entry;
- entry.base = NULL;
- entry.node = node;
- entry.variants = NULL;
- omp_declare_variant_base_entry *entryp
- = omp_declare_variant_alt->find_with_hash (&entry, DECL_UID (alt));
-
- unsigned int i, j;
- omp_declare_variant_entry *varentry1, *varentry2;
- auto_vec <bool, 16> matches;
- unsigned int nmatches = 0;
- FOR_EACH_VEC_SAFE_ELT (entryp->variants, i, varentry1)
- {
- if (varentry1->matches)
- {
- /* This has been checked to be ok already. */
- matches.safe_push (true);
- nmatches++;
- continue;
- }
- switch (omp_context_selector_matches (varentry1->ctx, false, true))
- {
- case 0:
- matches.safe_push (false);
- break;
- case -1:
- return alt;
- default:
- matches.safe_push (true);
- nmatches++;
- break;
- }
- }
-
- if (nmatches == 0)
- return entryp->base->decl;
-
- /* A context selector that is a strict subset of another context selector
- has a score of zero. */
- FOR_EACH_VEC_SAFE_ELT (entryp->variants, i, varentry1)
- if (matches[i])
- {
- for (j = i + 1;
- vec_safe_iterate (entryp->variants, j, &varentry2); ++j)
- if (matches[j])
- {
- int r = omp_context_selector_compare (varentry1->ctx,
- varentry2->ctx);
- if (r == -1)
- {
- /* ctx1 is a strict subset of ctx2, ignore ctx1. */
- matches[i] = false;
- break;
- }
- else if (r == 1)
- /* ctx2 is a strict subset of ctx1, remove ctx2. */
- matches[j] = false;
- }
- }
-
- score_wide_int max_score = -1;
- varentry2 = NULL;
- FOR_EACH_VEC_SAFE_ELT (entryp->variants, i, varentry1)
- if (matches[i])
- {
- score_wide_int score
- = (cur_node->simdclone ? varentry1->score_in_declare_simd_clone
- : varentry1->score);
- if (score > max_score)
- {
- max_score = score;
- varentry2 = varentry1;
- }
- }
- return varentry2->variant->decl;
-}
-
-/* Hook to adjust hash tables on cgraph_node removal. */
-
-static void
-omp_declare_variant_remove_hook (struct cgraph_node *node, void *)
-{
- if (!node->declare_variant_alt)
- return;
-
- /* Drop this hash table completely. */
- omp_declare_variants = NULL;
- /* And remove node from the other hash table. */
- if (omp_declare_variant_alt)
- {
- omp_declare_variant_base_entry entry;
- entry.base = NULL;
- entry.node = node;
- entry.variants = NULL;
- omp_declare_variant_alt->remove_elt_with_hash (&entry,
- DECL_UID (node->decl));
- }
-}
-
-/* Try to resolve declare variant, return the variant decl if it should
- be used instead of base, or base otherwise. */
-
-tree
-omp_resolve_declare_variant (tree base)
-{
- tree variant1 = NULL_TREE, variant2 = NULL_TREE;
- if (cfun && (cfun->curr_properties & PROP_gimple_any) != 0)
- return omp_resolve_late_declare_variant (base);
-
- auto_vec <tree, 16> variants;
- auto_vec <bool, 16> defer;
- bool any_deferred = false;
- for (tree attr = DECL_ATTRIBUTES (base); attr; attr = TREE_CHAIN (attr))
- {
- attr = lookup_attribute ("omp declare variant base", attr);
- if (attr == NULL_TREE)
- break;
- if (TREE_CODE (TREE_PURPOSE (TREE_VALUE (attr))) != FUNCTION_DECL)
- continue;
- cgraph_node *node = cgraph_node::get (base);
- /* If this is already a magic decl created by this function,
- don't process it again. */
- if (node && node->declare_variant_alt)
- return base;
- switch (omp_context_selector_matches (TREE_VALUE (TREE_VALUE (attr)),
- false, true))
- {
- case 0:
- /* No match, ignore. */
- break;
- case -1:
- /* Needs to be deferred. */
- any_deferred = true;
- variants.safe_push (attr);
- defer.safe_push (true);
- break;
- default:
- variants.safe_push (attr);
- defer.safe_push (false);
- break;
- }
- }
- if (variants.length () == 0)
- return base;
-
- if (any_deferred)
- {
- score_wide_int max_score1 = 0;
- score_wide_int max_score2 = 0;
- bool first = true;
- unsigned int i;
- tree attr1, attr2;
- omp_declare_variant_base_entry entry;
- entry.base = cgraph_node::get_create (base);
- entry.node = NULL;
- vec_alloc (entry.variants, variants.length ());
- FOR_EACH_VEC_ELT (variants, i, attr1)
- {
- score_wide_int score1;
- score_wide_int score2;
- bool need_two;
- tree ctx = TREE_VALUE (TREE_VALUE (attr1));
- need_two = omp_context_compute_score (ctx, &score1, false);
- if (need_two)
- omp_context_compute_score (ctx, &score2, true);
- else
- score2 = score1;
- if (first)
- {
- first = false;
- max_score1 = score1;
- max_score2 = score2;
- if (!defer[i])
- {
- variant1 = attr1;
- variant2 = attr1;
- }
- }
- else
- {
- if (max_score1 == score1)
- variant1 = NULL_TREE;
- else if (score1 > max_score1)
- {
- max_score1 = score1;
- variant1 = defer[i] ? NULL_TREE : attr1;
- }
- if (max_score2 == score2)
- variant2 = NULL_TREE;
- else if (score2 > max_score2)
- {
- max_score2 = score2;
- variant2 = defer[i] ? NULL_TREE : attr1;
- }
- }
- omp_declare_variant_entry varentry;
- varentry.variant
- = cgraph_node::get_create (TREE_PURPOSE (TREE_VALUE (attr1)));
- varentry.score = score1;
- varentry.score_in_declare_simd_clone = score2;
- varentry.ctx = ctx;
- varentry.matches = !defer[i];
- entry.variants->quick_push (varentry);
- }
-
- /* If there is a clear winner variant with the score which is not
- deferred, verify it is not a strict subset of any other context
- selector and if it is not, it is the best alternative no matter
- whether the others do or don't match. */
- if (variant1 && variant1 == variant2)
- {
- tree ctx1 = TREE_VALUE (TREE_VALUE (variant1));
- FOR_EACH_VEC_ELT (variants, i, attr2)
- {
- if (attr2 == variant1)
- continue;
- tree ctx2 = TREE_VALUE (TREE_VALUE (attr2));
- int r = omp_context_selector_compare (ctx1, ctx2);
- if (r == -1)
- {
- /* The winner is a strict subset of ctx2, can't
- decide now. */
- variant1 = NULL_TREE;
- break;
- }
- }
- if (variant1)
- {
- vec_free (entry.variants);
- return TREE_PURPOSE (TREE_VALUE (variant1));
- }
- }
-
- static struct cgraph_node_hook_list *node_removal_hook_holder;
- if (!node_removal_hook_holder)
- node_removal_hook_holder
- = symtab->add_cgraph_removal_hook (omp_declare_variant_remove_hook,
- NULL);
-
- if (omp_declare_variants == NULL)
- omp_declare_variants
- = hash_table<omp_declare_variant_hasher>::create_ggc (64);
- omp_declare_variant_base_entry **slot
- = omp_declare_variants->find_slot (&entry, INSERT);
- if (*slot != NULL)
- {
- vec_free (entry.variants);
- return (*slot)->node->decl;
- }
-
- *slot = ggc_cleared_alloc<omp_declare_variant_base_entry> ();
- (*slot)->base = entry.base;
- (*slot)->node = entry.base;
- (*slot)->variants = entry.variants;
- tree alt = build_decl (DECL_SOURCE_LOCATION (base), FUNCTION_DECL,
- DECL_NAME (base), TREE_TYPE (base));
- DECL_ARTIFICIAL (alt) = 1;
- DECL_IGNORED_P (alt) = 1;
- TREE_STATIC (alt) = 1;
- tree attributes = DECL_ATTRIBUTES (base);
- if (lookup_attribute ("noipa", attributes) == NULL)
- {
- attributes = tree_cons (get_identifier ("noipa"), NULL, attributes);
- if (lookup_attribute ("noinline", attributes) == NULL)
- attributes = tree_cons (get_identifier ("noinline"), NULL,
- attributes);
- if (lookup_attribute ("noclone", attributes) == NULL)
- attributes = tree_cons (get_identifier ("noclone"), NULL,
- attributes);
- if (lookup_attribute ("no_icf", attributes) == NULL)
- attributes = tree_cons (get_identifier ("no_icf"), NULL,
- attributes);
- }
- DECL_ATTRIBUTES (alt) = attributes;
- DECL_INITIAL (alt) = error_mark_node;
- (*slot)->node = cgraph_node::create (alt);
- (*slot)->node->declare_variant_alt = 1;
- (*slot)->node->create_reference (entry.base, IPA_REF_ADDR);
- omp_declare_variant_entry *varentry;
- FOR_EACH_VEC_SAFE_ELT (entry.variants, i, varentry)
- (*slot)->node->create_reference (varentry->variant, IPA_REF_ADDR);
- if (omp_declare_variant_alt == NULL)
- omp_declare_variant_alt
- = hash_table<omp_declare_variant_alt_hasher>::create_ggc (64);
- *omp_declare_variant_alt->find_slot_with_hash (*slot, DECL_UID (alt),
- INSERT) = *slot;
- return alt;
- }
-
- if (variants.length () == 1)
- return TREE_PURPOSE (TREE_VALUE (variants[0]));
-
- /* A context selector that is a strict subset of another context selector
- has a score of zero. */
- tree attr1, attr2;
- unsigned int i, j;
- FOR_EACH_VEC_ELT (variants, i, attr1)
- if (attr1)
- {
- tree ctx1 = TREE_VALUE (TREE_VALUE (attr1));
- FOR_EACH_VEC_ELT_FROM (variants, j, attr2, i + 1)
- if (attr2)
- {
- tree ctx2 = TREE_VALUE (TREE_VALUE (attr2));
- int r = omp_context_selector_compare (ctx1, ctx2);
- if (r == -1)
- {
- /* ctx1 is a strict subset of ctx2, remove
- attr1 from the vector. */
- variants[i] = NULL_TREE;
- break;
- }
- else if (r == 1)
- /* ctx2 is a strict subset of ctx1, remove attr2
- from the vector. */
- variants[j] = NULL_TREE;
- }
- }
- score_wide_int max_score1 = 0;
- score_wide_int max_score2 = 0;
- bool first = true;
- FOR_EACH_VEC_ELT (variants, i, attr1)
- if (attr1)
- {
- if (variant1)
- {
- score_wide_int score1;
- score_wide_int score2;
- bool need_two;
- tree ctx;
- if (first)
- {
- first = false;
- ctx = TREE_VALUE (TREE_VALUE (variant1));
- need_two = omp_context_compute_score (ctx, &max_score1, false);
- if (need_two)
- omp_context_compute_score (ctx, &max_score2, true);
- else
- max_score2 = max_score1;
- }
- ctx = TREE_VALUE (TREE_VALUE (attr1));
- need_two = omp_context_compute_score (ctx, &score1, false);
- if (need_two)
- omp_context_compute_score (ctx, &score2, true);
- else
- score2 = score1;
- if (score1 > max_score1)
- {
- max_score1 = score1;
- variant1 = attr1;
- }
- if (score2 > max_score2)
- {
- max_score2 = score2;
- variant2 = attr1;
- }
- }
- else
- {
- variant1 = attr1;
- variant2 = attr1;
- }
- }
- /* If there is a disagreement on which variant has the highest score
- depending on whether it will be in a declare simd clone or not,
- punt for now and defer until after IPA where we will know that. */
- return ((variant1 && variant1 == variant2)
- ? TREE_PURPOSE (TREE_VALUE (variant1)) : base);
-}
-
void
omp_lto_output_declare_variant_alt (lto_simple_output_block *ob,
cgraph_node *node,
@@ -3059,16 +2853,36 @@ sort_variant (const void * a, const void *b, void *)
}
/* Return a vector of dynamic replacement candidates for the directive
- candidates in ALL_VARIANTS. Return an empty vector if the metadirective
+ candidates in ALL_VARIANTS. Return an empty vector if the candidates
cannot be resolved. */
-static vec<struct omp_variant>
+vec<struct omp_variant>
omp_get_dynamic_candidates (vec <struct omp_variant> &all_variants,
- bool delay_p)
+ tree construct_context)
{
auto_vec <struct omp_variant> variants;
struct omp_variant default_variant;
bool default_found = false;
+ bool complete_p;
+
+ construct_context
+ = omp_complete_construct_context (construct_context, &complete_p);
+
+ if (dump_file)
+ {
+ fprintf (dump_file, "\nIn omp_get_dynamic_candidates:\n");
+ if (symtab->state == PARSING)
+ fprintf (dump_file, "invoked during parsing\n");
+ else if (cfun && (cfun->curr_properties & PROP_gimple_any) == 0)
+ fprintf (dump_file, "invoked during gimplification\n");
+ else if (cfun && (cfun->curr_properties & PROP_gimple_any) != 0)
+ fprintf (dump_file, "invoked during late resolution\n");
+ else
+ fprintf (dump_file, "confused about invocation context?!?\n");
+ fprintf (dump_file, "construct_context has %d traits (%s)\n",
+ (construct_context ? list_length (construct_context) : 0),
+ (complete_p ? "complete" : "incomplete"));
+ }
for (unsigned int i = 0; i < all_variants.length (); i++)
{
@@ -3097,19 +2911,24 @@ omp_get_dynamic_candidates (vec <struct omp_variant> &all_variants,
fprintf (dump_file, " as candidate - ");
}
- switch (omp_context_selector_matches (variant.selector, true, delay_p))
+ switch (omp_context_selector_matches (variant.selector,
+ construct_context, complete_p))
{
case -1:
- variant.resolvable_p = false;
+ /* Give up for now. This can only happen during early resolution,
+ prior to or during gimplification. */
if (dump_file)
- fprintf (dump_file, "unresolvable");
- /* FALLTHRU */
+ fprintf (dump_file, "unresolvable\n");
+ gcc_assert (!cfun || (cfun->curr_properties & PROP_gimple_any) == 0);
+ variants.truncate (0);
+ return variants.copy ();
case 1:
- /* TODO: Handle SIMD score?. */
- omp_context_compute_score (variant.selector, &variant.score, false);
+ variant.resolvable_p
+ = omp_context_compute_score (variant.selector, construct_context,
+ complete_p, &variant.score);
variant.dynamic_selector = omp_dynamic_cond (variant.selector);
variants.safe_push (variant);
- if (dump_file && variant.resolvable_p)
+ if (dump_file)
{
if (variant.dynamic_selector)
fprintf (dump_file, "matched, dynamic");
@@ -3130,6 +2949,21 @@ omp_get_dynamic_candidates (vec <struct omp_variant> &all_variants,
/* There must be one default variant. */
gcc_assert (default_found);
+ /* If there are no matching selectors, return the default. */
+ if (variants.length () == 0)
+ {
+ variants.safe_push (default_variant);
+ return variants.copy ();
+ }
+
+ /* If there is only one matching selector, use it. */
+ if (variants.length () == 1)
+ {
+ if (variants[0].dynamic_selector)
+ variants.safe_push (default_variant);
+ return variants.copy ();
+ }
+
/* A context selector that is a strict subset of another context selector
has a score of zero. */
for (unsigned int i = 0; i < variants.length (); i++)
@@ -3155,14 +2989,80 @@ omp_get_dynamic_candidates (vec <struct omp_variant> &all_variants,
/* Add the default as a final choice. */
variants.safe_push (default_variant);
+ if (dump_file)
+ {
+ fprintf (dump_file, "Sorted variants are:\n");
+ for (unsigned i = 0; i < variants.length (); i++)
+ {
+ HOST_WIDE_INT score = variants[i].score.to_shwi ();
+ fprintf (dump_file, "score %d ", (int)score);
+ if (variants[i].selector)
+ {
+ fprintf (dump_file, "selector ");
+ print_omp_context_selector (dump_file, variants[i].selector,
+ TDF_NONE);
+ fprintf (dump_file, "\n");
+ }
+ else
+ fprintf (dump_file, "default selector\n");
+ }
+ }
+
/* Build the dynamic candidate list. */
for (unsigned i = 0; i < variants.length (); i++)
{
- /* If one of the candidates is unresolvable, give up for now. */
+ /* In general, we can't proceed if we can't accurately score any
+ of the selectors, since the sorting may be incorrect. But, since
+ the actual score will never be lower than the guessed value, we
+ can use the variant if it is the first one and either the next
+ one is resolvable or we can make a direct comparison of the
+ isa/arch/kind bits. */
if (!variants[i].resolvable_p)
{
- variants.truncate (0);
- break;
+ bool ok = true;
+ if (i != 0)
+ ok = false;
+ else if (!variants[i+1].resolvable_p)
+ {
+ /* To keep comparisons simple, reject selectors that contain
+ sets other than device, target_device, or construct. */
+ for (tree tss = variants[i].selector;
+ tss && ok; tss = TREE_CHAIN (tss))
+ {
+ enum omp_tss_code code = OMP_TSS_CODE (tss);
+ if (code != OMP_TRAIT_SET_DEVICE
+ && code != OMP_TRAIT_SET_TARGET_DEVICE
+ && code != OMP_TRAIT_SET_CONSTRUCT)
+ ok = false;
+ }
+ for (tree tss = variants[i+1].selector;
+ tss && ok; tss = TREE_CHAIN (tss))
+ {
+ enum omp_tss_code code = OMP_TSS_CODE (tss);
+ if (code != OMP_TRAIT_SET_DEVICE
+ && code != OMP_TRAIT_SET_TARGET_DEVICE
+ && code != OMP_TRAIT_SET_CONSTRUCT)
+ ok = false;
+ }
+ /* Ignore the construct bits of the score. If the isa/arch/kind
+ bits are strictly ordered, we're good to go. Since
+ "the final score is the sum of the values of all specified
+ selectors plus 1", subtract that 1 from both scores before
+ getting rid of the low bits. */
+ if (ok)
+ {
+ size_t l = list_length (construct_context);
+ if ((variants[i].score - 1) >> l
+ <= (variants[i+1].score - 1) >> l)
+ ok = false;
+ }
+ }
+
+ if (!ok)
+ {
+ variants.truncate (0);
+ break;
+ }
}
if (dump_file)
@@ -3192,35 +3092,106 @@ omp_get_dynamic_candidates (vec <struct omp_variant> &all_variants,
return variants.copy ();
}
+/* Two attempts are made to resolve calls to "declare variant" functions:
+ early resolution in the gimplifier, and late resolution in the
+ omp_device_lower pass. If early resolution is not possible, the
+ original function call is gimplified into the same form as metadirective
+ and goes through the same late resolution code as metadirective. */
+
+/* Collect "declare variant" candidates for BASE. CONSTRUCT_CONTEXT
+ is the un-augmented context, or NULL_TREE if that information is not
+ available yet. */
+vec<struct omp_variant>
+omp_declare_variant_candidates (tree base, tree construct_context)
+{
+ auto_vec <struct omp_variant> candidates;
+ bool complete_p;
+ tree augmented_context
+ = omp_complete_construct_context (construct_context, &complete_p);
+
+ /* The variants are stored on (possible multiple) "omp declare variant base"
+ attributes on the base function. */
+ for (tree attr = DECL_ATTRIBUTES (base); attr; attr = TREE_CHAIN (attr))
+ {
+ attr = lookup_attribute ("omp declare variant base", attr);
+ if (attr == NULL_TREE)
+ break;
+
+ tree fndecl = TREE_PURPOSE (TREE_VALUE (attr));
+ tree selector = TREE_VALUE (TREE_VALUE (attr));
+
+ if (TREE_CODE (fndecl) != FUNCTION_DECL)
+ continue;
+
+ /* Ignore this variant if its selector is known not to match. */
+ if (!omp_context_selector_matches (selector, augmented_context,
+ complete_p))
+ continue;
+
+ struct omp_variant candidate;
+ candidate.selector = selector;
+ candidate.dynamic_selector = NULL_TREE;
+ candidate.alternative = fndecl;
+ candidates.safe_push (candidate);
+ }
+
+ /* Add a default that is the base function. */
+ struct omp_variant v;
+ v.selector = NULL_TREE;
+ v.dynamic_selector = NULL_TREE;
+ v.alternative = base;
+ candidates.safe_push (v);
+ return candidates.copy ();
+}
+
+/* Collect metadirective candidates for METADIRECTIVE. CONSTRUCT_CONTEXT
+ is the un-augmented context, or NULL_TREE if that information is not
+ available yet. */
+vec<struct omp_variant>
+omp_metadirective_candidates (tree metadirective, tree construct_context)
+{
+ auto_vec <struct omp_variant> candidates;
+ tree variant = OMP_METADIRECTIVE_VARIANTS (metadirective);
+ bool complete_p;
+ tree augmented_context
+ = omp_complete_construct_context (construct_context, &complete_p);
+
+ gcc_assert (variant);
+ for (; variant; variant = TREE_CHAIN (variant))
+ {
+ tree selector = OMP_METADIRECTIVE_VARIANT_SELECTOR (variant);
+
+ /* Ignore this variant if its selector is known not to match. */
+ if (!omp_context_selector_matches (selector, augmented_context,
+ complete_p))
+ continue;
+
+ struct omp_variant candidate;
+ candidate.selector = selector;
+ candidate.dynamic_selector = NULL_TREE;
+ candidate.alternative = OMP_METADIRECTIVE_VARIANT_DIRECTIVE (variant);
+ candidate.body = OMP_METADIRECTIVE_VARIANT_BODY (variant);
+ candidates.safe_push (candidate);
+ }
+ return candidates.copy ();
+}
+
/* Return a vector of dynamic replacement candidates for the metadirective
statement in METADIRECTIVE. Return an empty vector if the metadirective
- cannot be resolved. */
+ cannot be resolved. This function is intended to be called from the
+ front ends, prior to gimplification. */
vec<struct omp_variant>
omp_early_resolve_metadirective (tree metadirective)
{
- auto_vec <struct omp_variant> candidates;
- tree variant = OMP_METADIRECTIVE_VARIANTS (metadirective);
-
- gcc_assert (variant);
- while (variant)
- {
- struct omp_variant candidate;
-
- candidate.selector = OMP_METADIRECTIVE_VARIANT_SELECTOR (variant);
- candidate.alternative = OMP_METADIRECTIVE_VARIANT_DIRECTIVE (variant);
- candidate.body = OMP_METADIRECTIVE_VARIANT_BODY (variant);
-
- candidates.safe_push (candidate);
- variant = TREE_CHAIN (variant);
- }
-
- return omp_get_dynamic_candidates (candidates, true);
+ vec <struct omp_variant> candidates
+ = omp_metadirective_candidates (metadirective, NULL_TREE);
+ return omp_get_dynamic_candidates (candidates, NULL_TREE);
}
/* Return a vector of dynamic replacement candidates for the metadirective
- Gimple statement in GS. Return an empty vector if the metadirective
- cannot be resolved. */
+ Gimple statement in GS. This version is called during late resolution
+ in the ompdevlow pass. */
vec<struct omp_variant>
omp_late_resolve_metadirective (gimple *gs)
@@ -3232,12 +3203,14 @@ omp_late_resolve_metadirective (gimple *gs)
struct omp_variant variant;
variant.selector = gimple_op (gs, i);
+ variant.dynamic_selector = NULL_TREE;
variant.alternative = gimple_omp_metadirective_label (gs, i);
variants.safe_push (variant);
}
- return omp_get_dynamic_candidates (variants, false);
+ tree construct_context = gimple_omp_metadirective_context (gs);
+ return omp_get_dynamic_candidates (variants, construct_context);
}
/* Encode an oacc launch argument. This matches the GOMP_LAUNCH_PACK
diff --git a/gcc/omp-general.h b/gcc/omp-general.h
index b3e9efb93db..318ed477233 100644
--- a/gcc/omp-general.h
+++ b/gcc/omp-general.h
@@ -95,16 +95,27 @@ struct omp_for_data
desirable to be the same on all targets. */
typedef generic_wide_int <fixed_wide_int_storage <1024> > score_wide_int;
-/* A structure describing a variant in a metadirective. */
-
+/* A structure describing a variant alternative in a metadirective or
+ variant function, used for matching and scoring during resolution. */
struct GTY(()) omp_variant
{
- score_wide_int score;
+ /* Context selector. This is NULL_TREE for the default. */
tree selector;
+ /* For early resolution of "metadirective", contains the nested directive.
+ For early resolution of "declare variant", contains the function decl
+ for this alternative. For late resolution of both, contains the label
+ that is the branch target for this alternative. */
tree alternative;
+ /* Common body, used for metadirective. */
tree body;
+ /* If the selector is dynamic, this is the dynamic part; otherwise
+ NULL_TREE. Filled in during resolution. */
tree dynamic_selector;
+ /* A selector can match but not be resolvable due to its score not
+ being computable yet. */
bool resolvable_p : 1;
+ /* The score, if resolvable_p is true. */
+ score_wide_int score;
};
#define OACC_FN_ATTRIB "oacc function"
@@ -190,17 +201,18 @@ extern tree find_combined_omp_for (tree *, int *, void *);
extern poly_uint64 omp_max_vf (void);
extern int omp_max_simt_vf (void);
extern const char *omp_context_name_list_prop (tree);
-extern void omp_construct_traits_to_codes (tree, int, enum tree_code *);
extern tree omp_check_context_selector (location_t loc, tree ctx,
bool metadirective_p);
extern void omp_mark_declare_variant (location_t loc, tree variant,
tree construct);
-extern int omp_context_selector_matches (tree, bool, bool);
-extern int omp_context_selector_set_compare (enum omp_tss_code, tree, tree);
+extern int omp_context_selector_matches (tree, tree, bool);
extern tree omp_get_context_selector (tree, enum omp_tss_code,
enum omp_ts_code);
extern tree omp_get_context_selector_list (tree, enum omp_tss_code);
-extern tree omp_resolve_declare_variant (tree);
+extern vec<struct omp_variant> omp_declare_variant_candidates (tree, tree);
+extern vec<struct omp_variant> omp_metadirective_candidates (tree, tree);
+extern vec<struct omp_variant>
+omp_get_dynamic_candidates (vec<struct omp_variant>&, tree);
extern vec<struct omp_variant> omp_early_resolve_metadirective (tree);
extern vec<struct omp_variant> omp_late_resolve_metadirective (gimple *);
extern tree oacc_launch_pack (unsigned code, tree device, unsigned op);
diff --git a/gcc/omp-offload.cc b/gcc/omp-offload.cc
index bbfc6beff87..c093440bc09 100644
--- a/gcc/omp-offload.cc
+++ b/gcc/omp-offload.cc
@@ -2736,16 +2736,8 @@ execute_omp_device_lower ()
continue;
if (!gimple_call_internal_p (stmt))
{
- if (calls_declare_variant_alt)
- if (tree fndecl = gimple_call_fndecl (stmt))
- {
- tree new_fndecl = omp_resolve_declare_variant (fndecl);
- if (new_fndecl != fndecl)
- {
- gimple_call_set_fndecl (stmt, new_fndecl);
- update_stmt (stmt);
- }
- }
+ /* FIXME: this is a leftover of obsolete code. */
+ gcc_assert (!calls_declare_variant_alt);
#ifdef ACCEL_COMPILER
if (omp_redirect_indirect_calls
&& gimple_call_fndecl (stmt) == NULL_TREE)
diff --git a/gcc/testsuite/c-c++-common/gomp/declare-variant-12.c b/gcc/testsuite/c-c++-common/gomp/declare-variant-12.c
index 3515d9ae44e..f9150773b0e 100644
--- a/gcc/testsuite/c-c++-common/gomp/declare-variant-12.c
+++ b/gcc/testsuite/c-c++-common/gomp/declare-variant-12.c
@@ -29,29 +29,29 @@ void f13 (void);
void f14 (void);
void f15 (void);
void f16 (void);
-#pragma omp declare variant (f14) match (construct={teams,parallel,for}) /* 16+8+4 */
-#pragma omp declare variant (f15) match (construct={parallel},user={condition(score(19):1)}) /* 8+19 */
-#pragma omp declare variant (f16) match (implementation={atomic_default_mem_order(score(27):seq_cst)})
+#pragma omp declare variant (f14) match (construct={teams,parallel,for}) /* 1+8+16 */
+#pragma omp declare variant (f15) match (construct={parallel},user={condition(score(16):1)}) /* 8+16 */
+#pragma omp declare variant (f16) match (implementation={atomic_default_mem_order(score(24):seq_cst)})
void f17 (void);
void f18 (void);
void f19 (void);
void f20 (void);
-#pragma omp declare variant (f18) match (construct={teams,parallel,for}) /* 16+8+4 */
+#pragma omp declare variant (f18) match (construct={teams,parallel,for}) /* 1+8+6 */
#pragma omp declare variant (f19) match (construct={for},user={condition(score(25):1)}) /* 4+25 */
#pragma omp declare variant (f20) match (implementation={atomic_default_mem_order(score(28):seq_cst)})
void f21 (void);
void f22 (void);
void f23 (void);
void f24 (void);
-#pragma omp declare variant (f22) match (construct={parallel,for}) /* 2+1 */
+#pragma omp declare variant (f22) match (construct={parallel,for}) /* 8+16 */
#pragma omp declare variant (f23) match (construct={for}) /* 0 */
#pragma omp declare variant (f24) match (implementation={atomic_default_mem_order(score(2):seq_cst)})
void f25 (void);
void f26 (void);
void f27 (void);
void f28 (void);
-#pragma omp declare variant (f26) match (construct={parallel,for}) /* 2+1 */
-#pragma omp declare variant (f27) match (construct={for},user={condition(1)}) /* 4 */
+#pragma omp declare variant (f26) match (construct={parallel,for}) /* 8+16 */
+#pragma omp declare variant (f27) match (construct={for},user={condition(score(25):1)}) /* 16 + 25 */
#pragma omp declare variant (f28) match (implementation={atomic_default_mem_order(score(3):seq_cst)})
void f29 (void);
diff --git a/gcc/testsuite/c-c++-common/gomp/declare-variant-13.c b/gcc/testsuite/c-c++-common/gomp/declare-variant-13.c
index 68e6a897950..7d386ecea5c 100644
--- a/gcc/testsuite/c-c++-common/gomp/declare-variant-13.c
+++ b/gcc/testsuite/c-c++-common/gomp/declare-variant-13.c
@@ -1,5 +1,5 @@
/* { dg-do compile { target vect_simd_clones } } */
-/* { dg-additional-options "-fdump-tree-gimple" } */
+/* { dg-additional-options "-fdump-tree-ompdevlow" } */
/* { dg-additional-options "-mno-sse3" { target { i?86-*-* x86_64-*-* } } } */
int f01 (int);
@@ -20,5 +20,7 @@ test1 (int x)
isa has score 2^2 or 2^3. We can't decide on whether avx512f will match or
not, that also depends on whether it is a declare simd clone or not and which
one, but the f03 variant has a higher score anyway. */
- return f05 (x); /* { dg-final { scan-tree-dump-times "f03 \\\(x" 1 "gimple" } } */
+ return f05 (x);
+ /* { dg-final { scan-tree-dump "f03 \\\(x" "ompdevlow" } } */
+ /* { dg-final { scan-tree-dump-not "f05 \\\(x" "ompdevlow" } } */
}
diff --git a/gcc/testsuite/c-c++-common/gomp/declare-variant-2.c b/gcc/testsuite/c-c++-common/gomp/declare-variant-2.c
index 05e485ef6a8..43657486c99 100644
--- a/gcc/testsuite/c-c++-common/gomp/declare-variant-2.c
+++ b/gcc/testsuite/c-c++-common/gomp/declare-variant-2.c
@@ -38,8 +38,8 @@ void f18 (void);
void f19 (void);
#pragma omp declare variant (f1) match(user={condition()}) /* { dg-error "expected \[^\n\r]*expression before '\\)' token" } */
void f20 (void);
-#pragma omp declare variant (f1) match(user={condition(f1)}) /* { dg-error "property must be constant integer expression" "" { target { c || c++11 } } } */
-void f21 (void); /* { dg-error "cannot appear in a constant-expression" "" { target c++98_only } .-1 } */
+#pragma omp declare variant (f1) match(user={condition(f1)}) /* { dg-error "property must be integer expression" } */
+void f21 (void);
#pragma omp declare variant (f1) match(user={condition(1, 2, 3)}) /* { dg-error "expected '\\)' before ',' token" } */
void f22 (void);
#pragma omp declare variant (f1) match(construct={master}) /* { dg-warning "unknown selector 'master' for context selector set 'construct'" } */
diff --git a/gcc/testsuite/c-c++-common/gomp/declare-variant-arg-exprs.c b/gcc/testsuite/c-c++-common/gomp/declare-variant-arg-exprs.c
new file mode 100644
index 00000000000..38bfe928c74
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/gomp/declare-variant-arg-exprs.c
@@ -0,0 +1,29 @@
+/* { dg-do compile } */
+/* { dg-additional-options "-foffload=disable" } */
+/* { dg-additional-options "-mavx512bw -mavx512vl" { target { i?86-*-* x86_64-*-* } } } */
+
+/* References to function parameters in dynamic selector expressions for
+ "declare variant" isn't supported yet; see PR 113904. Check to see that
+ a proper error is diagnosed meanwhile and GCC doesn't just wander off
+ into the weeds and ICE. */
+
+extern int frob (int);
+
+void f01 (int, int);
+void f02 (int, int);
+void f03 (int, int);
+#pragma omp declare variant (f01) match (target_device={device_num (devnum), isa("avx512f","avx512vl")}) /* { dg-message "sorry, unimplemented: reference to function parameter" } */
+#pragma omp declare variant (f02) match (implementation={vendor(score(15):gnu)})
+#pragma omp declare variant (f03) match (user={condition(score(11):frob (ok + 42))}) /* { dg-message "sorry, unimplemented: reference to function parameter" } */
+void f04 (int devnum, int ok);
+
+void
+test1 (void)
+{
+ int i;
+ #pragma omp parallel for
+ for (i = 0; i < 1; i++)
+ f04 (17, 1);
+}
+
+
diff --git a/gcc/testsuite/c-c++-common/gomp/declare-variant-dynamic-1.c b/gcc/testsuite/c-c++-common/gomp/declare-variant-dynamic-1.c
new file mode 100644
index 00000000000..b406a31eb30
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/gomp/declare-variant-dynamic-1.c
@@ -0,0 +1,26 @@
+/* { dg-do compile } */
+/* { dg-additional-options "-fdump-tree-gimple" } */
+
+extern int foo_p (int);
+extern int bar;
+
+int f01 (int);
+int f02 (int);
+int f03 (int);
+int f04 (int);
+#pragma omp declare variant (f01) match (device={isa("avx512f")}) /* 4 */
+#pragma omp declare variant (f02) match (implementation={vendor(score(3):gnu)},device={kind(cpu)}) /* 1 + 3 */
+#pragma omp declare variant (f03) match (user={condition(score(9):foo_p (bar))})
+#pragma omp declare variant (f04) match (implementation={vendor(score(6):gnu)},device={kind(host)}) /* 1 + 6 */
+int f05 (int);
+
+
+int
+test1 (int x)
+{
+ return f05 (x);
+}
+
+/* { dg-final { scan-tree-dump "f03 \\\(x" "gimple" } } */
+/* { dg-final { scan-tree-dump "f04 \\\(x" "gimple" } } */
+/* { dg-final { scan-tree-dump-not "f05 \\\(x" "gimple" } } */
diff --git a/gcc/testsuite/c-c++-common/gomp/declare-variant-dynamic-2.c b/gcc/testsuite/c-c++-common/gomp/declare-variant-dynamic-2.c
new file mode 100644
index 00000000000..c078123e2e6
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/gomp/declare-variant-dynamic-2.c
@@ -0,0 +1,30 @@
+/* { dg-do compile } */
+/* { dg-additional-options "-fdump-tree-gimple" } */
+
+extern int foo_p (int);
+extern int bar;
+extern int omp_get_default_device (void);
+
+int f01 (int);
+int f02 (int);
+int f03 (int);
+int f04 (int);
+#pragma omp declare variant (f01) match (target_device={device_num(omp_get_default_device()), isa("avx512f")}) /* 4 */
+#pragma omp declare variant (f02) match (user={condition(score(6):0)})
+#pragma omp declare variant (f03) match (user={condition(score(5):foo_p (bar))})
+#pragma omp declare variant (f04) match (user={condition(score(3):0)})
+int f05 (int);
+
+int
+test1 (int x)
+{
+ return f05 (x);
+}
+
+/* f01 and f03 are the dynamic selectors, the fall-through is f05.
+ f02 and f04 are static selectors and do not match. */
+/* { dg-final { scan-tree-dump "f01 \\\(x" "gimple" } } */
+/* { dg-final { scan-tree-dump "f03 \\\(x" "gimple" } } */
+/* { dg-final { scan-tree-dump "f05 \\\(x" "gimple" } } */
+/* { dg-final { scan-tree-dump-not "f02 \\\(x" "gimple" } } */
+/* { dg-final { scan-tree-dump-not "f04 \\\(x" "gimple" } } */
diff --git a/gcc/testsuite/c-c++-common/gomp/metadirective-3.c b/gcc/testsuite/c-c++-common/gomp/metadirective-3.c
index 7a2818dd710..f7258ffb5f7 100644
--- a/gcc/testsuite/c-c++-common/gomp/metadirective-3.c
+++ b/gcc/testsuite/c-c++-common/gomp/metadirective-3.c
@@ -1,7 +1,5 @@
/* { dg-do compile } */
-/* { dg-additional-options "-fdump-tree-original" } */
/* { dg-additional-options "-fdump-tree-gimple" } */
-/* { dg-additional-options "-fdump-tree-optimized" } */
#define N 100
@@ -17,15 +15,7 @@ void f (int x[], int y[], int z[])
z[i] = x[i] * y[i];
}
-/* The metadirective should be resolved after Gimplification. */
-
-/* { dg-final { scan-tree-dump-times "#pragma omp metadirective" 1 "original" } } */
-/* { dg-final { scan-tree-dump-times "when \\(device = .*arch.*nvptx.*\\):" 1 "original" } } */
-/* { dg-final { scan-tree-dump-times "#pragma omp teams" 1 "original" } } */
-/* { dg-final { scan-tree-dump-times "default:" 1 "original" } } */
-/* { dg-final { scan-tree-dump-times "#pragma omp parallel" 1 "original" } } */
-/* { dg-final { scan-tree-dump-times "#pragma omp loop" 2 "original" } } */
-
-/* { dg-final { scan-tree-dump-times "#pragma omp metadirective" 1 "gimple" } } */
-
-/* { dg-final { scan-tree-dump-not "#pragma omp metadirective" "optimized" } } */
+/* If offload device "nvptx" isn't supported, the front end can eliminate
+ that alternative and not produce a metadirective at all. Otherwise this
+ is supposed to be resolvable during gimplification. */
+/* { dg-final { scan-tree-dump-not "#pragma omp metadirective" "gimple" } } */
diff --git a/gcc/testsuite/g++.dg/gomp/attrs-metadirective-3.C b/gcc/testsuite/g++.dg/gomp/attrs-metadirective-3.C
index 0c2bbdd2f10..d9b6d3cc0e4 100644
--- a/gcc/testsuite/g++.dg/gomp/attrs-metadirective-3.C
+++ b/gcc/testsuite/g++.dg/gomp/attrs-metadirective-3.C
@@ -1,7 +1,5 @@
// { dg-do compile { target c++11 } }
-/* { dg-additional-options "-fdump-tree-original" } */
/* { dg-additional-options "-fdump-tree-gimple" } */
-/* { dg-additional-options "-fdump-tree-optimized" } */
#define N 100
@@ -18,14 +16,4 @@ void f (int x[], int y[], int z[])
}
/* The metadirective should be resolved after Gimplification. */
-
-/* { dg-final { scan-tree-dump-times "#pragma omp metadirective" 1 "original" } } */
-/* { dg-final { scan-tree-dump-times "when \\(device = .*arch.*nvptx.*\\):" 1 "original" } } */
-/* { dg-final { scan-tree-dump-times "#pragma omp teams" 1 "original" } } */
-/* { dg-final { scan-tree-dump-times "default:" 1 "original" } } */
-/* { dg-final { scan-tree-dump-times "#pragma omp parallel" 1 "original" } } */
-/* { dg-final { scan-tree-dump-times "#pragma omp loop" 2 "original" } } */
-
-/* { dg-final { scan-tree-dump-times "#pragma omp metadirective" 1 "gimple" } } */
-
-/* { dg-final { scan-tree-dump-not "#pragma omp metadirective" "optimized" } } */
+/* { dg-final { scan-tree-dump-not "#pragma omp metadirective" "gimple" } } */
diff --git a/gcc/testsuite/g++.dg/gomp/declare-variant-class-1.C b/gcc/testsuite/g++.dg/gomp/declare-variant-class-1.C
new file mode 100644
index 00000000000..35b25de860f
--- /dev/null
+++ b/gcc/testsuite/g++.dg/gomp/declare-variant-class-1.C
@@ -0,0 +1,32 @@
+/* { dg-do compile } */
+/* { dg-additional-options "-foffload=disable" } */
+/* { dg-additional-options "-mavx512bw -mavx512vl" { target { i?86-*-* x86_64-*-* } } } */
+
+/* References to function parameters in dynamic selector expressions for
+ "declare variant" isn't supported yet; see PR 113904. Check to see that
+ a proper error is diagnosed meanwhile and GCC doesn't just wander off
+ into the weeds and ICE. */
+
+extern int frob (int);
+
+class junk
+{
+ public:
+ int data;
+ static void f01 (int, int);
+ static void f02 (int, int);
+ static void f03 (int, int);
+#pragma omp declare variant (f01) match (target_device={device_num (devnum), isa("avx512f","avx512vl")}) /* { dg-message "sorry, unimplemented: reference to function parameter" } */
+#pragma omp declare variant (f02) match (implementation={vendor(score(15):gnu)})
+#pragma omp declare variant (f03) match (user={condition(score(11):frob (ok + 42))}) /* { dg-message "sorry, unimplemented: reference to function parameter" } */
+ static void f04 (int devnum, int ok);
+};
+
+void
+test1 (void)
+{
+ int i;
+ #pragma omp parallel for
+ for (i = 0; i < 1; i++)
+ junk::f04 (17, 1);
+}
diff --git a/gcc/testsuite/g++.dg/gomp/declare-variant-class-2.C b/gcc/testsuite/g++.dg/gomp/declare-variant-class-2.C
new file mode 100644
index 00000000000..b30243f70c6
--- /dev/null
+++ b/gcc/testsuite/g++.dg/gomp/declare-variant-class-2.C
@@ -0,0 +1,37 @@
+/* { dg-do compile } */
+/* { dg-additional-options "-foffload=disable" } */
+/* { dg-additional-options "-mavx512bw -mavx512vl" { target { i?86-*-* x86_64-*-* } } } */
+
+/* References to function parameters in dynamic selector expressions for
+ "declare variant" isn't supported yet; see PR 113904. Check to see that
+ a proper error is diagnosed meanwhile and GCC doesn't just wander off
+ into the weeds and ICE. */
+
+extern int frob (int);
+extern int frobmore (class junk *);
+
+class junk
+{
+ public:
+ int data;
+ void f01 (int, int);
+ void f02 (int, int);
+ void f03 (int, int);
+ void f04 (int, int);
+ void f05 (int, int);
+#pragma omp declare variant (f01) match (target_device={device_num (devnum), isa("avx512f","avx512vl")}) /* { dg-message "sorry, unimplemented: reference to function parameter" } */
+#pragma omp declare variant (f02) match (implementation={vendor(score(15):gnu)})
+#pragma omp declare variant (f03) match (user={condition(score(11):frob (ok + 42))}) /* { dg-message "sorry, unimplemented: reference to function parameter" } */
+#pragma omp declare variant (f04) match (user={condition(score(11):data)}) /* { dg-message "sorry, unimplemented: reference to function parameter" } */
+#pragma omp declare variant (f05) match (user={condition(score(11):frobmore (this))}) /* { dg-message "sorry, unimplemented: reference to function parameter" } */
+ void f06 (int devnum, int ok);
+};
+
+void
+test1 (junk *j)
+{
+ int i;
+ #pragma omp parallel for
+ for (i = 0; i < 1; i++)
+ j->f06 (17, 1);
+}
diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-variant-12.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-variant-12.f90
index f1b4a2280ec..dd8d7c24d00 100644
--- a/gcc/testsuite/gfortran.dg/gomp/declare-variant-12.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/declare-variant-12.f90
@@ -64,9 +64,9 @@ contains
end subroutine
subroutine f17 ()
- !$omp declare variant (f14) match (construct={teams,parallel,do}) ! 16+8+4
- !$omp declare variant (f15) match (construct={parallel},user={condition(score(19):.true.)}) ! 8+19
- !$omp declare variant (f16) match (implementation={atomic_default_mem_order(score(27):seq_cst)})
+ !$omp declare variant (f14) match (construct={teams,parallel,do}) ! 1+8+16
+ !$omp declare variant (f15) match (construct={parallel},user={condition(score(16):.true.)}) ! 8+16
+ !$omp declare variant (f16) match (implementation={atomic_default_mem_order(score(24):seq_cst)})
end subroutine
subroutine f18 ()
@@ -79,7 +79,7 @@ contains
end subroutine
subroutine f21 ()
- !$omp declare variant (f18) match (construct={teams,parallel,do}) ! 16+8+4
+ !$omp declare variant (f18) match (construct={teams,parallel,do}) ! 1+8+16
!$omp declare variant (f19) match (construct={do},user={condition(score(25):.true.)}) ! 4+25
!$omp declare variant (f20) match (implementation={atomic_default_mem_order(score(28):seq_cst)})
end subroutine
@@ -94,7 +94,7 @@ contains
end subroutine
subroutine f25 ()
- !$omp declare variant (f22) match (construct={parallel,do}) ! 2+1
+ !$omp declare variant (f22) match (construct={parallel,do}) ! 8+16
!$omp declare variant (f23) match (construct={do}) ! 0
!$omp declare variant (f24) match (implementation={atomic_default_mem_order(score(2):seq_cst)})
end subroutine
@@ -109,8 +109,8 @@ contains
end subroutine
subroutine f29 ()
- !$omp declare variant (f26) match (construct={parallel,do}) ! 2+1
- !$omp declare variant (f27) match (construct={do},user={condition(.true.)}) ! 4
+ !$omp declare variant (f26) match (construct={parallel,do}) ! 8+16
+ !$omp declare variant (f27) match (construct={do},user={condition(score(25):.true.)}) ! 16+25
!$omp declare variant (f28) match (implementation={atomic_default_mem_order(score(3):seq_cst)})
end subroutine
diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-variant-13.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-variant-13.f90
index 97484a63d0b..870aeb2dad9 100644
--- a/gcc/testsuite/gfortran.dg/gomp/declare-variant-13.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/declare-variant-13.f90
@@ -1,28 +1,27 @@
! { dg-do compile { target vect_simd_clones } }
-! { dg-additional-options "-fdump-tree-gimple" }
+! { dg-additional-options "-O0 -fdump-tree-ompdevlow" }
! { dg-additional-options "-mno-sse3" { target { i?86-*-* x86_64-*-* } } }
-program main
- implicit none
+module foo
contains
integer function f01 (x)
integer, intent(in) :: x
- f01 = x
+ f01 = x + 1
end function
integer function f02 (x)
integer, intent(in) :: x
- f02 = x
+ f02 = x + 2
end function
integer function f03 (x)
integer, intent(in) :: x
- f03 = x
+ f03 = x + 3
end function
integer function f04 (x)
integer, intent(in) :: x
- f04 = x
+ f04 = x + 4
end function
integer function f05 (x)
@@ -32,9 +31,17 @@ contains
!$omp declare variant (f02) match (implementation={vendor(score(3):gnu)},device={kind(cpu)}) ! (1 or 2) + 3
!$omp declare variant (f03) match (user={condition(score(9):.true.)})
!$omp declare variant (f04) match (implementation={vendor(score(6):gnu)},device={kind(host)}) ! (1 or 2) + 6
- f05 = x
+ f05 = x + 5
end function
+end module
+program main
+ use :: foo
+ implicit none
+
+ if (test1 (42) /= 42 + 3) stop 100
+
+contains
integer function test1 (x)
!$omp declare simd
integer, intent(in) :: x
@@ -43,6 +50,9 @@ contains
! isa has score 2^2 or 2^3. We can't decide on whether avx512f will match or
! not, that also depends on whether it is a declare simd clone or not and which
! one, but the f03 variant has a higher score anyway. */
- test1 = f05 (x) ! { dg-final { scan-tree-dump-times "f03 \\\(x" 1 "gimple" } }
+ test1 = f05 (x)
+ ! { dg-final { scan-tree-dump "f03 \\\(x" "ompdevlow" } }
+ ! { dg-final { scan-tree-dump-not "f05 \\\(x" "ompdevlow" } }
end function
+
end program
diff --git a/gcc/testsuite/gfortran.dg/gomp/metadirective-1.f90 b/gcc/testsuite/gfortran.dg/gomp/metadirective-1.f90
index c5b3946341d..1de5bc8a3a4 100644
--- a/gcc/testsuite/gfortran.dg/gomp/metadirective-1.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/metadirective-1.f90
@@ -44,8 +44,26 @@ program main
do i = 1, N
c(i) = a(i) * b(i)
end do
-
- !$omp begin metadirective &
+
+ !$omp metadirective &
+ !$omp& default (teams loop) &
+ !$omp& when (device={arch("nvptx")} parallel loop) ! { dg-error "expected .:." }
+ do i = 1, N
+ c(i) = a(i) * b(i)
+ end do
+
+ ! Test improperly nested metadirectives - even though the second
+ ! metadirective resolves to 'omp nothing', that is not the same as there
+ ! being literally nothing there.
+ !$omp metadirective &
+ !$omp& when (implementation={vendor("gnu")}: parallel do)
+ !$omp metadirective &
+ !$omp& when (implementation={vendor("cray")}: parallel do) ! { dg-error "Unexpected !.OMP METADIRECTIVE statement" }
+ do i = 1, N
+ c(i) = a(i) * b(i)
+ end do
+
+!$omp begin metadirective &
!$omp& when (device={arch("nvptx")}: parallel do) &
!$omp& default (barrier) ! { dg-error "variant directive used in OMP BEGIN METADIRECTIVE at .1. must have a corresponding end directive" }
do i = 1, N
diff --git a/gcc/testsuite/gfortran.dg/gomp/metadirective-3.f90 b/gcc/testsuite/gfortran.dg/gomp/metadirective-3.f90
index eca389a7842..5f5235cc887 100644
--- a/gcc/testsuite/gfortran.dg/gomp/metadirective-3.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/metadirective-3.f90
@@ -1,7 +1,5 @@
! { dg-do compile }
-! { dg-additional-options "-fdump-tree-original" }
! { dg-additional-options "-fdump-tree-gimple" }
-! { dg-additional-options "-fdump-tree-optimized" }
module test
integer, parameter :: N = 100
@@ -20,15 +18,7 @@ contains
end subroutine
end module
-! The metadirective should be resolved after Gimplification.
-
-! { dg-final { scan-tree-dump-times "#pragma omp metadirective" 1 "original" } }
-! { dg-final { scan-tree-dump-times "when \\(device =.*arch.*nvptx.*\\):" 1 "original" } }
-! { dg-final { scan-tree-dump-times "#pragma omp teams" 1 "original" } }
-! { dg-final { scan-tree-dump-times "default:" 1 "original" } }
-! { dg-final { scan-tree-dump-times "#pragma omp parallel" 1 "original" } }
-! { dg-final { scan-tree-dump-times "#pragma omp loop" 2 "original" } }
-
-! { dg-final { scan-tree-dump-times "#pragma omp metadirective" 1 "gimple" } }
-
-! { dg-final { scan-tree-dump-not "#pragma omp metadirective" "optimized" } }
+! If offload device "nvptx" isn't supported, the front end can eliminate
+! that alternative and not produce a metadirective at all. Otherwise this
+! is supposed to be resolvable during gimplification.
+! { dg-final { scan-tree-dump-not "#pragma omp metadirective" "gimple" } }
diff --git a/gcc/tree-inline.cc b/gcc/tree-inline.cc
index c34d2ce1592..0a3ad616d84 100644
--- a/gcc/tree-inline.cc
+++ b/gcc/tree-inline.cc
@@ -1678,6 +1678,7 @@ remap_gimple_stmt (gimple *stmt, copy_body_data *id)
gimple *first_variant = NULL;
gimple **prev_next = &first_variant;
gimple_seq variant_seq = gimple_omp_variants (stmt);
+ tree context = gimple_omp_metadirective_context (stmt);
for (gimple_stmt_iterator gsi = gsi_start (variant_seq);
!gsi_end_p (gsi); gsi_next (&gsi))
{
@@ -1689,6 +1690,7 @@ remap_gimple_stmt (gimple *stmt, copy_body_data *id)
prev_next = &new_variant->next;
}
gimple_omp_metadirective_set_variants (copy, first_variant);
+ gimple_omp_metadirective_set_context (copy, context);
}
memset (&wi, 0, sizeof (wi));
--
2.25.1
^ permalink raw reply [flat|nested] 13+ messages in thread
* [PATCH 10/12] OpenMP: Remove dead code from declare variant reimplementation
2024-05-04 21:21 [PATCH 00/12] OpenMP: Metadirective support + "declare variant" improvements Sandra Loosemore
` (8 preceding siblings ...)
2024-05-04 21:21 ` [PATCH 09/12] OpenMP: Extend dynamic selector support to declare variant Sandra Loosemore
@ 2024-05-04 21:21 ` Sandra Loosemore
2024-05-04 21:21 ` [PATCH 11/12] OpenMP: Update "declare target"/OpenMP context interaction Sandra Loosemore
2024-05-04 21:21 ` [PATCH 12/12] OpenMP: Update documentation of metadirective implementation status Sandra Loosemore
11 siblings, 0 replies; 13+ messages in thread
From: Sandra Loosemore @ 2024-05-04 21:21 UTC (permalink / raw)
To: gcc-patches; +Cc: jakub, tburnus
After reimplementing late resolution of "declare variant" to use the
same mechanisms as metadirective, the declare_variant_alt and
calls_declare_variant_alt flags on struct cgraph_node are no longer
used by anything. For the purposes of marking functions that need
late resolution, the has_metadirectives flag has replaced
calls_declare_variant_alt.
Likewise struct omp_declare_variant_entry, struct
omp_declare_variant_base_entry, and the hash tables used to store
these structures are no longer needed, since the information needed for
late resolution is now stored in the gomp_metadirective nodes.
There are no functional changes in this patch, just removing dead code.
gcc/ChangeLog
* cgraph.cc (symbol_table::create_edge): Don't set
calls_declare_variant_alt in the caller.
* cgraph.h (struct cgraph_node): Remove declare_variant_alt
and calls_declare_variant_alt flags.
* cgraphclones.cc (cgraph_node::create_clone): Don't copy
calls_declare_variant_alt bit.
* ipa-free-lang-data.cc (free_lang_data_in_decl): Adjust code
referencing declare_variant_alt bit.
* ipa.cc (symbol_table::remove_unreachable_nodes): Likewise.
* lto-cgraph.cc (lto_output_node): Remove references to deleted
bits.
(output_refs): Adjust code referencing declare_variant_alt bit.
(input_overwrite_node): Remove references to deleted bits.
(input_refs): Adjust code referencing declare_variant_alt bit.
* lto-streamer-out.cc (lto_output): Likewise.
* lto-streamer.h (omp_lto_output_declare_variant_alt): Delete.
(omp_lto_input_declare_variant_alt): Delete.
* lto/lto-partition.cc (lto_balanced_map): Adjust code referencing
deleted declare_variant_alt bit.
* omp-expand.cc (expand_omp_target): Use has_metadirectives bit to
trigger pass_omp_device_lower instead of calls_declare_variant_alt.
* omp-general.cc (struct omp_declare_variant_entry): Delete.
(struct omp_declare_variant_base_entry): Delete.
(struct omp_declare_variant_hasher): Delete.
(omp_declare_variant_hasher::hash): Delete.
(omp_declare_variant_hasher::equal): Delete.
(omp_declare_variants): Delete.
(omp_declare_variant_alt_hasher): Delete.
(omp_declare_variant_alt_hasher::hash): Delete.
(omp_declare_variant_alt_hasher::equal): Delete.
(omp_declare_variant_alt): Delete.
(omp_lto_output_declare_variant_alt): Delete.
(omp_lto_input_declare_variant_alt): Delete.
(includes): Delete unnecessary include of gt-omp-general.h.
* omp-offload.cc (execute_omp_device_lower): Remove references
to deleted bit.
(pass_omp_device_lower::gate): Likewise.
* omp-simd-clone.cc (simd_clone_create): Likewise.
* passes.cc (ipa_write_summaries): Likeise.
* symtab.cc (symtab_node::get_partitioning_class): Likewise.
* tree-inline.cc (expand_call_inline): Likewise.
(tree_function_versioning): Likewise.
---
gcc/cgraph.cc | 2 -
gcc/cgraph.h | 11 +-
gcc/cgraphclones.cc | 1 -
gcc/ipa-free-lang-data.cc | 2 +-
gcc/ipa.cc | 3 -
gcc/lto-cgraph.cc | 10 --
gcc/lto-streamer-out.cc | 3 +-
gcc/lto-streamer.h | 6 --
gcc/lto/lto-partition.cc | 5 +-
gcc/omp-expand.cc | 2 +-
gcc/omp-general.cc | 218 --------------------------------------
gcc/omp-offload.cc | 8 +-
gcc/omp-simd-clone.cc | 2 -
gcc/passes.cc | 3 +-
gcc/symtab.cc | 2 +-
gcc/tree-inline.cc | 4 -
16 files changed, 10 insertions(+), 272 deletions(-)
diff --git a/gcc/cgraph.cc b/gcc/cgraph.cc
index 473d8410bc9..103bc2c0332 100644
--- a/gcc/cgraph.cc
+++ b/gcc/cgraph.cc
@@ -931,8 +931,6 @@ symbol_table::create_edge (cgraph_node *caller, cgraph_node *callee,
caller->decl);
else
edge->in_polymorphic_cdtor = caller->thunk;
- if (callee)
- caller->calls_declare_variant_alt |= callee->declare_variant_alt;
if (callee && symtab->state != LTO_STREAMING
&& edge->callee->comdat_local_p ())
diff --git a/gcc/cgraph.h b/gcc/cgraph.h
index 6653ce19c3e..dd210842df7 100644
--- a/gcc/cgraph.h
+++ b/gcc/cgraph.h
@@ -897,10 +897,8 @@ struct GTY((tag ("SYMTAB_FUNCTION"))) cgraph_node : public symtab_node
split_part (false), indirect_call_target (false), local (false),
versionable (false), can_change_signature (false),
redefined_extern_inline (false), tm_may_enter_irr (false),
- ipcp_clone (false), declare_variant_alt (false),
- calls_declare_variant_alt (false), gc_candidate (false),
- called_by_ifunc_resolver (false),
- has_metadirectives (false),
+ ipcp_clone (false), gc_candidate (false),
+ called_by_ifunc_resolver (false), has_metadirectives (false),
m_uid (uid), m_summary_id (-1)
{}
@@ -1491,11 +1489,6 @@ struct GTY((tag ("SYMTAB_FUNCTION"))) cgraph_node : public symtab_node
unsigned tm_may_enter_irr : 1;
/* True if this was a clone created by ipa-cp. */
unsigned ipcp_clone : 1;
- /* True if this is the deferred declare variant resolution artificial
- function. */
- unsigned declare_variant_alt : 1;
- /* True if the function calls declare_variant_alt functions. */
- unsigned calls_declare_variant_alt : 1;
/* True if the function should only be emitted if it is used. This flag
is set for local SIMD clones when they are created and cleared if the
vectorizer uses them. */
diff --git a/gcc/cgraphclones.cc b/gcc/cgraphclones.cc
index e6312b5c0ab..2b16730c10b 100644
--- a/gcc/cgraphclones.cc
+++ b/gcc/cgraphclones.cc
@@ -388,7 +388,6 @@ cgraph_node::create_clone (tree new_decl, profile_count prof_count,
if (!new_inlined_to)
prof_count = count.combine_with_ipa_count (prof_count);
new_node->count = prof_count;
- new_node->calls_declare_variant_alt = this->calls_declare_variant_alt;
new_node->has_metadirectives = this->has_metadirectives;
/* Update IPA profile. Local profiles need no updating in original. */
diff --git a/gcc/ipa-free-lang-data.cc b/gcc/ipa-free-lang-data.cc
index 3ad203fec4c..dc9f1f58e9e 100644
--- a/gcc/ipa-free-lang-data.cc
+++ b/gcc/ipa-free-lang-data.cc
@@ -575,7 +575,7 @@ free_lang_data_in_decl (tree decl, class free_lang_data_d *fld)
if (!(node = cgraph_node::get (decl))
|| (!node->definition && !node->clones))
{
- if (node && !node->declare_variant_alt)
+ if (node)
node->release_body ();
else
{
diff --git a/gcc/ipa.cc b/gcc/ipa.cc
index c453fca5d9b..c2bf8d42407 100644
--- a/gcc/ipa.cc
+++ b/gcc/ipa.cc
@@ -451,9 +451,6 @@ symbol_table::remove_unreachable_nodes (FILE *file)
reachable.add (body);
reachable.add (e->callee);
}
- else if (e->callee->declare_variant_alt
- && !e->callee->in_other_partition)
- reachable.add (e->callee);
enqueue_node (e->callee, &first, &reachable);
}
diff --git a/gcc/lto-cgraph.cc b/gcc/lto-cgraph.cc
index 5bd9916fd2c..a3dc76f219f 100644
--- a/gcc/lto-cgraph.cc
+++ b/gcc/lto-cgraph.cc
@@ -549,8 +549,6 @@ lto_output_node (struct lto_simple_output_block *ob, struct cgraph_node *node,
bp_pack_value (&bp, node->merged_extern_inline, 1);
bp_pack_value (&bp, node->thunk, 1);
bp_pack_value (&bp, node->parallelized_function, 1);
- bp_pack_value (&bp, node->declare_variant_alt, 1);
- bp_pack_value (&bp, node->calls_declare_variant_alt, 1);
bp_pack_value (&bp, node->has_metadirectives, 1);
/* Stream thunk info always because we use it in
@@ -781,9 +779,6 @@ output_refs (lto_symtab_encoder_t encoder)
for (int i = 0; node->iterate_reference (i, ref); i++)
lto_output_ref (ob, ref, encoder);
}
- if (cgraph_node *cnode = dyn_cast <cgraph_node *> (node))
- if (cnode->declare_variant_alt)
- omp_lto_output_declare_variant_alt (ob, cnode, encoder);
}
streamer_write_uhwi_stream (ob->main_stream, 0);
@@ -1251,8 +1246,6 @@ input_overwrite_node (struct lto_file_decl_data *file_data,
node->merged_extern_inline = bp_unpack_value (bp, 1);
node->thunk = bp_unpack_value (bp, 1);
node->parallelized_function = bp_unpack_value (bp, 1);
- node->declare_variant_alt = bp_unpack_value (bp, 1);
- node->calls_declare_variant_alt = bp_unpack_value (bp, 1);
node->has_metadirectives = bp_unpack_value (bp, 1);
*has_thunk_info = bp_unpack_value (bp, 1);
node->resolution = bp_unpack_enum (bp, ld_plugin_symbol_resolution,
@@ -1663,9 +1656,6 @@ input_refs (class lto_input_block *ib,
input_ref (ib, node, nodes);
count--;
}
- if (cgraph_node *cnode = dyn_cast <cgraph_node *> (node))
- if (cnode->declare_variant_alt)
- omp_lto_input_declare_variant_alt (ib, cnode, nodes);
}
}
diff --git a/gcc/lto-streamer-out.cc b/gcc/lto-streamer-out.cc
index d4f728094ed..42456d34823 100644
--- a/gcc/lto-streamer-out.cc
+++ b/gcc/lto-streamer-out.cc
@@ -2815,8 +2815,7 @@ lto_output (void)
&& flag_incremental_link != INCREMENTAL_LINK_LTO)
/* Thunks have no body but they may be synthetized
at WPA time. */
- || DECL_ARGUMENTS (cnode->decl)
- || cnode->declare_variant_alt))
+ || DECL_ARGUMENTS (cnode->decl)))
output_function (cnode);
else if ((vnode = dyn_cast <varpool_node *> (snode))
&& (DECL_INITIAL (vnode->decl) != error_mark_node
diff --git a/gcc/lto-streamer.h b/gcc/lto-streamer.h
index e8dbba471ed..895aa27692b 100644
--- a/gcc/lto-streamer.h
+++ b/gcc/lto-streamer.h
@@ -934,12 +934,6 @@ bool reachable_from_this_partition_p (struct cgraph_node *,
lto_symtab_encoder_t compute_ltrans_boundary (lto_symtab_encoder_t encoder);
void select_what_to_stream (void);
-/* In omp-general.cc. */
-void omp_lto_output_declare_variant_alt (lto_simple_output_block *,
- cgraph_node *, lto_symtab_encoder_t);
-void omp_lto_input_declare_variant_alt (lto_input_block *, cgraph_node *,
- vec<symtab_node *>);
-
/* In options-save.cc. */
void cl_target_option_stream_out (struct output_block *, struct bitpack_d *,
struct cl_target_option *);
diff --git a/gcc/lto/lto-partition.cc b/gcc/lto/lto-partition.cc
index 19f91e5d660..0985631dee0 100644
--- a/gcc/lto/lto-partition.cc
+++ b/gcc/lto/lto-partition.cc
@@ -593,8 +593,7 @@ lto_balanced_map (int n_lto_partitions, int max_partition_size)
last_visited_node++;
- gcc_assert (node->definition || node->weakref
- || node->declare_variant_alt);
+ gcc_assert (node->definition || node->weakref);
/* Compute boundary cost of callgraph edges. */
for (edge = node->callees; edge; edge = edge->next_callee)
@@ -705,7 +704,7 @@ lto_balanced_map (int n_lto_partitions, int max_partition_size)
int index;
node = dyn_cast <cgraph_node *> (ref->referring);
- gcc_assert (node->definition || node->declare_variant_alt);
+ gcc_assert (node->definition);
index = lto_symtab_encoder_lookup (partition->encoder,
node);
if (index != LCC_NOT_FOUND
diff --git a/gcc/omp-expand.cc b/gcc/omp-expand.cc
index f44ba204123..5abd2240711 100644
--- a/gcc/omp-expand.cc
+++ b/gcc/omp-expand.cc
@@ -10109,7 +10109,7 @@ expand_omp_target (struct omp_region *region)
/* Enable pass_omp_device_lower pass. */
fn2_node = cgraph_node::get (DECL_CONTEXT (child_fn));
- fn2_node->calls_declare_variant_alt = 1;
+ fn2_node->has_metadirectives = 1;
t = build_decl (DECL_SOURCE_LOCATION (child_fn),
RESULT_DECL, NULL_TREE, void_type_node);
diff --git a/gcc/omp-general.cc b/gcc/omp-general.cc
index 13cf43d272f..b7eca439ad9 100644
--- a/gcc/omp-general.cc
+++ b/gcc/omp-general.cc
@@ -2617,222 +2617,6 @@ omp_complete_construct_context (tree construct_context, bool *completep)
return construct_context;
}
-/* Class describing a single variant. */
-struct GTY(()) omp_declare_variant_entry {
- /* NODE of the variant. */
- cgraph_node *variant;
- /* Score if not in declare simd clone. */
- score_wide_int score;
- /* Score if in declare simd clone. */
- score_wide_int score_in_declare_simd_clone;
- /* Context selector for the variant. */
- tree ctx;
- /* True if the context selector is known to match already. */
- bool matches;
-};
-
-/* Class describing a function with variants. */
-struct GTY((for_user)) omp_declare_variant_base_entry {
- /* NODE of the base function. */
- cgraph_node *base;
- /* NODE of the artificial function created for the deferred variant
- resolution. */
- cgraph_node *node;
- /* Vector of the variants. */
- vec<omp_declare_variant_entry, va_gc> *variants;
-};
-
-struct omp_declare_variant_hasher
- : ggc_ptr_hash<omp_declare_variant_base_entry> {
- static hashval_t hash (omp_declare_variant_base_entry *);
- static bool equal (omp_declare_variant_base_entry *,
- omp_declare_variant_base_entry *);
-};
-
-hashval_t
-omp_declare_variant_hasher::hash (omp_declare_variant_base_entry *x)
-{
- inchash::hash hstate;
- hstate.add_int (DECL_UID (x->base->decl));
- hstate.add_int (x->variants->length ());
- omp_declare_variant_entry *variant;
- unsigned int i;
- FOR_EACH_VEC_SAFE_ELT (x->variants, i, variant)
- {
- hstate.add_int (DECL_UID (variant->variant->decl));
- hstate.add_wide_int (variant->score);
- hstate.add_wide_int (variant->score_in_declare_simd_clone);
- hstate.add_ptr (variant->ctx);
- hstate.add_int (variant->matches);
- }
- return hstate.end ();
-}
-
-bool
-omp_declare_variant_hasher::equal (omp_declare_variant_base_entry *x,
- omp_declare_variant_base_entry *y)
-{
- if (x->base != y->base
- || x->variants->length () != y->variants->length ())
- return false;
- omp_declare_variant_entry *variant;
- unsigned int i;
- FOR_EACH_VEC_SAFE_ELT (x->variants, i, variant)
- if (variant->variant != (*y->variants)[i].variant
- || variant->score != (*y->variants)[i].score
- || (variant->score_in_declare_simd_clone
- != (*y->variants)[i].score_in_declare_simd_clone)
- || variant->ctx != (*y->variants)[i].ctx
- || variant->matches != (*y->variants)[i].matches)
- return false;
- return true;
-}
-
-static GTY(()) hash_table<omp_declare_variant_hasher> *omp_declare_variants;
-
-struct omp_declare_variant_alt_hasher
- : ggc_ptr_hash<omp_declare_variant_base_entry> {
- static hashval_t hash (omp_declare_variant_base_entry *);
- static bool equal (omp_declare_variant_base_entry *,
- omp_declare_variant_base_entry *);
-};
-
-hashval_t
-omp_declare_variant_alt_hasher::hash (omp_declare_variant_base_entry *x)
-{
- return DECL_UID (x->node->decl);
-}
-
-bool
-omp_declare_variant_alt_hasher::equal (omp_declare_variant_base_entry *x,
- omp_declare_variant_base_entry *y)
-{
- return x->node == y->node;
-}
-
-static GTY(()) hash_table<omp_declare_variant_alt_hasher>
- *omp_declare_variant_alt;
-
-void
-omp_lto_output_declare_variant_alt (lto_simple_output_block *ob,
- cgraph_node *node,
- lto_symtab_encoder_t encoder)
-{
- gcc_assert (node->declare_variant_alt);
-
- omp_declare_variant_base_entry entry;
- entry.base = NULL;
- entry.node = node;
- entry.variants = NULL;
- omp_declare_variant_base_entry *entryp
- = omp_declare_variant_alt->find_with_hash (&entry, DECL_UID (node->decl));
- gcc_assert (entryp);
-
- int nbase = lto_symtab_encoder_lookup (encoder, entryp->base);
- gcc_assert (nbase != LCC_NOT_FOUND);
- streamer_write_hwi_stream (ob->main_stream, nbase);
-
- streamer_write_hwi_stream (ob->main_stream, entryp->variants->length ());
-
- unsigned int i;
- omp_declare_variant_entry *varentry;
- FOR_EACH_VEC_SAFE_ELT (entryp->variants, i, varentry)
- {
- int nvar = lto_symtab_encoder_lookup (encoder, varentry->variant);
- gcc_assert (nvar != LCC_NOT_FOUND);
- streamer_write_hwi_stream (ob->main_stream, nvar);
-
- for (score_wide_int *w = &varentry->score; ;
- w = &varentry->score_in_declare_simd_clone)
- {
- unsigned len = w->get_len ();
- streamer_write_hwi_stream (ob->main_stream, len);
- const HOST_WIDE_INT *val = w->get_val ();
- for (unsigned j = 0; j < len; j++)
- streamer_write_hwi_stream (ob->main_stream, val[j]);
- if (w == &varentry->score_in_declare_simd_clone)
- break;
- }
-
- HOST_WIDE_INT cnt = -1;
- HOST_WIDE_INT i = varentry->matches ? 1 : 0;
- for (tree attr = DECL_ATTRIBUTES (entryp->base->decl);
- attr; attr = TREE_CHAIN (attr), i += 2)
- {
- attr = lookup_attribute ("omp declare variant base", attr);
- if (attr == NULL_TREE)
- break;
-
- if (varentry->ctx == TREE_VALUE (TREE_VALUE (attr)))
- {
- cnt = i;
- break;
- }
- }
-
- gcc_assert (cnt != -1);
- streamer_write_hwi_stream (ob->main_stream, cnt);
- }
-}
-
-void
-omp_lto_input_declare_variant_alt (lto_input_block *ib, cgraph_node *node,
- vec<symtab_node *> nodes)
-{
- gcc_assert (node->declare_variant_alt);
- omp_declare_variant_base_entry *entryp
- = ggc_cleared_alloc<omp_declare_variant_base_entry> ();
- entryp->base = dyn_cast<cgraph_node *> (nodes[streamer_read_hwi (ib)]);
- entryp->node = node;
- unsigned int len = streamer_read_hwi (ib);
- vec_alloc (entryp->variants, len);
-
- for (unsigned int i = 0; i < len; i++)
- {
- omp_declare_variant_entry varentry;
- varentry.variant
- = dyn_cast<cgraph_node *> (nodes[streamer_read_hwi (ib)]);
- for (score_wide_int *w = &varentry.score; ;
- w = &varentry.score_in_declare_simd_clone)
- {
- unsigned len2 = streamer_read_hwi (ib);
- HOST_WIDE_INT arr[WIDE_INT_MAX_HWIS (1024)];
- gcc_assert (len2 <= WIDE_INT_MAX_HWIS (1024));
- for (unsigned int j = 0; j < len2; j++)
- arr[j] = streamer_read_hwi (ib);
- *w = score_wide_int::from_array (arr, len2, true);
- if (w == &varentry.score_in_declare_simd_clone)
- break;
- }
-
- HOST_WIDE_INT cnt = streamer_read_hwi (ib);
- HOST_WIDE_INT j = 0;
- varentry.ctx = NULL_TREE;
- varentry.matches = (cnt & 1) ? true : false;
- cnt &= ~HOST_WIDE_INT_1;
- for (tree attr = DECL_ATTRIBUTES (entryp->base->decl);
- attr; attr = TREE_CHAIN (attr), j += 2)
- {
- attr = lookup_attribute ("omp declare variant base", attr);
- if (attr == NULL_TREE)
- break;
-
- if (cnt == j)
- {
- varentry.ctx = TREE_VALUE (TREE_VALUE (attr));
- break;
- }
- }
- gcc_assert (varentry.ctx != NULL_TREE);
- entryp->variants->quick_push (varentry);
- }
- if (omp_declare_variant_alt == NULL)
- omp_declare_variant_alt
- = hash_table<omp_declare_variant_alt_hasher>::create_ggc (64);
- *omp_declare_variant_alt->find_slot_with_hash (entryp, DECL_UID (node->decl),
- INSERT) = entryp;
-}
-
/* Comparison function for sorting routines, to sort OpenMP metadirective
variants by decreasing score. */
@@ -4138,5 +3922,3 @@ debug_omp_tokenized_addr (vec<omp_addr_token *> &addr_tokens,
fputs ("\n", stderr);
}
-
-#include "gt-omp-general.h"
diff --git a/gcc/omp-offload.cc b/gcc/omp-offload.cc
index c093440bc09..613b77571e6 100644
--- a/gcc/omp-offload.cc
+++ b/gcc/omp-offload.cc
@@ -2718,8 +2718,6 @@ execute_omp_device_lower ()
bool regimplify = false;
basic_block bb;
gimple_stmt_iterator gsi;
- bool calls_declare_variant_alt
- = cgraph_node::get (cfun->decl)->calls_declare_variant_alt;
auto_vec<basic_block> metadirective_bbs;
#ifdef ACCEL_COMPILER
bool omp_redirect_indirect_calls = vec_safe_length (offload_ind_funcs) > 0;
@@ -2736,8 +2734,6 @@ execute_omp_device_lower ()
continue;
if (!gimple_call_internal_p (stmt))
{
- /* FIXME: this is a leftover of obsolete code. */
- gcc_assert (!calls_declare_variant_alt);
#ifdef ACCEL_COMPILER
if (omp_redirect_indirect_calls
&& gimple_call_fndecl (stmt) == NULL_TREE)
@@ -2919,9 +2915,7 @@ public:
#endif
return (!(fun->curr_properties & PROP_gimple_lomp_dev)
|| (flag_openmp
- && (node->calls_declare_variant_alt
- || node->has_metadirectives
- || offload_ind_funcs_p)));
+ && (node->has_metadirectives || offload_ind_funcs_p)));
}
unsigned int execute (function *) final override
{
diff --git a/gcc/omp-simd-clone.cc b/gcc/omp-simd-clone.cc
index fa80b6b3bb9..52806620ed0 100644
--- a/gcc/omp-simd-clone.cc
+++ b/gcc/omp-simd-clone.cc
@@ -688,8 +688,6 @@ simd_clone_create (struct cgraph_node *old_node, bool force_local)
the old node. */
new_node->local = old_node->local;
new_node->externally_visible = old_node->externally_visible;
- new_node->calls_declare_variant_alt
- = old_node->calls_declare_variant_alt;
new_node->has_metadirectives = old_node->has_metadirectives;
}
diff --git a/gcc/passes.cc b/gcc/passes.cc
index d73f8ba97b6..e9d18b9d22e 100644
--- a/gcc/passes.cc
+++ b/gcc/passes.cc
@@ -2881,8 +2881,7 @@ ipa_write_summaries (void)
{
struct cgraph_node *node = order[i];
- if ((node->definition || node->declare_variant_alt)
- && node->need_lto_streaming)
+ if (node->definition && node->need_lto_streaming)
{
if (gimple_has_body_p (node->decl))
lto_prepare_function_for_streaming (node);
diff --git a/gcc/symtab.cc b/gcc/symtab.cc
index 3b018ab3ea2..5660857fa51 100644
--- a/gcc/symtab.cc
+++ b/gcc/symtab.cc
@@ -2160,7 +2160,7 @@ symtab_node::get_partitioning_class (void)
if (DECL_ABSTRACT_P (decl))
return SYMBOL_EXTERNAL;
- if (cnode && (cnode->inlined_to || cnode->declare_variant_alt))
+ if (cnode && cnode->inlined_to)
return SYMBOL_DUPLICATE;
/* Transparent aliases are always duplicated. */
diff --git a/gcc/tree-inline.cc b/gcc/tree-inline.cc
index 0a3ad616d84..8674baec5f2 100644
--- a/gcc/tree-inline.cc
+++ b/gcc/tree-inline.cc
@@ -5058,8 +5058,6 @@ expand_call_inline (basic_block bb, gimple *stmt, copy_body_data *id,
if (src_properties != prop_mask)
dst_cfun->curr_properties &= src_properties | ~prop_mask;
dst_cfun->calls_eh_return |= id->src_cfun->calls_eh_return;
- id->dst_node->calls_declare_variant_alt
- |= id->src_node->calls_declare_variant_alt;
id->dst_node->has_metadirectives |= id->src_node->has_metadirectives;
gcc_assert (!id->src_cfun->after_inlining);
@@ -6314,8 +6312,6 @@ tree_function_versioning (tree old_decl, tree new_decl,
DECL_ARGUMENTS (new_decl) = DECL_ARGUMENTS (old_decl);
initialize_cfun (new_decl, old_decl,
new_entry ? new_entry->count : old_entry_block->count);
- new_version_node->calls_declare_variant_alt
- = old_version_node->calls_declare_variant_alt;
new_version_node->has_metadirectives = old_version_node->has_metadirectives;
if (DECL_STRUCT_FUNCTION (new_decl)->gimple_df)
DECL_STRUCT_FUNCTION (new_decl)->gimple_df->ipa_pta
--
2.25.1
^ permalink raw reply [flat|nested] 13+ messages in thread
* [PATCH 11/12] OpenMP: Update "declare target"/OpenMP context interaction
2024-05-04 21:21 [PATCH 00/12] OpenMP: Metadirective support + "declare variant" improvements Sandra Loosemore
` (9 preceding siblings ...)
2024-05-04 21:21 ` [PATCH 10/12] OpenMP: Remove dead code from declare variant reimplementation Sandra Loosemore
@ 2024-05-04 21:21 ` Sandra Loosemore
2024-05-04 21:21 ` [PATCH 12/12] OpenMP: Update documentation of metadirective implementation status Sandra Loosemore
11 siblings, 0 replies; 13+ messages in thread
From: Sandra Loosemore @ 2024-05-04 21:21 UTC (permalink / raw)
To: gcc-patches; +Cc: jakub, tburnus
The code and test case previously implemented the OpenMP 5.0 spec,
which said in section 2.3.1:
"For functions within a declare target block, the target trait is added
to the beginning of the set..."
In OpenMP 5.1, this was changed to
"For device routines, the target trait is added to the beginning of
the set..."
In OpenMP 5.2 and TR12, it says:
"For procedures that are determined to be target function variants
by a declare target directive..."
The definition of "device routine" in OpenMP 5.1 is confusing, but
certainly the intent of the later versions of the spec is clear that
it doesn't just apply to functions within a begin declare target/end
declare target block.
The only use of the "omp declare target block" function attribute was
to support the 5.0 language, so it can be removed. This patch changes
the context augmentation to use the "omp declare target" attribute
instead.
gcc/c-family/ChangeLog
* c-attribs.cc (c_common_gnu_attributes): Delete "omp declare
target block".
gcc/c/ChangeLog
* c-decl.cc (c_decl_attributes): Don't add "omp declare target
block".
gcc/cp/decl2.cc
* decl2.cc (cplus_decl_attributes): Don't add "omp declare target
block".
gcc/ChangeLog
* omp-general.cc (omp_complete_construct_context): Check
"omp declare target" attribute, not "omp declare target block".
gcc/testsuite/ChangeLog
* c-c++-common/gomp/declare-target-indirect-2.c : Adjust
expected output for removal of "omp declare target block".
* c-c++-common/gomp/declare-variant-8.c: Likewise, the variant
call to f20 is now resolved differently.
* c-c++-common/gomp/reverse-offload-1.c: Adjust expected output.
* gfortran.dg/gomp/declare-variant-8.f90: Likewise, both f18
and f20 now resolve to the variant. Delete obsolete comments.
---
gcc/c-family/c-attribs.cc | 2 --
gcc/c/c-decl.cc | 8 ++------
gcc/cp/decl2.cc | 9 ++-------
gcc/omp-general.cc | 2 +-
.../c-c++-common/gomp/declare-target-indirect-2.c | 10 +++++-----
gcc/testsuite/c-c++-common/gomp/declare-variant-8.c | 4 ++--
gcc/testsuite/c-c++-common/gomp/reverse-offload-1.c | 2 +-
gcc/testsuite/gfortran.dg/gomp/declare-variant-8.f90 | 12 ++----------
8 files changed, 15 insertions(+), 34 deletions(-)
diff --git a/gcc/c-family/c-attribs.cc b/gcc/c-family/c-attribs.cc
index 04e39b41bdf..582d99ada1b 100644
--- a/gcc/c-family/c-attribs.cc
+++ b/gcc/c-family/c-attribs.cc
@@ -570,8 +570,6 @@ const struct attribute_spec c_common_gnu_attributes[] =
handle_omp_declare_target_attribute, NULL },
{ "omp declare target nohost", 0, 0, true, false, false, false,
handle_omp_declare_target_attribute, NULL },
- { "omp declare target block", 0, 0, true, false, false, false,
- handle_omp_declare_target_attribute, NULL },
{ "non overlapping", 0, 0, true, false, false, false,
handle_non_overlapping_attribute, NULL },
{ "alloc_align", 1, 1, false, true, true, false,
diff --git a/gcc/c/c-decl.cc b/gcc/c/c-decl.cc
index 52af8f32998..4ab7cd86030 100644
--- a/gcc/c/c-decl.cc
+++ b/gcc/c/c-decl.cc
@@ -5414,12 +5414,8 @@ c_decl_attributes (tree *node, tree attributes, int flags)
attributes = tree_cons (get_identifier ("omp declare target implicit"),
NULL_TREE, attributes);
else
- {
- attributes = tree_cons (get_identifier ("omp declare target"),
- NULL_TREE, attributes);
- attributes = tree_cons (get_identifier ("omp declare target block"),
- NULL_TREE, attributes);
- }
+ attributes = tree_cons (get_identifier ("omp declare target"),
+ NULL_TREE, attributes);
if (TREE_CODE (*node) == FUNCTION_DECL)
{
int device_type
diff --git a/gcc/cp/decl2.cc b/gcc/cp/decl2.cc
index 806a2a4bc69..028105a5b26 100644
--- a/gcc/cp/decl2.cc
+++ b/gcc/cp/decl2.cc
@@ -1777,13 +1777,8 @@ cplus_decl_attributes (tree *decl, tree attributes, int flags)
= tree_cons (get_identifier ("omp declare target implicit"),
NULL_TREE, attributes);
else
- {
- attributes = tree_cons (get_identifier ("omp declare target"),
- NULL_TREE, attributes);
- attributes
- = tree_cons (get_identifier ("omp declare target block"),
- NULL_TREE, attributes);
- }
+ attributes = tree_cons (get_identifier ("omp declare target"),
+ NULL_TREE, attributes);
if (TREE_CODE (*decl) == FUNCTION_DECL)
{
cp_omp_declare_target_attr &last
diff --git a/gcc/omp-general.cc b/gcc/omp-general.cc
index b7eca439ad9..986f9e4f558 100644
--- a/gcc/omp-general.cc
+++ b/gcc/omp-general.cc
@@ -2609,7 +2609,7 @@ omp_complete_construct_context (tree construct_context, bool *completep)
}
/* Add target trait when in a target variant. */
- if (lookup_attribute ("omp declare target block", attributes))
+ if (lookup_attribute ("omp declare target", attributes))
construct_context = make_trait_selector (OMP_TRAIT_CONSTRUCT_TARGET,
NULL_TREE, NULL_TREE,
construct_context);
diff --git a/gcc/testsuite/c-c++-common/gomp/declare-target-indirect-2.c b/gcc/testsuite/c-c++-common/gomp/declare-target-indirect-2.c
index 6ba278b3ef0..75a205feb95 100644
--- a/gcc/testsuite/c-c++-common/gomp/declare-target-indirect-2.c
+++ b/gcc/testsuite/c-c++-common/gomp/declare-target-indirect-2.c
@@ -4,12 +4,12 @@
#pragma omp begin declare target indirect
void fn1 (void) { }
#pragma omp end declare target
-/* { dg-final { scan-tree-dump "__attribute__\\\(\\\(omp declare target, omp declare target block, omp declare target indirect\\\)\\\)\\\nvoid fn1" "gimple" } } */
+/* { dg-final { scan-tree-dump "__attribute__\\\(\\\(omp declare target, omp declare target indirect\\\)\\\)\\\nvoid fn1" "gimple" } } */
#pragma omp begin declare target indirect (0)
void fn2 (void) { }
#pragma omp end declare target
-/* { dg-final { scan-tree-dump "__attribute__\\\(\\\(omp declare target, omp declare target block\\\)\\\)\\\nvoid fn2" "gimple" } } */
+/* { dg-final { scan-tree-dump "__attribute__\\\(\\\(omp declare target\\\)\\\)\\\nvoid fn2" "gimple" } } */
void fn3 (void) { }
#pragma omp declare target indirect to (fn3)
@@ -27,6 +27,6 @@ void fn4 (void) { }
#pragma omp declare target indirect enter(baz)
#pragma omp end declare target
#pragma omp end declare target
-/* { dg-final { scan-tree-dump "__attribute__\\\(\\\(omp declare target, omp declare target block, omp declare target indirect\\\)\\\)\\\nint foo" "gimple" } } */
-/* { dg-final { scan-tree-dump "__attribute__\\\(\\\(omp declare target, omp declare target block\\\)\\\)\\\nint bar" "gimple" } } */
-/* { dg-final { scan-tree-dump "__attribute__\\\(\\\(omp declare target indirect, omp declare target, omp declare target block\\\)\\\)\\\nint baz" "gimple" } } */
+/* { dg-final { scan-tree-dump "__attribute__\\\(\\\(omp declare target, omp declare target indirect\\\)\\\)\\\nint foo" "gimple" } } */
+/* { dg-final { scan-tree-dump "__attribute__\\\(\\\(omp declare target\\\)\\\)\\\nint bar" "gimple" } } */
+/* { dg-final { scan-tree-dump "__attribute__\\\(\\\(omp declare target indirect, omp declare target\\\)\\\)\\\nint baz" "gimple" } } */
diff --git a/gcc/testsuite/c-c++-common/gomp/declare-variant-8.c b/gcc/testsuite/c-c++-common/gomp/declare-variant-8.c
index a7a3ba41b97..9cd706e896f 100644
--- a/gcc/testsuite/c-c++-common/gomp/declare-variant-8.c
+++ b/gcc/testsuite/c-c++-common/gomp/declare-variant-8.c
@@ -1,4 +1,4 @@
-/* { dg-do compile { target c } } */
+/* { dg-do compile } */
/* { dg-additional-options "-fdump-tree-gimple" } */
void f01 (void);
@@ -102,7 +102,7 @@ void
test3 (void)
{
#pragma omp parallel
- f20 (); /* { dg-final { scan-tree-dump-times "f20 \\\(\\\);" 1 "gimple" } } */
+ f20 (); /* { dg-final { scan-tree-dump-times "f19 \\\(\\\);" 1 "gimple" } } */
}
void
diff --git a/gcc/testsuite/c-c++-common/gomp/reverse-offload-1.c b/gcc/testsuite/c-c++-common/gomp/reverse-offload-1.c
index 9a3fa5230f8..6abaddcd5f4 100644
--- a/gcc/testsuite/c-c++-common/gomp/reverse-offload-1.c
+++ b/gcc/testsuite/c-c++-common/gomp/reverse-offload-1.c
@@ -4,7 +4,7 @@
/* { dg-final { scan-tree-dump-times "__attribute__\\(\\(omp declare target\\)\\)\[\n\r\]*int called_in_target1" 1 "omplower" } } */
/* { dg-final { scan-tree-dump-times "__attribute__\\(\\(omp declare target\\)\\)\[\n\r\]*int called_in_target2" 1 "omplower" } } */
-/* { dg-final { scan-tree-dump-times "__attribute__\\(\\(omp declare target, omp declare target block\\)\\)\[\n\r\]*void tg_fn" 1 "omplower" } } */
+/* { dg-final { scan-tree-dump-times "__attribute__\\(\\(omp declare target\\)\\)\[\n\r\]*void tg_fn" 1 "omplower" } } */
/* { dg-prune-output "'reverse_offload' clause on 'requires' directive not supported yet" } */
diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-variant-8.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-variant-8.f90
index d69e552eeb7..e3935768bc4 100644
--- a/gcc/testsuite/gfortran.dg/gomp/declare-variant-8.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/declare-variant-8.f90
@@ -167,23 +167,15 @@ contains
end subroutine
subroutine test2 ()
- ! OpenMP 5.0 specifies that the 'target' trait should be added for
- ! functions within a declare target block, but Fortran does not have
- ! the notion of a declare target _block_, so the variant is not used here.
- ! This may change in later versions of OpenMP.
-
!$omp declare target
!$omp parallel
- call f18 () ! { dg-final { scan-tree-dump-times "f18 \\\(\\\);" 1 "gimple" } }
+ call f18 () ! { dg-final { scan-tree-dump-times "f17 \\\(\\\);" 1 "gimple" } }
!$omp end parallel
end subroutine
subroutine test3 ()
- ! In the C version, this test was used to check that the
- ! 'declare target to' form of the directive did not result in the variant
- ! being used.
!$omp parallel
- call f20 () ! { dg-final { scan-tree-dump-times "f20 \\\(\\\);" 1 "gimple" } }
+ call f20 () ! { dg-final { scan-tree-dump-times "f19 \\\(\\\);" 1 "gimple" } }
!$omp end parallel
end subroutine
--
2.25.1
^ permalink raw reply [flat|nested] 13+ messages in thread
* [PATCH 12/12] OpenMP: Update documentation of metadirective implementation status.
2024-05-04 21:21 [PATCH 00/12] OpenMP: Metadirective support + "declare variant" improvements Sandra Loosemore
` (10 preceding siblings ...)
2024-05-04 21:21 ` [PATCH 11/12] OpenMP: Update "declare target"/OpenMP context interaction Sandra Loosemore
@ 2024-05-04 21:21 ` Sandra Loosemore
11 siblings, 0 replies; 13+ messages in thread
From: Sandra Loosemore @ 2024-05-04 21:21 UTC (permalink / raw)
To: gcc-patches; +Cc: jakub, tburnus
libgomp/ChangeLog
* libgomp.texi (OpenMP 5.0): Mark metadirective and declare variant
as implemented.
(OpenMP 5.1): Mark target_device as supported.
Add changed interaction between declare target and OpenMP context
and dynamic selector support.
(OpenMP 5.2): Mark otherwise clause as supported, note that
default is also still accepted.
---
libgomp/libgomp.texi | 21 ++++++++++++++-------
1 file changed, 14 insertions(+), 7 deletions(-)
diff --git a/libgomp/libgomp.texi b/libgomp/libgomp.texi
index 43048da4d6e..af7af63c504 100644
--- a/libgomp/libgomp.texi
+++ b/libgomp/libgomp.texi
@@ -192,9 +192,8 @@ The OpenMP 4.5 specification is fully supported.
@item Array shaping @tab N @tab
@item Array sections with non-unit strides in C and C++ @tab N @tab
@item Iterators @tab Y @tab
-@item @code{metadirective} directive @tab N @tab
-@item @code{declare variant} directive
- @tab P @tab @emph{simd} traits not handled correctly
+@item @code{metadirective} directive @tab Y @tab
+@item @code{declare variant} directive @tab Y @tab
@item @var{target-offload-var} ICV and @code{OMP_TARGET_OFFLOAD}
env variable @tab Y @tab
@item Nested-parallel changes to @var{max-active-levels-var} ICV @tab Y @tab
@@ -289,8 +288,8 @@ The OpenMP 4.5 specification is fully supported.
@headitem Description @tab Status @tab Comments
@item OpenMP directive as C++ attribute specifiers @tab Y @tab
@item @code{omp_all_memory} reserved locator @tab Y @tab
-@item @emph{target_device trait} in OpenMP Context @tab N @tab
-@item @code{target_device} selector set in context selectors @tab N @tab
+@item @emph{target_device trait} in OpenMP Context @tab Y
+@item @code{target_device} selector set in context selectors @tab Y @tab
@item C/C++'s @code{declare variant} directive: elision support of
preprocessed code @tab N @tab
@item @code{declare variant}: new clauses @code{adjust_args} and
@@ -366,6 +365,12 @@ to address of matching mapped list item per 5.1, Sect. 2.21.7.2 @tab N @tab
@item @code{device_type(nohost)}/@code{device_type(host)} for variables @tab N @tab
@item @code{present} modifier to the @code{map}, @code{to} and @code{from}
clauses @tab Y @tab
+@item Changed interaction between @code{declare target} and OpenMP context
+ @tab Y @tab
+@item Dynamic selector support in @code{metadirective} @tab Y @tab
+@item Dynamic selector support in @code{declare variant} @tab P
+ @tab Fortran rejects non-constant expressions in dynamic selectors;
+ C/C++ reject expressions using argument variables.
@end multitable
@@ -413,8 +418,10 @@ to address of matching mapped list item per 5.1, Sect. 2.21.7.2 @tab N @tab
@item Deprecation of traits array following the allocator_handle expression in
@code{uses_allocators} @tab N @tab
@item New @code{otherwise} clause as alias for @code{default} on metadirectives
- @tab N @tab
-@item Deprecation of @code{default} clause on metadirectives @tab N @tab
+ @tab Y @tab
+@item Deprecation of @code{default} clause on metadirectives @tab N
+ @tab Both @code{otherwise} and @code{default} are accepted
+ without diagnostics.
@item Deprecation of delimited form of @code{declare target} @tab N @tab
@item Reproducible semantics changed for @code{order(concurrent)} @tab N @tab
@item @code{allocate} and @code{firstprivate} clauses on @code{scope}
--
2.25.1
^ permalink raw reply [flat|nested] 13+ messages in thread
end of thread, other threads:[~2024-05-04 21:22 UTC | newest]
Thread overview: 13+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2024-05-04 21:21 [PATCH 00/12] OpenMP: Metadirective support + "declare variant" improvements Sandra Loosemore
2024-05-04 21:21 ` [PATCH 01/12] OpenMP: metadirective tree data structures and front-end interfaces Sandra Loosemore
2024-05-04 21:21 ` [PATCH 02/12] OpenMP: middle-end support for metadirectives Sandra Loosemore
2024-05-04 21:21 ` [PATCH 03/12] libgomp: runtime support for target_device selector Sandra Loosemore
2024-05-04 21:21 ` [PATCH 04/12] OpenMP: C front end support for metadirectives Sandra Loosemore
2024-05-04 21:21 ` [PATCH 05/12] OpenMP: C++ front-end " Sandra Loosemore
2024-05-04 21:21 ` [PATCH 06/12] OpenMP: common c/c++ testcases " Sandra Loosemore
2024-05-04 21:21 ` [PATCH 07/12] OpenMP: Fortran front-end support " Sandra Loosemore
2024-05-04 21:21 ` [PATCH 08/12] OpenMP: Reject other properties with kind(any) Sandra Loosemore
2024-05-04 21:21 ` [PATCH 09/12] OpenMP: Extend dynamic selector support to declare variant Sandra Loosemore
2024-05-04 21:21 ` [PATCH 10/12] OpenMP: Remove dead code from declare variant reimplementation Sandra Loosemore
2024-05-04 21:21 ` [PATCH 11/12] OpenMP: Update "declare target"/OpenMP context interaction Sandra Loosemore
2024-05-04 21:21 ` [PATCH 12/12] OpenMP: Update documentation of metadirective implementation status Sandra Loosemore
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).