From patchwork Sat Jan 6 18:52:49 2024 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Sandra Loosemore X-Patchwork-Id: 83457 Return-Path: X-Original-To: patchwork@sourceware.org Delivered-To: patchwork@sourceware.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 037DC385841F for ; Sat, 6 Jan 2024 18:54:03 +0000 (GMT) X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from esa3.mentor.iphmx.com (esa3.mentor.iphmx.com [68.232.137.180]) by sourceware.org (Postfix) with ESMTPS id C04483858D3C for ; Sat, 6 Jan 2024 18:53:14 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org C04483858D3C Authentication-Results: sourceware.org; dmarc=none (p=none dis=none) header.from=codesourcery.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=mentor.com ARC-Filter: OpenARC Filter v1.0.0 sourceware.org C04483858D3C Authentication-Results: server2.sourceware.org; arc=none smtp.remote-ip=68.232.137.180 ARC-Seal: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1704567199; cv=none; b=rCgQRAfeGZVpZd6624BcFrzVJiaGJtdEceSJWnS/JWnGgBS/X4/Tz9CTujdoCYtD4AJ3P2nWYR8oRga061npQYaWgxZx9v1GwjH/M9bXx6rGK/mG/nQN1l5KbedhS7EfbD6MvcT4FL8dKEfIhJObct7/VnQOiup4Xy9j20alTZU= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1704567199; c=relaxed/simple; bh=+4G3r8UIHHdrcNnd5XN1X1MuEUUqQTPmWU/CG/GGhBA=; h=From:To:Subject:Date:Message-ID:MIME-Version; b=GCbU8ka/xrYKEihO1dqPruUaDjI6O1YpfJUIwGI60WAJt7HQLW1PrVQ2R0OLf/qs7Zkr35JVg9lnroTP+KMLXDAmNB+AQM1xKUizOv6jdKS6btK8DDPsJiawgt81L/ZKBPOVmMFz2XQz9+nuzvnugq4s6mFOMrFtDjBvXNbweIs= ARC-Authentication-Results: i=1; server2.sourceware.org X-CSE-ConnectionGUID: IQZ2G2QlTRq3UVZyfN55CQ== X-CSE-MsgGUID: f0t8i0XQTSqB2c2P+k3vqA== X-IronPort-AV: E=Sophos;i="6.04,337,1695715200"; d="scan'208";a="27342983" Received: from orw-gwy-02-in.mentorg.com ([192.94.38.167]) by esa3.mentor.iphmx.com with ESMTP; 06 Jan 2024 10:53:13 -0800 IronPort-SDR: sjSp8e8aWNS/HIyyeJogKpnpFWmTCfEAt3oVL29+VnneqtBGZhr6x9/hB7UiezJNApYqCjAVfz UTFsV8yucJxo0e8dVrZRB2CZmSYVxwCr70dWGfV4hf+OEptmLftL4F9Uz3MvhbFgUixXLF8v18 2axuUTw5A6BWaJPbA0+Z3Ehs0ANDt15Y/WrLMw/ugFkmiyUrqJWRHalV050mZOy6OwA1ZkgxHN p6K7om0c+1352Od66kC3chbPTcQFGRTBTbqw4C6tVSgnLUtHWX7diBe6VL8D5nthkaQ1NfQ1cR BBU= From: Sandra Loosemore To: CC: , , Subject: [PATCH 1/8] OpenMP: metadirective tree data structures and front-end interfaces Date: Sat, 6 Jan 2024 11:52:49 -0700 Message-ID: <20240106185257.126445-2-sandra@codesourcery.com> X-Mailer: git-send-email 2.34.1 In-Reply-To: <20240106185257.126445-1-sandra@codesourcery.com> References: <20240106185257.126445-1-sandra@codesourcery.com> MIME-Version: 1.0 X-ClientProxiedBy: svr-orw-mbx-15.mgc.mentorg.com (147.34.90.215) To svr-orw-mbx-13.mgc.mentorg.com (147.34.90.213) X-Spam-Status: No, score=-10.0 required=5.0 tests=BAYES_00, GIT_PATCH_0, HEADER_FROM_DIFFERENT_DOMAINS, KAM_DMARC_STATUS, SPF_HELO_PASS, SPF_PASS, TXREP, T_SCC_BODY_TEXT_LINE autolearn=ham autolearn_force=no version=3.4.6 X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on server2.sourceware.org X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.30 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: gcc-patches-bounces+patchwork=sourceware.org@gcc.gnu.org From: Kwok Cheung Yeung 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_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_resolve_metadirective): New. * omp-general.h (score_wide_int): Moved here from omp-general.cc. (struct omp_metadirective_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_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_context_selector_patches to pass additional arguments. gcc/cp/ChangeLog * decl.cc (omp_declare_variant_finalize_one): Update call to omp_context_selector_patches to pass additional arguments. * parser.cc (cp_finish_omp_declare_variant): Likewise. gcc/fortran/ChangeLog * trans-openmp.cc (gfc_trans_omp_declare_variant): Update calls to omp_context_selector_patches to pass additional arguments. * types.def (BT_FN_BOOL_INT_CONST_PTR_CONST_PTR_CONST_PTR): New. Co-Authored-By: Sandra Loosemore --- 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 | 337 ++++++++++++++++++++++++++++++++++-- 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, 441 insertions(+), 27 deletions(-) diff --git a/gcc/Makefile.in b/gcc/Makefile.in index deb12e17d25..06134e61a3d 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 e7b74fb07f0..b3b3838b010 100644 --- a/gcc/c/c-parser.cc +++ b/gcc/c/c-parser.cc @@ -24729,7 +24729,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) @@ -24762,7 +24762,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 80d0327c557..ca63fdbe073 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 37536faf2cf..b864a9b5275 100644 --- a/gcc/cp/parser.cc +++ b/gcc/cp/parser.cc @@ -48020,7 +48020,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 5746bdc026d..b21b91193f3 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 9599521b97c..439ae5f9f55 100644 --- a/gcc/fortran/trans-openmp.cc +++ b/gcc/fortran/trans-openmp.cc @@ -8491,7 +8491,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 @@ -8528,7 +8528,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 bd4648f196f..c45c4279f8f 100644 --- a/gcc/omp-general.cc +++ b/gcc/omp-general.cc @@ -1258,7 +1258,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]; @@ -1267,9 +1267,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, "% selector set is not supported yet"); + /* FIXME: not implemented yet. */ + if (!metadirective_p && tss_code == OMP_TRAIT_SET_TARGET_DEVICE) + sorry_at (loc, "% selector set is not supported " + "yet for %"); /* Each trait-set-selector-name can only be specified once. */ if (tss_seen[tss_code]) @@ -1421,14 +1422,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)) @@ -1501,6 +1517,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); @@ -1570,6 +1591,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, @@ -1692,6 +1716,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, @@ -1731,6 +1758,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, @@ -1782,6 +1812,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))) @@ -2180,9 +2216,87 @@ 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 > score_wide_int; +/* 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 + device_num = build_int_cst (integer_type_node, -1); + + tree kind_sel + = omp_get_context_selector (ctx, OMP_TRAIT_SET_TARGET_DEVICE, + OMP_TRAIT_DEVICE_KIND); + if (kind_sel) + { + const char *str + = omp_context_name_list_prop (OMP_TS_PROPERTIES (kind_sel)); + kind = build_string_literal (strlen (str) + 1, str); + } + + tree arch_sel + = omp_get_context_selector (ctx, OMP_TRAIT_SET_TARGET_DEVICE, + OMP_TRAIT_DEVICE_ARCH); + if (arch_sel) + { + const char *str + = omp_context_name_list_prop (OMP_TS_PROPERTIES (arch_sel)); + arch = build_string_literal (strlen (str) + 1, str); + } + + tree isa_sel + = omp_get_context_selector (ctx, OMP_TRAIT_SET_TARGET_DEVICE, + OMP_TRAIT_DEVICE_ISA); + if (isa_sel) + { + const char *str + = omp_context_name_list_prop (OMP_TS_PROPERTIES (isa_sel)); + isa = build_string_literal (strlen (str) + 1, str); + } + + /* 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 @@ -2194,12 +2308,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)) @@ -2384,7 +2507,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); @@ -2488,7 +2611,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. */ @@ -2853,6 +2977,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_metadirective_variant *) a)->score; + score_wide_int score2 + = ((const struct omp_metadirective_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 +omp_get_dynamic_candidates (vec &all_variants, + bool delay_p) +{ + auto_vec variants; + struct omp_metadirective_variant default_variant; + bool default_found = false; + + for (unsigned int i = 0; i < all_variants.length (); i++) + { + struct omp_metadirective_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 +omp_resolve_metadirective (tree metadirective) +{ + auto_vec candidates; + tree variant = OMP_METADIRECTIVE_VARIANTS (metadirective); + + gcc_assert (variant); + while (variant) + { + struct omp_metadirective_variant candidate; + + candidate.selector = OMP_METADIRECTIVE_VARIANT_SELECTOR (variant); + candidate.directive = 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..2d9f874708b 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 > score_wide_int; + +/* A structure describing a variant in a metadirective. */ + +struct GTY(()) omp_metadirective_variant +{ + score_wide_int score; + tree selector; + tree directive; + 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 omp_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 04ac85fd230..b36fc30d200 100644 --- a/gcc/tree-pretty-print.cc +++ b/gcc/tree-pretty-print.cc @@ -1499,7 +1499,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) { @@ -4008,6 +4008,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 d07cea5aec2..58d453309a4 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 972a067a1f7..7a9c7804b60 100644 --- a/gcc/tree.h +++ b/gcc/tree.h @@ -1592,6 +1592,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) From patchwork Sat Jan 6 18:52:50 2024 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Sandra Loosemore X-Patchwork-Id: 83458 Return-Path: X-Original-To: patchwork@sourceware.org Delivered-To: patchwork@sourceware.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 51DE13857C60 for ; Sat, 6 Jan 2024 18:54:17 +0000 (GMT) X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from esa3.mentor.iphmx.com (esa3.mentor.iphmx.com [68.232.137.180]) by sourceware.org (Postfix) with ESMTPS id A2EDD3858C3A for ; Sat, 6 Jan 2024 18:53:17 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org A2EDD3858C3A Authentication-Results: sourceware.org; dmarc=none (p=none dis=none) header.from=codesourcery.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=mentor.com ARC-Filter: OpenARC Filter v1.0.0 sourceware.org A2EDD3858C3A Authentication-Results: server2.sourceware.org; arc=none smtp.remote-ip=68.232.137.180 ARC-Seal: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1704567204; cv=none; b=yAeLVq0SB/haZQQvi7nXyRvAqP4Iu2Xh4r/ZOpWQU5fs5EQhCKbSP1tof75Sq/79wj5hQ3MZXr/JTehdkLgVnJ/IZrUDwNppkNOa99OFc78zwWsXA7cUb4eKSRcOVrbraV5tYhowdajkCBWSRpPcTCkWiB+28qRvfplmiAom7B8= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1704567204; c=relaxed/simple; bh=xo6wiYig0ZhOb5UaVGr/Vc5NaEOUTpA+GyipkzvPBAI=; h=From:To:Subject:Date:Message-ID:MIME-Version; b=Uz6AGURjaPJvI/uy8peQ4qtaYbHvCMjtAXuyQUqYn/agApw6p3csLzA9XwdXdthTSZHT43YU0nc74r4TBtLCC85xCJ/1dKl+FKzZaEX76Cf6q7Fha06mm1Gm/M9vc2DNnvNK0yxQtsGTYKWEGwA5HArWkgXsAyyLGFyHqWXqVWQ= ARC-Authentication-Results: i=1; server2.sourceware.org X-CSE-ConnectionGUID: IQZ2G2QlTRq3UVZyfN55CQ== X-CSE-MsgGUID: xdo+HVR2SZSz8/3W+uDX4Q== X-IronPort-AV: E=Sophos;i="6.04,337,1695715200"; d="scan'208";a="27342985" Received: from orw-gwy-02-in.mentorg.com ([192.94.38.167]) by esa3.mentor.iphmx.com with ESMTP; 06 Jan 2024 10:53:17 -0800 IronPort-SDR: /01Z8JRL/z6Lbrsi5EfG4G3SWPub4pstTPfzawAIIjiZ5Z1WGFch0jM4Mu1AgGhZSVdxrKquib EIMtN/FmJGwuQobbhbo2agwwhYLQO1vm6uhpG9Q2qx4b658EL6q74RjTJIx5OolClWemhj9uqh u/BA5J/xKVcgiMpwLpyEQlIVopwSEAMtBMnlF/BdYy/cdOxrBZE7kMWXKOEqVC5U1rPD37VLr/ Rbu+edEIpMZkAZO/S6IUoMK3V8MjkwmgR2LZ89ZK8IoVTikVdDzZHIXGLL8uULwKRkiYz+fIfU 6WM= From: Sandra Loosemore To: CC: , , Subject: [PATCH 2/8] OpenMP: middle-end support for metadirectives Date: Sat, 6 Jan 2024 11:52:50 -0700 Message-ID: <20240106185257.126445-3-sandra@codesourcery.com> X-Mailer: git-send-email 2.34.1 In-Reply-To: <20240106185257.126445-1-sandra@codesourcery.com> References: <20240106185257.126445-1-sandra@codesourcery.com> MIME-Version: 1.0 X-ClientProxiedBy: svr-orw-mbx-15.mgc.mentorg.com (147.34.90.215) To svr-orw-mbx-13.mgc.mentorg.com (147.34.90.213) X-Spam-Status: No, score=-10.0 required=5.0 tests=BAYES_00, GIT_PATCH_0, HEADER_FROM_DIFFERENT_DOMAINS, KAM_DMARC_STATUS, SPF_HELO_PASS, SPF_PASS, TXREP, T_SCC_BODY_TEXT_LINE autolearn=ham autolearn_force=no version=3.4.6 X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on server2.sourceware.org X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.30 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: gcc-patches-bounces+patchwork=sourceware.org@gcc.gnu.org From: Kwok Cheung Yeung 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. * 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_metadirective_variant): New. * gimple.def (GIMPLE_OMP_METADIRECTIVE): New. (GIMPLE_OMP_METADIRECTIVE_VARIANT): New. * gimple.h (gomp_metadirective_variant, gomp_metadirective): New. (is_a_helper ::test): New. (is_a_helper ::test): New. (is_a_helper ::test): New. (is_a_helper ::test): New. (gimple_alloc_omp_metadirective): New. (gimple_build_omp_metadirective): New. (gimple_build_omp_metadirective_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_metadirective_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 (make_omp_metadirective_variant): New. * omp-general.h (make_omp_metadirective_variant): 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. (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): Handle metadirectives. * 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: Sandra Loosemore Co-Authored-By: Marcel Vollweiler --- gcc/cgraph.h | 3 + gcc/cgraphclones.cc | 1 + 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 | 80 ++++++++++++++++ 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 ++++ 22 files changed, 795 insertions(+), 2 deletions(-) diff --git a/gcc/cgraph.h b/gcc/cgraph.h index b4f028b3f30..c6ec788e7c7 100644 --- a/gcc/cgraph.h +++ b/gcc/cgraph.h @@ -896,6 +896,7 @@ struct GTY((tag ("SYMTAB_FUNCTION"))) cgraph_node : public symtab_node redefined_extern_inline (false), tm_may_enter_irr (false), ipcp_clone (false), declare_variant_alt (false), calls_declare_variant_alt (false), gc_candidate (false), + has_metadirectives (false), m_uid (uid), m_summary_id (-1) {} @@ -1495,6 +1496,8 @@ struct GTY((tag ("SYMTAB_FUNCTION"))) cgraph_node : public symtab_node is set for local SIMD clones when they are created and cleared if the vectorizer uses them. */ unsigned gc_candidate : 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 6d7bc402a29..163513ee069 100644 --- a/gcc/cgraphclones.cc +++ b/gcc/cgraphclones.cc @@ -387,6 +387,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/gimple-low.cc b/gcc/gimple-low.cc index 0fca9740898..d58b226b946 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_metadirective_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. */ @@ -811,6 +841,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 (stmt)), diff --git a/gcc/gimple-pretty-print.cc b/gcc/gimple-pretty-print.cc index abda8871f97..cc35e7193d6 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_metadirective_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 (gs), + spc, flags); + break; + case GIMPLE_CATCH: dump_gimple_catch (buffer, as_a (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 (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..1e8d9412117 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_metadirective_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 (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_metadirective_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..cf7af81cf06 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 (g); + + p->labels = ggc_cleared_vec_alloc (gimple_num_ops (p)); +} + +/* Build a GIMPLE_OMP_METADIRECTIVE statement. */ + +gomp_metadirective * +gimple_build_omp_metadirective (int num_variants) +{ + gomp_metadirective *p + = as_a (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_metadirective_variant * +gimple_build_omp_metadirective_variant (gimple_seq body) +{ + gomp_metadirective_variant *variant = as_a + (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..25d6947b475 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_metadirective_variant", GSS_OMP_METADIRECTIVE_VARIANT) + /* GIMPLE_PREDICT 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..8756aab6a64 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_metadirective_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_metadirective_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 ::test (gimple *gs) return gs->code == GIMPLE_OMP_TASK; } +template <> +template <> +inline bool +is_a_helper ::test (gimple *gs) +{ + return gs->code == GIMPLE_OMP_METADIRECTIVE; +} + +template <> +template <> +inline bool +is_a_helper ::test (gimple *gs) +{ + return gs->code == GIMPLE_OMP_METADIRECTIVE_VARIANT; +} + template <> template <> inline bool @@ -1501,6 +1541,22 @@ is_a_helper ::test (const gimple *gs) return gs->code == GIMPLE_OMP_TASK; } +template <> +template <> +inline bool +is_a_helper ::test (const gimple *gs) +{ + return gs->code == GIMPLE_OMP_METADIRECTIVE; +} + +template <> +template <> +inline bool +is_a_helper ::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_metadirective_variant *gimple_build_omp_metadirective_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 (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 (g); + omp_metadirective->labels[i] = label; +} + + +static inline gomp_metadirective_variant * +gimple_omp_metadirective_variants (const gimple *g) +{ + const gomp_metadirective *omp_metadirective + = as_a (g); + return omp_metadirective->variants; +} + + +static inline void +gimple_omp_metadirective_set_variants (gimple *g, gimple *variants) +{ + gomp_metadirective *omp_metadirective = as_a (g); + omp_metadirective->variants + = variants ? as_a (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 15b540646c2..a09138c499e 100644 --- a/gcc/gimplify.cc +++ b/gcc/gimplify.cc @@ -6212,6 +6212,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: @@ -17500,6 +17501,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 &candidates, + gimple_seq *pre_p) +{ + auto_vec selectors; + auto_vec directive_labels; + auto_vec 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_metadirective_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.directive != NULL_TREE) + gimplify_stmt (&candidate.directive, &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 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 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 candidates + = omp_resolve_metadirective (*expr_p); + if (!candidates.is_empty ()) + return expand_omp_metadirective (candidates, pre_p); + + /* The metadirective cannot be resolved yet. */ + + gomp_metadirective_variant *first_variant = NULL; + gomp_metadirective_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_metadirective_variant *omp_variant + = gimple_build_omp_metadirective_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 @@ -18423,6 +18602,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..16625f427e2 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_metadirective_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 6b9c9178613..792404d7b20 100644 --- a/gcc/omp-expand.cc +++ b/gcc/omp-expand.cc @@ -10017,6 +10017,8 @@ expand_omp_target (struct omp_region *region) cgraph_node *node = cgraph_node::get_create (child_fn); node->parallelized_function = 1; cgraph_node::add_new_function (child_fn, true); + node->has_metadirectives + = cgraph_node::get (cfun->decl)->has_metadirectives; /* Add the new function to the offload table. */ if (ENABLE_OFFLOADING) @@ -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 c45c4279f8f..88cf2c99f40 100644 --- a/gcc/omp-general.cc +++ b/gcc/omp-general.cc @@ -3156,6 +3156,28 @@ omp_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 +omp_resolve_metadirective (gimple *gs) +{ + auto_vec variants; + + for (unsigned i = 0; i < gimple_num_ops (gs); i++) + { + struct omp_metadirective_variant variant; + + variant.selector = gimple_op (gs, i); + variant.directive = 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 2d9f874708b..55b6f931dad 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 omp_resolve_metadirective (tree); +extern vec omp_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..f80b22bdaa1 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 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) @@ -3182,6 +3208,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_metadirective_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 +4287,10 @@ scan_omp_1_stmt (gimple_stmt_iterator *gsi, bool *handled_ops_p, scan_omp_teams (as_a (stmt), ctx); break; + case GIMPLE_OMP_METADIRECTIVE: + scan_omp_metadirective (as_a (stmt), ctx); + break; + case GIMPLE_BIND: { tree var; @@ -10702,6 +10748,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_metadirective_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 +14517,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 (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 % " + "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..e60d7527a6f 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 candidates + = omp_resolve_metadirective (stmt); + + /* This is the last chance for the metadirective to be resolved. */ + gcc_assert (!candidates.is_empty ()); + + auto_vec labels; + + for (unsigned int i = 0; i < candidates.length (); i++) + labels.safe_push (candidates[i].directive); + + /* 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 ().directive)); + 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].directive)); + 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 ().directive)); + 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 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 (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 cdd439fe750..5751b0d7310 100644 --- a/gcc/tree-cfg.cc +++ b/gcc/tree-cfg.cc @@ -1751,6 +1751,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; } @@ -6309,6 +6321,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 17628a34c70..54669f8d5f0 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_metadirective_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_metadirective_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 @@ -4587,6 +4617,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 ( @@ -5001,6 +5038,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); @@ -6256,6 +6294,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 (stmt)); From patchwork Sat Jan 6 18:52:51 2024 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Sandra Loosemore X-Patchwork-Id: 83459 Return-Path: X-Original-To: patchwork@sourceware.org Delivered-To: patchwork@sourceware.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 7985F3857706 for ; Sat, 6 Jan 2024 18:55:29 +0000 (GMT) X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from esa2.mentor.iphmx.com (esa2.mentor.iphmx.com [68.232.141.98]) by sourceware.org (Postfix) with ESMTPS id 0AD953857C61 for ; Sat, 6 Jan 2024 18:53:53 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 0AD953857C61 Authentication-Results: sourceware.org; dmarc=none (p=none dis=none) header.from=codesourcery.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=mentor.com ARC-Filter: OpenARC Filter v1.0.0 sourceware.org 0AD953857C61 Authentication-Results: server2.sourceware.org; arc=none smtp.remote-ip=68.232.141.98 ARC-Seal: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1704567240; cv=none; b=odRg45r3gWhsQB6b8qGbcc6iRhlNy4fSzM2Sngti2NxS97oU1lw5Xopef82fDgubfq9wAjytvbH7tkJdNEp68rXaWKleJ0nkmrEFz4xpmU8AyTIyS//+I1s8hJJmYlJsyxEgu9lkvlrFLxTPtrgcq6W0XuN29XiEcOcrIRF+nK8= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1704567240; c=relaxed/simple; bh=oKyqjnosIesVG8j7yqxReXmK2ntN0V+EuOY7g8Esqhc=; h=From:To:Subject:Date:Message-ID:MIME-Version; b=p2RDL9CNBN4jmYHGZgDuU/S6gcZ15jOpQc7LYD61FKnCHghFa86ynV1RDeFmJ9HMzkri7Le4++fmUq0OBj2c2BRjyJR4uiuEyTi+iEDAvnLw5gHSV+x2kC/ithuDk3UsOOfd4NOQxvSIfex6vciFLyR0CLFTPZ8UILtoFhNgRGI= ARC-Authentication-Results: i=1; server2.sourceware.org X-CSE-ConnectionGUID: JqWNT01RRgmQern+J9DWnA== X-CSE-MsgGUID: skjfB/i/SsK6LT+S758ECw== X-IronPort-AV: E=Sophos;i="6.04,337,1695715200"; d="scan'208";a="30509738" Received: from orw-gwy-02-in.mentorg.com ([192.94.38.167]) by esa2.mentor.iphmx.com with ESMTP; 06 Jan 2024 10:53:52 -0800 IronPort-SDR: X++ekpQC43vF0+rQPecQIKQl7/sVC54ak4qZZfX897SLtXUz1LBYYHI/MQ775hWwpiJdUxRpcN lAOJwG/0YhAcXXUDNnnndVipCAwWy0/vmvfe60yK1BlxiknCT1qQWOr9IucO5aOm+EtKQT+gQU qBqdopvYv2AFkBImYVht+mT23Gf3VL746+4VYQISo6dZOXNzR5gII2Q5NGUw7O2JpZnpBkA6HA ZNQ4arGCFGI6g7eYVxVm4BiPhSuE+09MPN93wdEOxmRmJ8pgqYKliWWYw4IlVMjgI92t0uBmbl z3I= From: Sandra Loosemore To: CC: , , Subject: [PATCH 3/8] libgomp: runtime support for target_device selector Date: Sat, 6 Jan 2024 11:52:51 -0700 Message-ID: <20240106185257.126445-4-sandra@codesourcery.com> X-Mailer: git-send-email 2.34.1 In-Reply-To: <20240106185257.126445-1-sandra@codesourcery.com> References: <20240106185257.126445-1-sandra@codesourcery.com> MIME-Version: 1.0 X-ClientProxiedBy: svr-orw-mbx-10.mgc.mentorg.com (147.34.90.210) To svr-orw-mbx-13.mgc.mentorg.com (147.34.90.213) X-Spam-Status: No, score=-10.0 required=5.0 tests=BAYES_00, GIT_PATCH_0, HEADER_FROM_DIFFERENT_DOMAINS, KAM_DMARC_STATUS, KAM_SHORT, SPF_HELO_PASS, SPF_PASS, TXREP, T_SCC_BODY_TEXT_LINE autolearn=ham autolearn_force=no version=3.4.6 X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on server2.sourceware.org X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.30 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: gcc-patches-bounces+patchwork=sourceware.org@gcc.gnu.org From: Kwok Cheung Yeung 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.am: 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): Add GOMP_evaluate_target_device. * 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_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. (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. --- include/cuda/cuda.h | 2 + libgomp/Makefile.am | 2 +- libgomp/Makefile.in | 5 +- libgomp/config/gcn/selector.c | 57 +++++ libgomp/config/linux/selector.c | 43 ++++ libgomp/config/linux/x86/selector.c | 325 ++++++++++++++++++++++++++++ libgomp/config/nvptx/selector.c | 65 ++++++ libgomp/libgomp-plugin.h | 2 + libgomp/libgomp.h | 1 + libgomp/libgomp.map | 1 + libgomp/libgomp_g.h | 8 + libgomp/oacc-host.c | 11 + libgomp/plugin/plugin-gcn.c | 14 ++ libgomp/plugin/plugin-nvptx.c | 45 ++++ libgomp/selector.c | 36 +++ libgomp/target.c | 38 ++++ 16 files changed, 652 insertions(+), 3 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 114aba4e074..0d57bdd68e9 100644 --- a/include/cuda/cuda.h +++ b/include/cuda/cuda.h @@ -82,6 +82,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 56a6beab867..81de2ddb943 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..60793fc05d3 --- /dev/null +++ b/libgomp/config/gcn/selector.c @@ -0,0 +1,57 @@ +/* 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 + . */ + +/* This file contains an implementation of GOMP_evaluate_current_device for + an AMD GCN GPU. */ + +#include "libgomp.h" +#include + +bool +GOMP_evaluate_current_device (const char *kind, const char *arch, + const char *isa) +{ + if (kind && strcmp (kind, "gpu") != 0) + return false; + + if (arch && strcmp (arch, "gcn") != 0) + return false; + + if (!isa) + return true; + +#ifdef __GCN3__ + if (strcmp (isa, "fiji") == 0 || strcmp (isa, "gfx803") == 0) + return true; +#endif + +#ifdef __GCN5__ + if (strcmp (isa, "gfx900") == 0 || strcmp (isa, "gfx906") != 0 + || strcmp (isa, "gfx908") == 0) + return true; +#endif + + return false; +} diff --git a/libgomp/config/linux/selector.c b/libgomp/config/linux/selector.c new file mode 100644 index 00000000000..84e59c7aabe --- /dev/null +++ b/libgomp/config/linux/selector.c @@ -0,0 +1,43 @@ +/* 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 + . */ + +/* This file contains a generic implementation of + GOMP_evaluate_current_device when run on a Linux host. */ + +#include +#include "libgomp.h" + +bool +GOMP_evaluate_current_device (const char *kind, const char *arch, + const char *isa) +{ + if (kind && strcmp (kind, "cpu") != 0) + return false; + + if (!arch && !isa) + return true; + + return false; +} diff --git a/libgomp/config/linux/x86/selector.c b/libgomp/config/linux/x86/selector.c new file mode 100644 index 00000000000..2b6c2ba165b --- /dev/null +++ b/libgomp/config/linux/x86/selector.c @@ -0,0 +1,325 @@ +/* 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 + . */ + +/* This file contains an implementation of GOMP_evaluate_current_device for + an x86/x64-based Linux host. */ + +#include +#include "libgomp.h" + +bool +GOMP_evaluate_current_device (const char *kind, const char *arch, + const char *isa) +{ + if (kind && strcmp (kind, "cpu") != 0) + return false; + + if (arch + && strcmp (arch, "x86") != 0 + && strcmp (arch, "ia32") != 0 +#ifdef __x86_64__ + && strcmp (arch, "x86_64") != 0 +#endif +#ifdef __ILP32__ + && strcmp (arch, "x32") != 0 +#endif + && strcmp (arch, "i386") != 0 + && strcmp (arch, "i486") != 0 +#ifndef __i486__ + && strcmp (arch, "i586") != 0 +#endif +#if !defined (__i486__) && !defined (__i586__) + && strcmp (arch, "i686") != 0 +#endif + ) + return false; + + if (!isa) + return true; + +#ifdef __WBNOINVD__ + if (strcmp (isa, "wbnoinvd") == 0) return true; +#endif +#ifdef __AVX512VP2INTERSECT__ + if (strcmp (isa, "avx512vp2intersect") == 0) return true; +#endif +#ifdef __MMX__ + if (strcmp (isa, "mmx") == 0) return true; +#endif +#ifdef __3dNOW__ + if (strcmp (isa, "3dnow") == 0) return true; +#endif +#ifdef __3dNOW_A__ + if (strcmp (isa, "3dnowa") == 0) return true; +#endif +#ifdef __SSE__ + if (strcmp (isa, "sse") == 0) return true; +#endif +#ifdef __SSE2__ + if (strcmp (isa, "sse2") == 0) return true; +#endif +#ifdef __SSE3__ + if (strcmp (isa, "sse3") == 0) return true; +#endif +#ifdef __SSSE3__ + if (strcmp (isa, "ssse3") == 0) return true; +#endif +#ifdef __SSE4_1__ + if (strcmp (isa, "sse4.1") == 0) return true; +#endif +#ifdef __SSE4_2__ + if (strcmp (isa, "sse4") == 0 || strcmp (isa, "sse4.2") == 0) return true; +#endif +#ifdef __AES__ + if (strcmp (isa, "aes") == 0) return true; +#endif +#ifdef __SHA__ + if (strcmp (isa, "sha") == 0) return true; +#endif +#ifdef __PCLMUL__ + if (strcmp (isa, "pclmul") == 0) return true; +#endif +#ifdef __AVX__ + if (strcmp (isa, "avx") == 0) return true; +#endif +#ifdef __AVX2__ + if (strcmp (isa, "avx2") == 0) return true; +#endif +#ifdef __AVX512F__ + if (strcmp (isa, "avx512f") == 0) return true; +#endif +#ifdef __AVX512ER__ + if (strcmp (isa, "avx512er") == 0) return true; +#endif +#ifdef __AVX512CD__ + if (strcmp (isa, "avx512cd") == 0) return true; +#endif +#ifdef __AVX512PF__ + if (strcmp (isa, "avx512pf") == 0) return true; +#endif +#ifdef __AVX512DQ__ + if (strcmp (isa, "avx512dq") == 0) return true; +#endif +#ifdef __AVX512BW__ + if (strcmp (isa, "avx512bw") == 0) return true; +#endif +#ifdef __AVX512VL__ + if (strcmp (isa, "avx512vl") == 0) return true; +#endif +#ifdef __AVX512VBMI__ + if (strcmp (isa, "avx512vbmi") == 0) return true; +#endif +#ifdef __AVX512IFMA__ + if (strcmp (isa, "avx512ifma") == 0) return true; +#endif +#ifdef __AVX5124VNNIW__ + if (strcmp (isa, "avx5124vnniw") == 0) return true; +#endif +#ifdef __AVX512VBMI2__ + if (strcmp (isa, "avx512vbmi2") == 0) return true; +#endif +#ifdef __AVX512VNNI__ + if (strcmp (isa, "avx512vnni") == 0) return true; +#endif +#ifdef __PCONFIG__ + if (strcmp (isa, "pconfig") == 0) return true; +#endif +#ifdef __SGX__ + if (strcmp (isa, "sgx") == 0) return true; +#endif +#ifdef __AVX5124FMAPS__ + if (strcmp (isa, "avx5124fmaps") == 0) return true; +#endif +#ifdef __AVX512BITALG__ + if (strcmp (isa, "avx512bitalg") == 0) return true; +#endif +#ifdef __AVX512VPOPCNTDQ__ + if (strcmp (isa, "avx512vpopcntdq") == 0) return true; +#endif +#ifdef __FMA__ + if (strcmp (isa, "fma") == 0) return true; +#endif +#ifdef __RTM__ + if (strcmp (isa, "rtm") == 0) return true; +#endif +#ifdef __SSE4A__ + if (strcmp (isa, "sse4a") == 0) return true; +#endif +#ifdef __FMA4__ + if (strcmp (isa, "fma4") == 0) return true; +#endif +#ifdef __XOP__ + if (strcmp (isa, "xop") == 0) return true; +#endif +#ifdef __LWP__ + if (strcmp (isa, "lwp") == 0) return true; +#endif +#ifdef __ABM__ + if (strcmp (isa, "abm") == 0) return true; +#endif +#ifdef __BMI__ + if (strcmp (isa, "bmi") == 0) return true; +#endif +#ifdef __BMI2__ + if (strcmp (isa, "bmi2") == 0) return true; +#endif +#ifdef __LZCNT__ + if (strcmp (isa, "lzcnt") == 0) return true; +#endif +#ifdef __TBM__ + if (strcmp (isa, "tbm") == 0) return true; +#endif +#ifdef __CRC32__ + if (strcmp (isa, "crc32") == 0) return true; +#endif +#ifdef __POPCNT__ + if (strcmp (isa, "popcnt") == 0) return true; +#endif +#ifdef __FSGSBASE__ + if (strcmp (isa, "fsgsbase") == 0) return true; +#endif +#ifdef __RDRND__ + if (strcmp (isa, "rdrnd") == 0) return true; +#endif +#ifdef __F16C__ + if (strcmp (isa, "f16c") == 0) return true; +#endif +#ifdef __RDSEED__ + if (strcmp (isa, "rdseed") == 0) return true; +#endif +#ifdef __PRFCHW__ + if (strcmp (isa, "prfchw") == 0) return true; +#endif +#ifdef __ADX__ + if (strcmp (isa, "adx") == 0) return true; +#endif +#ifdef __FXSR__ + if (strcmp (isa, "fxsr") == 0) return true; +#endif +#ifdef __XSAVE__ + if (strcmp (isa, "xsave") == 0) return true; +#endif +#ifdef __XSAVEOPT__ + if (strcmp (isa, "xsaveopt") == 0) return true; +#endif +#ifdef __PREFETCHWT1__ + if (strcmp (isa, "prefetchwt1") == 0) return true; +#endif +#ifdef __CLFLUSHOPT__ + if (strcmp (isa, "clflushopt") == 0) return true; +#endif +#ifdef __CLZERO__ + if (strcmp (isa, "clzero") == 0) return true; +#endif +#ifdef __XSAVEC__ + if (strcmp (isa, "xsavec") == 0) return true; +#endif +#ifdef __XSAVES__ + if (strcmp (isa, "xsaves") == 0) return true; +#endif +#ifdef __CLWB__ + if (strcmp (isa, "clwb") == 0) return true; +#endif +#ifdef __MWAITX__ + if (strcmp (isa, "mwaitx") == 0) return true; +#endif +#ifdef __PKU__ + if (strcmp (isa, "pku") == 0) return true; +#endif +#ifdef __RDPID__ + if (strcmp (isa, "rdpid") == 0) return true; +#endif +#ifdef __GFNI__ + if (strcmp (isa, "gfni") == 0) return true; +#endif +#ifdef __SHSTK__ + if (strcmp (isa, "shstk") == 0) return true; +#endif +#ifdef __VAES__ + if (strcmp (isa, "vaes") == 0) return true; +#endif +#ifdef __VPCLMULQDQ__ + if (strcmp (isa, "vpclmulqdq") == 0) return true; +#endif +#ifdef __MOVDIRI__ + if (strcmp (isa, "movdiri") == 0) return true; +#endif +#ifdef __MOVDIR64B__ + if (strcmp (isa, "movdir64b") == 0) return true; +#endif +#ifdef __WAITPKG__ + if (strcmp (isa, "waitpkg") == 0) return true; +#endif +#ifdef __CLDEMOTE__ + if (strcmp (isa, "cldemote") == 0) return true; +#endif +#ifdef __SERIALIZE__ + if (strcmp (isa, "serialize") == 0) return true; +#endif +#ifdef __PTWRITE__ + if (strcmp (isa, "ptwrite") == 0) return true; +#endif +#ifdef __AVX512BF16__ + if (strcmp (isa, "avx512bf16") == 0) return true; +#endif +#ifdef __AVX512FP16__ + if (strcmp (isa, "avx512fp16") == 0) return true; +#endif +#ifdef __ENQCMD__ + if (strcmp (isa, "enqcmd") == 0) return true; +#endif +#ifdef __TSXLDTRK__ + if (strcmp (isa, "tsxldtrk") == 0) return true; +#endif +#ifdef __AMX_TILE__ + if (strcmp (isa, "amx-tile") == 0) return true; +#endif +#ifdef __AMX_INT8__ + if (strcmp (isa, "amx-int8") == 0) return true; +#endif +#ifdef __AMX_BF16__ + if (strcmp (isa, "amx-bf16") == 0) return true; +#endif +#ifdef __LAHF_SAHF__ + if (strcmp (isa, "sahf") == 0) return true; +#endif +#ifdef __MOVBE__ + if (strcmp (isa, "movbe") == 0) return true; +#endif +#ifdef __UINTR__ + if (strcmp (isa, "uintr") == 0) return true; +#endif +#ifdef __HRESET__ + if (strcmp (isa, "hreset") == 0) return true; +#endif +#ifdef __KL__ + if (strcmp (isa, "kl") == 0) return true; +#endif +#ifdef __WIDEKL__ + if (strcmp (isa, "widekl") == 0) return true; +#endif + + return false; +} diff --git a/libgomp/config/nvptx/selector.c b/libgomp/config/nvptx/selector.c new file mode 100644 index 00000000000..50b5f9020ac --- /dev/null +++ b/libgomp/config/nvptx/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 + . */ + +/* This file contains an implementation of GOMP_evaluate_current_device for + a Nvidia GPU. */ + +#include "libgomp.h" +#include + +bool +GOMP_evaluate_current_device (const char *kind, const char *arch, + const char *isa) +{ + if (kind && strcmp (kind, "gpu") != 0) + return false; + + if (arch && strcmp (arch, "nvptx") != 0) + return false; + + if (!isa) + return true; + + if (strcmp (isa, "sm_30") == 0) + return true; +#if __PTX_SM__ >= 350 + if (strcmp (isa, "sm_35") == 0) + return true; +#endif +#if __PTX_SM__ >= 530 + if (strcmp (isa, "sm_53") == 0) + return true; +#endif +#if __PTX_SM__ >= 750 + if (strcmp (isa, "sm_75") == 0) + return true; +#endif +#if __PTX_SM__ >= 800 + if (strcmp (isa, "sm_80") == 0) + return true; +#endif + + return false; +} 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 f98cccd8b66..9cb1313677f 100644 --- a/libgomp/libgomp.h +++ b/libgomp/libgomp.h @@ -1415,6 +1415,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..2b7d49bd533 100644 --- a/libgomp/libgomp.map +++ b/libgomp/libgomp.map @@ -414,6 +414,7 @@ GOMP_5.1 { GOMP_scope_start; GOMP_warning; GOMP_teams4; + GOMP_evaluate_target_device; } GOMP_5.0.1; GOMP_5.1.1 { 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 bc8131a6c2d..9025702c543 100644 --- a/libgomp/plugin/plugin-gcn.c +++ b/libgomp/plugin/plugin-gcn.c @@ -3984,6 +3984,20 @@ GOMP_OFFLOAD_async_run (int device, void *tgt_fn, void *tgt_vars, GOMP_PLUGIN_target_task_completion, async_data); } +bool +GOMP_OFFLOAD_evaluate_device (int device_num, const char *kind, + const char *arch, const char *isa) +{ + struct agent_info *agent = get_agent_info (device_num); + + if (kind && strcmp (kind, "gpu") != 0) + return false; + if (arch && strcmp (arch, "gcn") != 0) + return false; + + return !isa || isa_code (isa) == agent->device_isa; +} + /* }}} */ /* {{{ OpenACC Plugin API */ diff --git a/libgomp/plugin/plugin-nvptx.c b/libgomp/plugin/plugin-nvptx.c index c04c3acd679..9dcd8a6f6eb 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); @@ -2312,3 +2321,39 @@ GOMP_OFFLOAD_run (int ord, void *tgt_fn, void *tgt_vars, void **args) } /* TODO: Implement GOMP_OFFLOAD_async_run. */ + +#define CHECK_ISA(major, minor) \ + if (device->compute_major >= major && device->compute_minor >= minor \ + && strcmp (isa, "sm_"#major#minor) == 0) \ + return true + +bool +GOMP_OFFLOAD_evaluate_device (int device_num, const char *kind, + const char *arch, const char *isa) +{ + if (kind && strcmp (kind, "gpu") != 0) + return false; + if (arch && strcmp (arch, "nvptx") != 0) + 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..dc920ee065f --- /dev/null +++ b/libgomp/selector.c @@ -0,0 +1,36 @@ +/* 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 + . */ + +/* This file contains a placeholder implementation of + GOMP_evaluate_current_device. */ + +#include "libgomp.h" + +bool +GOMP_evaluate_current_device (const char *kind, const char *arch, + const char *isa) +{ + return false; +} diff --git a/libgomp/target.c b/libgomp/target.c index 1367e9cce6c..206987953dc 100644 --- a/libgomp/target.c +++ b/libgomp/target.c @@ -5088,6 +5088,43 @@ 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; + + if (device_num < 0) + 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 @@ -5140,6 +5177,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 (); From patchwork Sat Jan 6 18:52:52 2024 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Sandra Loosemore X-Patchwork-Id: 83460 Return-Path: X-Original-To: patchwork@sourceware.org Delivered-To: patchwork@sourceware.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 86559385773F for ; Sat, 6 Jan 2024 18:55:34 +0000 (GMT) X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from esa2.mentor.iphmx.com (esa2.mentor.iphmx.com [68.232.141.98]) by sourceware.org (Postfix) with ESMTPS id E92C53858418 for ; Sat, 6 Jan 2024 18:53:56 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org E92C53858418 Authentication-Results: sourceware.org; dmarc=none (p=none dis=none) header.from=codesourcery.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=mentor.com ARC-Filter: OpenARC Filter v1.0.0 sourceware.org E92C53858418 Authentication-Results: server2.sourceware.org; arc=none smtp.remote-ip=68.232.141.98 ARC-Seal: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1704567241; cv=none; b=U4heD2FeTWaE5Lcuv054MM74zopeCutpVmxv7W6Av2bskPAb1TDUXL8W+3+6hfKFTwGKt8TZFfVFKfkaeeozvNYPSc0LzY98AGbrAvGm389DUrb3liA1vALfT2kOVjB4qAu/8caeTiOebjxwWxbN537MSkq9jYAMq8dzN5daK04= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1704567241; c=relaxed/simple; bh=v4R7uhf2D/fTSTNzXdin3PjyR1h5h9oGgFbwGUxxeMs=; h=From:To:Subject:Date:Message-ID:MIME-Version; b=qLr9z4v7XxogPUrerya85MhHanIltHmncMU5ZUpKEvZ5+ruy4/Llt00MA+9odjSv1WdLgQ5zD42jof0Yfq8QzarKRYEEFJbF/8j8WyMREjpXCKsjGIuroR4QrW/Vb13krKrEf1CGtMnDLxH/7QUb+X2g1G3gtMuSfXLIsfxt3Vw= ARC-Authentication-Results: i=1; server2.sourceware.org X-CSE-ConnectionGUID: JqWNT01RRgmQern+J9DWnA== X-CSE-MsgGUID: eyg2XUHATba+FydrVcBS0w== X-IronPort-AV: E=Sophos;i="6.04,337,1695715200"; d="scan'208";a="30509740" Received: from orw-gwy-02-in.mentorg.com ([192.94.38.167]) by esa2.mentor.iphmx.com with ESMTP; 06 Jan 2024 10:53:55 -0800 IronPort-SDR: JbQ1cga7ytxY8NJJjnpn2qHzlQo0UAsk79HSEJH15MRpL16HzPESsi5PITRKo8OFU25An46qb2 ASq6DOyKUJFQ7s1XjdbTP4Hey2dw96oIJIv6mIj+XDa9iovFBR7iJ0HQ5ZhVehiZJhpJG9dOKB aGGrlQ6GkOjwCzkTEBIdgNiNUglK4cfy5cVwnbuDHag4nFq1R/Il4U6g4dSUprtfbQUcAc9Jly 2QmxTbZXMh/WRtUGfyb0evkkixGqC/H5jLHp0WBOWk3juqc6wDgAcEzjm8RWj+m6rT6rfdvlG9 7C0= From: Sandra Loosemore To: CC: , , Subject: [PATCH 4/8] OpenMP: C front end support for metadirectives Date: Sat, 6 Jan 2024 11:52:52 -0700 Message-ID: <20240106185257.126445-5-sandra@codesourcery.com> X-Mailer: git-send-email 2.34.1 In-Reply-To: <20240106185257.126445-1-sandra@codesourcery.com> References: <20240106185257.126445-1-sandra@codesourcery.com> MIME-Version: 1.0 X-ClientProxiedBy: svr-orw-mbx-10.mgc.mentorg.com (147.34.90.210) To svr-orw-mbx-13.mgc.mentorg.com (147.34.90.213) X-Spam-Status: No, score=-10.0 required=5.0 tests=BAYES_00, GIT_PATCH_0, HEADER_FROM_DIFFERENT_DOMAINS, KAM_DMARC_STATUS, SPF_HELO_PASS, SPF_PASS, TXREP, T_SCC_BODY_TEXT_LINE autolearn=ham autolearn_force=no version=3.4.6 X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on server2.sourceware.org X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.30 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: gcc-patches-bounces+patchwork=sourceware.org@gcc.gnu.org From: Kwok Cheung Yeung 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 flag. (c_parser_finish_omp_declare_variant): Adjust call. (analyze_metadirective_body): New. (c_parser_omp_metadirective): New. gcc/testsuite/ChangeLog * gcc.dg/gomp/metadirective-1.c: New. Co-Authored-By: Sandra Loosemore --- 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 3c2d75a0027..bad12c8119f 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 &); /* 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 5bceb9cb5d9..974f34594a8 100644 --- a/gcc/c-family/c-omp.cc +++ b/gcc/c-family/c-omp.cc @@ -4131,7 +4131,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, @@ -4161,7 +4161,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 }, @@ -4179,8 +4179,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. */ @@ -4263,3 +4263,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 &candidates, + hash_map &body_labels, + unsigned index) +{ + struct omp_metadirective_variant &candidate = candidates[index]; + tree if_block = push_stmt_list (); + if (candidate.directive != NULL_TREE) + add_stmt (candidate.directive); + 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 &candidates) +{ + hash_map 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 b3b3838b010..70c6fba90ba 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 * 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 }; @@ -7316,6 +7340,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: @@ -7387,6 +7423,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) { @@ -7614,8 +7653,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)) @@ -14617,6 +14659,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); @@ -24393,7 +24439,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 @@ -24539,12 +24585,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); @@ -24625,7 +24677,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 @@ -24650,7 +24703,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) @@ -24726,7 +24780,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); @@ -26297,6 +26352,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 &tokens, + vec &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 directive_tokens; + auto_vec body_tokens; + auto_vec body_labels; + auto_vec directives; + auto_vec ctxs; + vec 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 %, " + "%, or % 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 % or % " + "clauses in %"); + 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 " + "%"); + goto error; + } + if (omp_directive->kind == C_OMP_DIR_DECLARATIVE) + { + sorry_at (loc, "declarative directive variants of a " + "% 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 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 *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_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); + } +} From patchwork Sat Jan 6 18:52:53 2024 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Sandra Loosemore X-Patchwork-Id: 83461 Return-Path: X-Original-To: patchwork@sourceware.org Delivered-To: patchwork@sourceware.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 0D3C9385E02D for ; Sat, 6 Jan 2024 18:55:35 +0000 (GMT) X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from esa2.mentor.iphmx.com (esa2.mentor.iphmx.com [68.232.141.98]) by sourceware.org (Postfix) with ESMTPS id 222743857BA0 for ; Sat, 6 Jan 2024 18:54:00 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 222743857BA0 Authentication-Results: sourceware.org; dmarc=none (p=none dis=none) header.from=codesourcery.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=mentor.com ARC-Filter: OpenARC Filter v1.0.0 sourceware.org 222743857BA0 Authentication-Results: server2.sourceware.org; arc=none smtp.remote-ip=68.232.141.98 ARC-Seal: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1704567246; cv=none; b=TvCxh669nEJETOh9SPp3U2iJJ/tD3i/hR+r4zugR7lfY1HY4Jhf9A25ZwKN7PqprEvnx6euIeoihljLjUqv4gBSADpysAq4ADFWySSBPK7MmIqljjk1gQW5EcJwx0gtoHgOk5Nvig+AHNksshG2e/bfhKfTuRvudot8y0gkmcfM= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1704567246; c=relaxed/simple; bh=4Frla1hooUILAHmU/tBcVEYlwL+iGjEsyVzrS8A4v4c=; h=From:To:Subject:Date:Message-ID:MIME-Version; b=Hq9jbn/+dHpUkmsJ6QsW6jjrtLxlmkq2omlKBiR7ZRcD6zXzCYLiXvwL6hqF9HfoyfizeA4xyKCj2xVmByoU5bLl01lyl9qp0lg1a2xyOP5bQsCPVqTyzcx7xlbvvV+zg8tW6zLNuJNLVvdEwto3JWqJ6mpzHQcDRjKxnaXyd3g= ARC-Authentication-Results: i=1; server2.sourceware.org X-CSE-ConnectionGUID: JqWNT01RRgmQern+J9DWnA== X-CSE-MsgGUID: eqQQwYdWQGe539mGZs/oHQ== X-IronPort-AV: E=Sophos;i="6.04,337,1695715200"; d="scan'208";a="30509746" Received: from orw-gwy-02-in.mentorg.com ([192.94.38.167]) by esa2.mentor.iphmx.com with ESMTP; 06 Jan 2024 10:53:59 -0800 IronPort-SDR: 8m8BcMo6B9ztNidL+kKt/paSmkaY1uN2zhlA9QB7hLq11cREwz1Dr8BIpAec0o6gsROVqBcAUn 5vyu+MS++wwyHLaDI0Ap0fmi8ep/gewCrOTd7olDOKw5OqVWtZSxIVrL2L8rVz+v+Hhuw5dHte uC5aqLD1Ss0GKM0TdxKT/DhgK1feQu2G70l6RDvqk1x0vPP6MBMg/3ZjdaOY+EEYvAMWa1SMUY WlTGzSLDm7xpkZRJTjp3sOQtfsUbBuOJu5B69OxbodBJzCpkztPjKTocVZX4gmR0Om3B7zVCKD y/0= From: Sandra Loosemore To: CC: , , Subject: [PATCH 5/8] OpenMP: C++ front-end support for metadirectives Date: Sat, 6 Jan 2024 11:52:53 -0700 Message-ID: <20240106185257.126445-6-sandra@codesourcery.com> X-Mailer: git-send-email 2.34.1 In-Reply-To: <20240106185257.126445-1-sandra@codesourcery.com> References: <20240106185257.126445-1-sandra@codesourcery.com> MIME-Version: 1.0 X-ClientProxiedBy: svr-orw-mbx-10.mgc.mentorg.com (147.34.90.210) To svr-orw-mbx-13.mgc.mentorg.com (147.34.90.213) X-Spam-Status: No, score=-10.1 required=5.0 tests=BAYES_00, GIT_PATCH_0, HEADER_FROM_DIFFERENT_DOMAINS, KAM_DMARC_STATUS, SPF_HELO_PASS, SPF_PASS, TXREP, T_SCC_BODY_TEXT_LINE autolearn=ham autolearn_force=no version=3.4.6 X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on server2.sourceware.org X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.30 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: gcc-patches-bounces+patchwork=sourceware.org@gcc.gnu.org From: Kwok Cheung Yeung 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: Sandra Loosemore --- gcc/cp/parser.cc | 524 +++++++++++++++++- gcc/cp/parser.h | 7 + gcc/cp/pt.cc | 118 ++++ .../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, 1043 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 b864a9b5275..4ec4ed8a01c 100644 --- a/gcc/cp/parser.cc +++ b/gcc/cp/parser.cc @@ -2998,7 +2998,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 @@ -4174,9 +4174,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) @@ -4198,7 +4200,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; @@ -4217,6 +4219,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; @@ -12834,6 +12849,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: @@ -12936,7 +12963,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; @@ -14741,7 +14773,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; @@ -47431,7 +47471,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 @@ -47591,17 +47631,25 @@ cp_parser_omp_context_selector (cp_parser *parser, enum omp_tss_code set, while (1); break; case OMP_TRAIT_PROPERTY_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); @@ -47680,7 +47728,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 @@ -47707,7 +47756,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); @@ -48017,7 +48067,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); @@ -48650,6 +48701,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 &tokens, + vec &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 directive_tokens; + auto_vec body_tokens; + auto_vec body_labels; + auto_vec directives; + auto_vec ctxs; + bool default_seen = false; + int directive_token_idx = 0; + location_t pragma_loc = pragma_tok->location; + tree standalone_body = NULL_TREE; + vec 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 %, " + "%, or % 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 % or % " + "clauses in %"); + 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 " + "%"); + goto fail; + } + if (omp_directive->kind == C_OMP_DIR_DECLARATIVE) + { + sorry_at (loc, "declarative directive variants of a " + "% 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 *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_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 @@ -50582,6 +51076,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 8a40d3870ca..1e4ea425b72 100644 --- a/gcc/cp/parser.h +++ b/gcc/cp/parser.h @@ -443,6 +443,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 * 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 e38e7a773f0..e7a0186fb03 100644 --- a/gcc/cp/pt.cc +++ b/gcc/cp/pt.cc @@ -17694,6 +17694,78 @@ 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), + "% 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), + "% argument must be non-negative"); + score = NULL_TREE; + } + } + + switch (omp_ts_map[OMP_TS_CODE (sel)].tp_type) + { + case OMP_TRAIT_PROPERTY_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 @@ -19243,6 +19315,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 candidates + = omp_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..161bbf86bd5 --- /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\"\\\[0\\\], &\"amdgcn\"\\\[0\\\], &\"gfx906\"\\\[0\\\]\\)" "gimple" } } */ +/* { dg-final { scan-tree-dump "__builtin_GOMP_evaluate_target_device \\(num, &\"gpu\"\\\[0\\\], &\"nvptx\"\\\[0\\\], 0B\\)" "gimple" } } */ +/* { dg-final { scan-tree-dump "__builtin_GOMP_evaluate_target_device \\(num, &\"cpu\"\\\[0\\\], &\"x86_64\"\\\[0\\\], 0B\\)" "gimple" } } */ +/* { dg-final { scan-tree-dump "__builtin_GOMP_evaluate_target_device \\(-1, &\"gpu\"\\\[0\\\], &\"nvptx\"\\\[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 + +template 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 (n); + else + { +#pragma omp metadirective \ + when (user = {condition (tasking)}: task shared(i)) + i = fib (n - 1); +#pragma omp metadirective \ + when (user = {condition (score(10): tasking)}: task shared(j)) + j = fib (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 (n) != o) + __builtin_abort (); + if (fib (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 + +template 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 (n, false); + else + { +#pragma omp metadirective \ + when (user = {condition (tasking && flag)}: task shared(i)) + i = fib (n - 1, flag); +#pragma omp metadirective \ + when (user = {condition (score(10): tasking && flag)}: task shared(j)) + j = fib (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 (n, true) != o) + __builtin_abort (); + if (fib (n, false) != o) + __builtin_abort (); + if (fib (n, false) != o) + __builtin_abort (); + if (fib (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 + +template 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 (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 (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 (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 (n, true) != o) + __builtin_abort (); + if (fib (n, false) != o) + __builtin_abort (); + } + return 0; +} From patchwork Sat Jan 6 18:52:54 2024 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Sandra Loosemore X-Patchwork-Id: 83464 Return-Path: X-Original-To: patchwork@sourceware.org Delivered-To: patchwork@sourceware.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 5917C3857B8B for ; Sat, 6 Jan 2024 18:56:29 +0000 (GMT) X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from esa1.mentor.iphmx.com (esa1.mentor.iphmx.com [68.232.129.153]) by sourceware.org (Postfix) with ESMTPS id 294143858D32 for ; Sat, 6 Jan 2024 18:54:38 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 294143858D32 Authentication-Results: sourceware.org; dmarc=none (p=none dis=none) header.from=codesourcery.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=mentor.com ARC-Filter: OpenARC Filter v1.0.0 sourceware.org 294143858D32 Authentication-Results: server2.sourceware.org; arc=none smtp.remote-ip=68.232.129.153 ARC-Seal: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1704567287; cv=none; b=qDIJXJkj1o3vz3atTStCMqTKaz0B7JnljidNxQCbEV3Q33pIUV4NaOVdwQ6pB6YJuP6HFMqaEpW8m0y4orbhpNyosGSRQWFTyX9tlk3GpdJoADZqag8YU1qJ3Qsb2wfx5hjOEH8ROcRM4MnjvlVoMid26B4FAzvDWEoXqwr1K3g= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1704567287; c=relaxed/simple; bh=njV8FnwyTPM0Bl1sB1v/d85yQdoq62KgAHKBA4IK+2k=; h=From:To:Subject:Date:Message-ID:MIME-Version; b=ZInKtIY5Nu3nVhtgOTz+KA25qaOrqSR1TiiGEFXA712JMJPouXNCd3y3NDldeNWxUJLAFMoSwuR/l6oYpFxQDpKqGX41K5wJXdMjRfBqNh0p3CgMWpSEh4fUA369wrg6d1CsofjVQFVbeEH2n2fxfoBMB0+P+Vl9sqzITTwgu7U= ARC-Authentication-Results: i=1; server2.sourceware.org X-CSE-ConnectionGUID: A0ufJUGjQOqi70e/GHZ7eg== X-CSE-MsgGUID: gEIBq2qXTZ+qc6So51YHTA== X-IronPort-AV: E=Sophos;i="6.04,337,1695715200"; d="scan'208";a="30827348" Received: from orw-gwy-02-in.mentorg.com ([192.94.38.167]) by esa1.mentor.iphmx.com with ESMTP; 06 Jan 2024 10:54:37 -0800 IronPort-SDR: LgZLriPQ2ZnVOJzvTVJYePjBloGeK/o+ijIXk9FKasHN7Xhll4OO5zVBmvf1ik6dVDE5/kYcBd gfZ1lIRZSBOCapsrQM83c/7ksRmXMxS/SeWKQL5zH55KeX5+UkS7rFzDXAuLBDBjfaDCX01X54 V7Mxm2E/nO8KXa+qeGJfDlQ7AiGFNGd+0rT05Jt18YDbjQp57Ajk3eKQd/Wp3LvCmaCzazQiqa Nz3PjtZnjsV0yDZoDuerjXidBABIwe4VsrzRxGPSp4fvm7FnDDjk1463Mi3a4w9wJ8OYpYmX5Z pZw= From: Sandra Loosemore To: CC: , , Subject: [PATCH 6/8] OpenMP: common c/c++ testcases for metadirectives Date: Sat, 6 Jan 2024 11:52:54 -0700 Message-ID: <20240106185257.126445-7-sandra@codesourcery.com> X-Mailer: git-send-email 2.34.1 In-Reply-To: <20240106185257.126445-1-sandra@codesourcery.com> References: <20240106185257.126445-1-sandra@codesourcery.com> MIME-Version: 1.0 X-ClientProxiedBy: svr-orw-mbx-10.mgc.mentorg.com (147.34.90.210) To svr-orw-mbx-13.mgc.mentorg.com (147.34.90.213) X-Spam-Status: No, score=-10.1 required=5.0 tests=BAYES_00, GIT_PATCH_0, HEADER_FROM_DIFFERENT_DOMAINS, KAM_DMARC_STATUS, SPF_HELO_PASS, SPF_PASS, TXREP, T_SCC_BODY_TEXT_LINE autolearn=ham autolearn_force=no version=3.4.6 X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on server2.sourceware.org X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.30 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: gcc-patches-bounces+patchwork=sourceware.org@gcc.gnu.org From: Kwok Cheung Yeung 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: Sandra Loosemore --- .../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..cf695aa24cb --- /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\"\\\[0\\\], &\"amdgcn\"\\\[0\\\], &\"gfx906\"\\\[0\\\]\\)" "gimple" } } */ +/* { dg-final { scan-tree-dump "__builtin_GOMP_evaluate_target_device \\(num, &\"gpu\"\\\[0\\\], &\"nvptx\"\\\[0\\\], 0B\\)" "gimple" } } */ +/* { dg-final { scan-tree-dump "__builtin_GOMP_evaluate_target_device \\(num, &\"cpu\"\\\[0\\\], &\"x86_64\"\\\[0\\\], 0B\\)" "gimple" } } */ +/* { dg-final { scan-tree-dump "__builtin_GOMP_evaluate_target_device \\(-1, &\"gpu\"\\\[0\\\], &\"nvptx\"\\\[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 + +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 + +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 + +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 + +#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 + +#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 +#include + +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; +} From patchwork Sat Jan 6 18:52:55 2024 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Sandra Loosemore X-Patchwork-Id: 83462 Return-Path: X-Original-To: patchwork@sourceware.org Delivered-To: patchwork@sourceware.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 32150385782D for ; Sat, 6 Jan 2024 18:55:35 +0000 (GMT) X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from esa1.mentor.iphmx.com (esa1.mentor.iphmx.com [68.232.129.153]) by sourceware.org (Postfix) with ESMTPS id 23F843858C60 for ; Sat, 6 Jan 2024 18:54:41 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 23F843858C60 Authentication-Results: sourceware.org; dmarc=none (p=none dis=none) header.from=codesourcery.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=mentor.com ARC-Filter: OpenARC Filter v1.0.0 sourceware.org 23F843858C60 Authentication-Results: server2.sourceware.org; arc=none smtp.remote-ip=68.232.129.153 ARC-Seal: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1704567291; cv=none; b=mFM0nczANesmXXDNzgncWI456ZuGe7MVIFm831vrd2vQCRmqqOYQHD2cg1QBqUwifrSGz0tDre8WW3uOjs+phZPdbhQtLlMIiAsNHFh7+bkNBfKmXGp8BLrReKBF0Gsi/VI/dBqddaqH8lks611M5hOizOWRPXbPCE5chqq1MDY= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1704567291; c=relaxed/simple; bh=rl7uDk+7kCz8flTCdtZdlQuMCFOPC+k5uN7BJRzf3lM=; h=From:To:Subject:Date:Message-ID:MIME-Version; b=AYjaP5dKgHQs4C30PXIaTCGk3XNaAg3gr3MR6AE5C/WBhV3Rlw/WeKaLxInWCvQv4y1JJMrf7pJL7JRaH3M6DPOIB5iXCjo7Dm3veuDr5bKA2CduK7GxOGn+dkefEn6RkfU63gZWTD53VMiMvtEH7RcKjAl5AH9/wwevnOpmlE0= ARC-Authentication-Results: i=1; server2.sourceware.org X-CSE-ConnectionGUID: A0ufJUGjQOqi70e/GHZ7eg== X-CSE-MsgGUID: jSlgr5CnS4KiKioU/GBgsg== X-IronPort-AV: E=Sophos;i="6.04,337,1695715200"; d="scan'208";a="30827357" Received: from orw-gwy-02-in.mentorg.com ([192.94.38.167]) by esa1.mentor.iphmx.com with ESMTP; 06 Jan 2024 10:54:40 -0800 IronPort-SDR: Wc3caJnwMRanPCdrHUrHtCH4N/T9OiNH40t53A4d5E01hRox0/C5unhKWFJm0yisdFKp07SF/W 62iKlFjKcRXNmI8Z/awsnFCFUaEHo6zlepi3Zx2QFg7gtd5B4kF/EKc6bOGIykx6V3el6v+Fh2 TYqTHeBC9V7Q8L473x5qLA2TYtIqiQROt76RJlcl60v6fAtWfr95BfxzghHJBVLdpFA0hsRt0d jFDCNI2L1DukSfMt+5uVfZLBsMX/FrLIGAWglsCY60jUyxA/u157zys1Ng4B1Ng5pEwluwowUf U0o= From: Sandra Loosemore To: CC: , , Subject: [PATCH 7/8] OpenMP: Fortran front-end support for metadirectives. Date: Sat, 6 Jan 2024 11:52:55 -0700 Message-ID: <20240106185257.126445-8-sandra@codesourcery.com> X-Mailer: git-send-email 2.34.1 In-Reply-To: <20240106185257.126445-1-sandra@codesourcery.com> References: <20240106185257.126445-1-sandra@codesourcery.com> MIME-Version: 1.0 X-ClientProxiedBy: svr-orw-mbx-10.mgc.mentorg.com (147.34.90.210) To svr-orw-mbx-13.mgc.mentorg.com (147.34.90.213) X-Spam-Status: No, score=-10.1 required=5.0 tests=BAYES_00, GIT_PATCH_0, HEADER_FROM_DIFFERENT_DOMAINS, KAM_DMARC_STATUS, SPF_HELO_PASS, SPF_PASS, TXREP, T_SCC_BODY_TEXT_LINE autolearn=ham autolearn_force=no version=3.4.6 X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on server2.sourceware.org X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.30 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: gcc-patches-bounces+patchwork=sourceware.org@gcc.gnu.org From: Kwok Cheung Yeung 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_metadirective_variant): New. (struct gfc_st_label): Add omp_region field. (gfc_exec_op): Add EXEC_OMP_METADIRECTIVE. (struct gfc_code): Add omp_metadirective_variants field. (gfc_free_omp_metadirective_variants): Declare. (match_omp_directive): Declare. (is_omp_declarative_stmt): Declare. (gfc_skip_omp_metadirective_variant): 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_metadirective_variants): New. (gfc_match_omp_clauses): Remove context_selector parameter, use global state variable gfc_matching_omp_context_selector instead. (match_omp): Adjust call to gfc_match_omp_clauses, set gfc_matching_omp_context_selector instead. (gfc_match_omp_context_selector): Likewise. (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 (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. (gfc_skip_omp_metadirective_variant): 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: Sandra Loosemore Co-Authored-By: Tobias Burnus Co-Authored-By: Paul-Antoine Arras --- gcc/fortran/decl.cc | 29 + gcc/fortran/dump-parse-tree.cc | 21 + gcc/fortran/gfortran.h | 24 +- gcc/fortran/io.cc | 2 +- gcc/fortran/match.h | 2 + gcc/fortran/openmp.cc | 265 +++++++- 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 | 239 +++++--- 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, 1937 insertions(+), 353 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 503ecb8d9b5..0ab2e710e78 100644 --- a/gcc/fortran/decl.cc +++ b/gcc/fortran/decl.cc @@ -8404,6 +8404,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; @@ -8411,6 +8412,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; } @@ -8556,6 +8579,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 1563b810b98..204c6b60a1f 100644 --- a/gcc/fortran/dump-parse-tree.cc +++ b/gcc/fortran/dump-parse-tree.cc @@ -2162,6 +2162,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; @@ -2359,6 +2360,25 @@ show_omp_node (int level, gfc_code *c) d = d->block; } } + else if (c->op == EXEC_OMP_METADIRECTIVE) + { + gfc_omp_metadirective_variant *variant + = c->ext.omp_metadirective_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) @@ -3493,6 +3513,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 82f388c05f8..7adc98fccf1 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, @@ -1583,7 +1584,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; ENUM_BITFIELD (gfc_omp_sched_kind) sched_kind:3; ENUM_BITFIELD (gfc_omp_device_type) device_type:2; @@ -1703,6 +1704,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_metadirective_variant +{ + struct gfc_omp_metadirective_variant *next; + locus where; /* Where the metadirective clause occurred. */ + + gfc_omp_set_selector *selectors; + enum gfc_statement stmt; + struct gfc_code *code; + +} gfc_omp_metadirective_variant; +#define gfc_get_omp_metadirective_variant() XCNEW (gfc_omp_metadirective_variant) typedef struct gfc_omp_udr { @@ -1751,6 +1763,7 @@ typedef struct gfc_st_label locus where; gfc_namespace *ns; + int omp_region; } gfc_st_label; @@ -3009,6 +3022,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 }; @@ -3067,6 +3081,7 @@ typedef struct gfc_code gfc_omp_clauses *omp_clauses; const char *omp_name; gfc_omp_namelist *omp_namelist; + gfc_omp_metadirective_variant *omp_metadirective_variants; bool omp_bool; } ext; /* Points to additional structures required by statement */ @@ -3661,6 +3676,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_metadirective_variants (gfc_omp_metadirective_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 *); @@ -3942,6 +3958,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); @@ -4038,4 +4056,8 @@ bool gfc_is_reallocatable_lhs (gfc_expr *); void finish_oacc_declare (gfc_namespace *, gfc_symbol *, bool); void gfc_adjust_builtins (void); +/* trans-openmp.c */ + +bool gfc_skip_omp_metadirective_variant (gfc_omp_metadirective_variant *); + #endif /* GCC_GFORTRAN_H */ 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 0af80d54fad..b602d9aa34d 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; @@ -339,6 +348,19 @@ gfc_free_omp_udr (gfc_omp_udr *omp_udr) } } +/* Free variants of an !$omp metadirective construct. */ + +void +gfc_free_omp_metadirective_variants (gfc_omp_metadirective_variant *variant) +{ + while (variant) + { + gfc_omp_metadirective_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) @@ -1866,8 +1888,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 (); @@ -3789,9 +3810,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"); @@ -4479,7 +4498,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; @@ -5810,14 +5829,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) { @@ -5874,7 +5896,7 @@ 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) { do { @@ -5907,9 +5929,9 @@ 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) return MATCH_ERROR; @@ -6010,7 +6032,8 @@ 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) + != MATCH_YES) return MATCH_ERROR; if (gfc_match (" )") != MATCH_YES) @@ -6026,6 +6049,157 @@ gfc_match_omp_declare_variant (void) } +static match +match_omp_metadirective (bool begin_p) +{ + locus old_loc = gfc_current_locus; + gfc_omp_metadirective_variant *variants_head; + gfc_omp_metadirective_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 %, %, or % at %C"); + gfc_current_locus = old_loc; + return MATCH_ERROR; + } + + if (default_p && default_seen) + { + gfc_error ("too many % or % clauses " + "in % at %C"); + gfc_current_locus = old_loc; + return MATCH_ERROR; + } + + if (!default_p) + { + if (gfc_match_omp_context_selector_specification (&selectors) + != 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_metadirective_variant *omv = gfc_get_omp_metadirective_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; + } + + if (!gfc_skip_omp_metadirective_variant (omv)) + { + *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_metadirective_variant *omv = gfc_get_omp_metadirective_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_metadirective_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) { @@ -10919,6 +11093,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_metadirective_variant *variant = code->ext.omp_metadirective_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) @@ -11462,13 +11649,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_metadirective_variant *mc + = c->ext.omp_metadirective_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) @@ -11595,6 +11801,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 d8b38cfb5ac..f23045636c9 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) { @@ -1935,6 +1955,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(). */ @@ -2572,6 +2629,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; @@ -2671,6 +2731,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; @@ -2815,6 +2878,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"; @@ -3075,6 +3141,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 (); @@ -5386,6 +5454,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. */ @@ -5436,94 +5638,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) @@ -5835,80 +5959,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; @@ -5954,11 +6013,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: @@ -6131,6 +6192,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_metadirective_variant *variant + = new_st.ext.omp_metadirective_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 @@ -6141,6 +6284,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) @@ -6148,6 +6292,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) @@ -6257,68 +6407,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; @@ -6332,6 +6427,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; } @@ -7097,6 +7205,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 */ @@ -7409,3 +7521,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 6148ed94fe1..5858b3a88dc 100644 --- a/gcc/fortran/resolve.cc +++ b/gcc/fortran/resolve.cc @@ -12261,6 +12261,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_metadirective_variant *variant + = code->ext.omp_metadirective_variants; + variant; variant = variant->next) + gfc_resolve_code (variant->code, ns); else if (code->block) { omp_workshare_save = -1; @@ -12793,6 +12798,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..9d6cc974083 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_metadirective_variants (p->ext.omp_metadirective_variants); + break; + default: gfc_internal_error ("gfc_free_statement(): Bad statement"); } diff --git a/gcc/fortran/symbol.cc b/gcc/fortran/symbol.cc index fddf68f8398..cd1de989eab 100644 --- a/gcc/fortran/symbol.cc +++ b/gcc/fortran/symbol.cc @@ -2630,10 +2630,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; } @@ -2683,6 +2686,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; @@ -2699,10 +2703,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; @@ -2714,6 +2724,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 de162f6cc75..a17f6582d81 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 439ae5f9f55..2b72862d62b 100644 --- a/gcc/fortran/trans-openmp.cc +++ b/gcc/fortran/trans-openmp.cc @@ -8228,6 +8228,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: @@ -8319,6 +8321,104 @@ gfc_trans_omp_declare_simd (gfc_namespace *ns) } } +/* Translate the context selector list GFC_SELECTORS, using WHERE as the + locus for error messages. CONV_EXPR_P is true for normal translation + and false for early conversion during parsing. */ + +static tree +gfc_trans_omp_set_selector (gfc_omp_set_selector *gfc_selectors, locus where, + bool conv_expr_p) +{ + 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_EXPR: + { + tree expr = NULL_TREE; + if (conv_expr_p) + { + 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) { @@ -8394,89 +8494,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_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, true); 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) @@ -8577,3 +8596,57 @@ 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_metadirective_variant *variant = code->ext.omp_metadirective_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, true); + ctx = omp_check_context_selector (gfc_get_location (&variant->where), + ctx, true); + if (ctx == error_mark_node) + return error_mark_node; + + 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; +} + +/* Hook to check during parsing whether a metadirective is both resolvable + and non-matching; if so, it can be eliminated immediately. */ +bool +gfc_skip_omp_metadirective_variant (gfc_omp_metadirective_variant *variant) +{ + tree selector = gfc_trans_omp_set_selector (variant->selectors, + variant->where, false); + return omp_context_selector_matches (selector, true, true) == 0; +} 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 1a03a4a91d4..7e3089dfc8b 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..870ea192fbc --- /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\"\\\[0\\\], &\"amdgcn\"\\\[0\\\], &\"gfx906\"\\\[0\\\]\\)" "gimple" } } +! { dg-final { scan-tree-dump "__builtin_GOMP_evaluate_target_device \\(.+, &\"gpu\"\\\[0\\\], &\"nvptx\"\\\[0\\\], 0B\\)" "gimple" } } +! { dg-final { scan-tree-dump "__builtin_GOMP_evaluate_target_device \\(.+, &\"cpu\"\\\[0\\\], &\"x86_64\"\\\[0\\\], 0B\\)" "gimple" } } +! { dg-final { scan-tree-dump "__builtin_GOMP_evaluate_target_device \\(-1, &\"gpu\"\\\[0\\\], &\"nvptx\"\\\[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..3f46801e044 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/metadirective-8.f90 @@ -0,0 +1,22 @@ +! { dg-do compile } +! { dg-additional-options "-fdump-tree-original" } + +program test + integer :: i + integer, parameter :: N = 100 + integer :: sum = 0 + + ! The compiler should never consider a situation where both metadirectives + ! match. If it does, then the nested metadirective would be an error + ! as it is not a loop-nest as per the OpenMP specification. + + !$omp metadirective when (implementation={vendor("ibm")}: & + !$omp& target teams distribute) + !$omp metadirective when (implementation={vendor("gnu")}: parallel do) + do i = 1, N + sum = sum + i + end do +end program + +! { dg-final { scan-tree-dump-not "when \\(implementation = .*vendor.*ibm.*\\):" "original" } } +! { dg-final { scan-tree-dump-times "when \\(implementation = .*vendor.*gnu.*\\):" 1 "original" } } 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 From patchwork Sat Jan 6 18:52:56 2024 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Sandra Loosemore X-Patchwork-Id: 83463 Return-Path: X-Original-To: patchwork@sourceware.org Delivered-To: patchwork@sourceware.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 5F8DD385DC08 for ; Sat, 6 Jan 2024 18:56:25 +0000 (GMT) X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from esa1.mentor.iphmx.com (esa1.mentor.iphmx.com [68.232.129.153]) by sourceware.org (Postfix) with ESMTPS id 3FD793858C30 for ; Sat, 6 Jan 2024 18:54:44 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 3FD793858C30 Authentication-Results: sourceware.org; dmarc=none (p=none dis=none) header.from=codesourcery.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=mentor.com ARC-Filter: OpenARC Filter v1.0.0 sourceware.org 3FD793858C30 Authentication-Results: server2.sourceware.org; arc=none smtp.remote-ip=68.232.129.153 ARC-Seal: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1704567287; cv=none; b=r8KocsdwM/y2ZiOEof7r3YvrQPFjl5hSxdYOFwS263uu9vbFYPSWVbxIek2zr9fCXV5xgsecyTpLEeQDiI3h+XQ+Ab9mPqt9W+XhUJL98GF31RZxJHaend774Dgajxslg+5e4fCFuhCtN/79a8P2klLKG9GFb8aeNJu9ti7Rr74= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1704567287; c=relaxed/simple; bh=KzDcNo6h8Rrm4jQdHE3fJIYxuueQVWcFzAmkwlbWa+s=; h=From:To:Subject:Date:Message-ID:MIME-Version; b=P/nqkpclQQszbJcrT/fGQa+kNFsECfiqvzx7SIKU/qkMHNNXScgm3MKq1ziAVASnGWE29V9SiqlGvou+qSWny1RfaGi/8V1VCc2FMUTpnDrrV4fwVxebmS5g6tnngUgbGu8nBFKFp3f+RewdblULwUpfB2x+xG7OuwBqTX2O2Gw= ARC-Authentication-Results: i=1; server2.sourceware.org X-CSE-ConnectionGUID: A0ufJUGjQOqi70e/GHZ7eg== X-CSE-MsgGUID: /ZrRIXeISaaitAO2ma3hBw== X-IronPort-AV: E=Sophos;i="6.04,337,1695715200"; d="scan'208";a="30827365" Received: from orw-gwy-02-in.mentorg.com ([192.94.38.167]) by esa1.mentor.iphmx.com with ESMTP; 06 Jan 2024 10:54:43 -0800 IronPort-SDR: SD6Go3SD4I91D5a422HNXR9lJ6UQMAp9fSOUL1aTfdMW/tZwFux58aSpLbD/+80K/aA/Lj/3CS SVNp7yRGMwbTJyhm9Ywy+PVcWt0Q7IA/gZFp3OuPdY+KOP+TEdVosgo1TNf4KLkehIPopgibAE M5xd+A/RR9CzzQgpqyvroCkSmX4ohADWANbo7ITzbT6F+DeabI77LGzWsWTVZ6lZjYlMfYcoK9 +zIozy1cxsRaBplxrTADHoVsiF31vpaWjtu0uYRDNcE5iniGeuN3NXl2LCwgtRAdaiiyYU7563 +XI= From: Sandra Loosemore To: CC: , , Subject: [PATCH 8/8] OpenMP: Update documentation of metadirective implementation status. Date: Sat, 6 Jan 2024 11:52:56 -0700 Message-ID: <20240106185257.126445-9-sandra@codesourcery.com> X-Mailer: git-send-email 2.34.1 In-Reply-To: <20240106185257.126445-1-sandra@codesourcery.com> References: <20240106185257.126445-1-sandra@codesourcery.com> MIME-Version: 1.0 X-ClientProxiedBy: svr-orw-mbx-10.mgc.mentorg.com (147.34.90.210) To svr-orw-mbx-13.mgc.mentorg.com (147.34.90.213) X-Spam-Status: No, score=-10.1 required=5.0 tests=BAYES_00, GIT_PATCH_0, HEADER_FROM_DIFFERENT_DOMAINS, KAM_DMARC_STATUS, SPF_HELO_PASS, SPF_PASS, TXREP, T_SCC_BODY_TEXT_LINE autolearn=ham autolearn_force=no version=3.4.6 X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on server2.sourceware.org X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.30 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: gcc-patches-bounces+patchwork=sourceware.org@gcc.gnu.org libgomp/ChangeLog * libgomp.texi (OpenMP 5.0): Mark metadirective as implemented. (OpenMP 5.1): Mark target_device as partially supported. (OpenMP 5.2): Mark otherwise clause as supported, note that default is also still accepted. --- libgomp/libgomp.texi | 15 ++++++++++----- 1 file changed, 10 insertions(+), 5 deletions(-) diff --git a/libgomp/libgomp.texi b/libgomp/libgomp.texi index c727850397d..8ef22086653 100644 --- a/libgomp/libgomp.texi +++ b/libgomp/libgomp.texi @@ -192,7 +192,7 @@ 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{metadirective} directive @tab Y @tab @item @code{declare variant} directive @tab P @tab @emph{simd} traits not handled correctly @item @var{target-offload-var} ICV and @code{OMP_TARGET_OFFLOAD} @@ -289,8 +289,11 @@ 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 P + @tab Supported only for @code{metadirective}. + The @code{declare variant} construct does not yet support dynamic + selectors. @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 @@ -413,8 +416,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}