From patchwork Tue Apr 27 13:36:38 2021 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Tobias Burnus X-Patchwork-Id: 1470706 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Authentication-Results: ozlabs.org; spf=pass (sender SPF authorized) smtp.mailfrom=gcc.gnu.org (client-ip=8.43.85.97; helo=sourceware.org; envelope-from=gcc-patches-bounces@gcc.gnu.org; receiver=) Received: from sourceware.org (ip-8-43-85-97.sourceware.org [8.43.85.97]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange X25519 server-signature RSA-PSS (4096 bits) server-digest SHA256) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 4FV2rJ17Myz9sW1 for ; Tue, 27 Apr 2021 23:37:34 +1000 (AEST) Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 397EF399242F; Tue, 27 Apr 2021 13:36:58 +0000 (GMT) X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from esa4.mentor.iphmx.com (esa4.mentor.iphmx.com [68.232.137.252]) by sourceware.org (Postfix) with ESMTPS id 045B0398E474; Tue, 27 Apr 2021 13:36:46 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.3.2 sourceware.org 045B0398E474 Authentication-Results: sourceware.org; dmarc=none (p=none dis=none) header.from=codesourcery.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=Tobias_Burnus@mentor.com IronPort-SDR: 7790k8dG04E2WstCAA3gqbba3jbCN3kWcBc8uUXAKvRvh8ZnH2s7bIlOODfl0OUAALsSRp9WIO 54d/Y1F4XU8a9TxiUyN6itJ9dprRq9QjFZX0Q5SoNoGo65yRH69xqy/XY1vlyqg1xGfb2tEPjo ssYW0Tf7cKle+l6yDiZ0lMTuvZhFzIPuN/CjP9fXyaMFYhQ+JaeLHW7oDjJt3QC1+mEgUu1e5Q PVXFGihrR2xsJSl+iO9Dvj2LVmsC3QX+FtNSVmZN7Iyn/2ym9cVXjLT14H8oTFmLJKu+SHgT3S yHU= X-IronPort-AV: E=Sophos;i="5.82,254,1613462400"; d="diff'?scan'208";a="60702673" Received: from orw-gwy-02-in.mentorg.com ([192.94.38.167]) by esa4.mentor.iphmx.com with ESMTP; 27 Apr 2021 05:36:45 -0800 IronPort-SDR: AypLpAuta8P0eOar9bILJVmq1IqCKQzE5Dnvfp4B78n173+SBZSgoUKi1+InZbDLPqo4ZwZfIN 4nEaTKOqxHFJM4cKRm32AUQ707jmFpE/oZtOvx/ox/Ta86baqHlrktA7R8a2ntZ7bI5tHICtGw oqDgQThlO+nqNGotKTz2RbDAZvoCw1P3KewChDBoyrNwyLO34SuIGBnyjjIACNFXeKFydZerb+ /knozBcMKY9ZiM8D+jsd960l2I7h+RPrHSEHCa67wsp/Dlba6Zd3aLBzSJoYVcSDmrCbaZI4MI Jsw= From: Tobias Burnus Subject: [Patch] OpenMP: Add iterator support to Fortran's depend; add affinity clause To: gcc-patches , fortran , Jakub Jelinek Message-ID: <923778bf-f61e-7bd0-7926-53d28434fdab@codesourcery.com> Date: Tue, 27 Apr 2021 15:36:38 +0200 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:78.0) Gecko/20100101 Thunderbird/78.10.0 MIME-Version: 1.0 Content-Language: en-US X-Originating-IP: [137.202.0.90] X-ClientProxiedBy: SVR-IES-MBX-04.mgc.mentorg.com (139.181.222.4) To svr-ies-mbx-01.mgc.mentorg.com (139.181.222.1) X-Spam-Status: No, score=-11.9 required=5.0 tests=BAYES_00, GIT_PATCH_0, HEADER_FROM_DIFFERENT_DOMAINS, KAM_DMARC_STATUS, SPF_HELO_PASS, SPF_PASS, TXREP autolearn=ham autolearn_force=no version=3.4.2 X-Spam-Checker-Version: SpamAssassin 3.4.2 (2018-09-13) on server2.sourceware.org X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: gcc-patches-bounces@gcc.gnu.org Sender: "Gcc-patches" OpenMP 5's iterator can be used for - depend clause - affinity clause - mapping (unsupported and not touched) (a) This patch add the iterator support to the Fortran FE and adds support for it to the depend clause. (b) It also adds a conforming stub implementation (parse & ignore in ME) for 'affinity' (Fortran, C, C++) (c) Fortran's taskwait did not handle the depend clause, now it does. The way the iterator is stored in Fortran is a bit convoluted, but should be fine: new namespace (such that symbols can be overridden and resolution works), using symbol->value for the iteration (begin:end:step) as array constructor, and abusing the ns->proc_name + its '->tlink' to generate an linked list, which avoids walking the ns->sym_root tree and has the user's order in the dump instead of the tree-walking order. The ME implementation also seems to require a very special way the variables are stored. – It seems as if it works correctly for depend; hence, I hope I did correctly read the dump and tree sharing is correctly handled. NOTE: The iterator Fortran patch includes one change from the post-OpenMP-5.0 spec: The '::' after the typespec in order to avoid Fortran free-form source issues with: 'iterator(integer i=1:10)' – namely: is this the integer 'i' or the variable 'integeri' (as spaces are ignored in fixed-form Fortran)? NOTE 2: The way it is implemented, the 'begin:end:step' expression is evaluated multiple times - once per list item; I think this matches C, but I am not completely sure nor whether that is a problem. (Unlikely a real-world problem.) NOTE 3: I did have some trouble reading the spec with regards to what in C is permitted for 'affinity' ('locator-list); the code now mostly follows what is permitted for 'depend'. OK? Tobias ----------------- Mentor Graphics (Deutschland) GmbH, Arnulfstrasse 201, 80634 München Registergericht München HRB 106955, Geschäftsführer: Thomas Heurung, Frank Thürauf OpenMP: Add iterator support to Fortran's depend; add affinity clause gcc/c-family/ChangeLog: * c-pragma.h (enum pragma_omp_clause): Add PRAGMA_OMP_CLAUSE_AFFINITY. gcc/c/ChangeLog: * c-parser.c (c_parser_omp_clause_affinity): New. (c_parser_omp_clause_name, c_parser_omp_variable_list, c_parser_omp_all_clauses, OMP_TASK_CLAUSE_MASK): Handle affinity clause. * c-typeck.c (handle_omp_array_sections_1, handle_omp_array_sections, c_finish_omp_clauses): Likewise. gcc/cp/ChangeLog: * parser.c (cp_parser_omp_clause_affinity): New. (cp_parser_omp_clause_name, cp_parser_omp_var_list_no_open, cp_parser_omp_all_clauses, OMP_TASK_CLAUSE_MASK): Handle affinity clause. * semantics.c (handle_omp_array_sections_1, handle_omp_array_sections, finish_omp_clauses): Likewise. gcc/fortran/ChangeLog: * dump-parse-tree.c (show_iterator): New. (show_omp_namelist): Handle iterators. (show_omp_clauses): Handle affinity. * gfortran.h (gfc_free_omp_namelist): New union with 'udr' and new 'ns'. * match.c (gfc_free_omp_namelist): Add are to choose union element. * openmp.c (gfc_free_omp_clauses, gfc_match_omp_detach): Update call to gfc_free_omp_namelist. (gfc_match_omp_variable_list): Likewise; permit preceeding whitespace. (enum omp_mask1): (gfc_match_iterator): New. (gfc_match_omp_clause_reduction): (gfc_match_omp_clauses): (gfc_match_omp_flush): (gfc_match_omp_taskwait): Match depend clause. (resolve_omp_clauses): Handle affinity; update for udr/union change. (gfc_resolve_omp_directive): Resolve clauses of taskwait. * st.c (gfc_free_statement): Update gfc_free_omp_namelist call. * trans-openmp.c (gfc_trans_omp_array_reduction_or_udr): Likewise (handle_iterator): New. (gfc_trans_omp_clauses): Handle iterators for depend/affinity clause. (gfc_trans_omp_taskwait): Handle depend clause. (gfc_trans_omp_directive): Update call. gcc/ChangeLog: * (gimplify_scan_omp_clauses): Ignore affinity clause. * tree-core.h (enum omp_clause_code): Add OMP_CLAUSE_AFFINITY. * tree-pretty-print.c (dump_omp_clause): Handle OMP_CLAUSE_AFFINITY. * tree.c (omp_clause_num_ops, omp_clause_code_name): Add clause. (walk_tree_1): Handle OMP_CLAUSE_AFFINITY. libgomp/ChangeLog: * testsuite/libgomp.fortran/depend-iterator-2.f90: New test. gcc/testsuite/ChangeLog: * c-c++-common/gomp/affinity-1.c: New test. * c-c++-common/gomp/affinity-2.c: New test. * c-c++-common/gomp/affinity-3.c: New test. * c-c++-common/gomp/affinity-4.c: New test. * gfortran.dg/gomp/affinity-clause-1.f90: New test. * gfortran.dg/gomp/affinity-clause-2.f90: New test. * gfortran.dg/gomp/depend-iterator-2.f90: New test. * gfortran.dg/gomp/depend-iterator.f90: New test. gcc/c-family/c-pragma.h | 1 + gcc/c/c-parser.c | 64 ++++- gcc/c/c-typeck.c | 54 ++-- gcc/cp/parser.c | 76 +++++- gcc/cp/semantics.c | 56 +++-- gcc/fortran/dump-parse-tree.c | 51 +++- gcc/fortran/gfortran.h | 9 +- gcc/fortran/match.c | 18 +- gcc/fortran/openmp.c | 280 +++++++++++++++++---- gcc/fortran/st.c | 2 +- gcc/fortran/trans-openmp.c | 168 ++++++++++--- gcc/gimplify.c | 4 + gcc/testsuite/c-c++-common/gomp/affinity-1.c | 20 ++ gcc/testsuite/c-c++-common/gomp/affinity-2.c | 232 +++++++++++++++++ gcc/testsuite/c-c++-common/gomp/affinity-3.c | 77 ++++++ gcc/testsuite/c-c++-common/gomp/affinity-4.c | 77 ++++++ .../gfortran.dg/gomp/affinity-clause-1.f90 | 31 +++ .../gfortran.dg/gomp/affinity-clause-2.f90 | 27 ++ .../gfortran.dg/gomp/depend-iterator-1.f90 | 45 ++++ .../gfortran.dg/gomp/depend-iterator-3.f90 | 27 ++ gcc/testsuite/gfortran.dg/taskwait.f90 | 7 + gcc/tree-core.h | 3 + gcc/tree-pretty-print.c | 23 +- gcc/tree.c | 3 + .../libgomp.fortran/depend-iterator-2.f90 | 89 +++++++ 25 files changed, 1304 insertions(+), 140 deletions(-) diff --git a/gcc/c-family/c-pragma.h b/gcc/c-family/c-pragma.h index 6c34ffa5be4..e4fd3c9b740 100644 --- a/gcc/c-family/c-pragma.h +++ b/gcc/c-family/c-pragma.h @@ -86,6 +86,7 @@ enum pragma_kind { enum pragma_omp_clause { PRAGMA_OMP_CLAUSE_NONE = 0, + PRAGMA_OMP_CLAUSE_AFFINITY, PRAGMA_OMP_CLAUSE_ALIGNED, PRAGMA_OMP_CLAUSE_ALLOCATE, PRAGMA_OMP_CLAUSE_BIND, diff --git a/gcc/c/c-parser.c b/gcc/c/c-parser.c index 5cdeb21a458..893cf755b0c 100644 --- a/gcc/c/c-parser.c +++ b/gcc/c/c-parser.c @@ -12601,7 +12601,9 @@ c_parser_omp_clause_name (c_parser *parser) switch (p[0]) { case 'a': - if (!strcmp ("aligned", p)) + if (!strcmp ("affinity", p)) + result = PRAGMA_OMP_CLAUSE_AFFINITY; + else if (!strcmp ("aligned", p)) result = PRAGMA_OMP_CLAUSE_ALIGNED; else if (!strcmp ("allocate", p)) result = PRAGMA_OMP_CLAUSE_ALLOCATE; @@ -12900,7 +12902,7 @@ c_parser_omp_variable_list (c_parser *parser, while (1) { bool array_section_p = false; - if (kind == OMP_CLAUSE_DEPEND) + if (kind == OMP_CLAUSE_DEPEND || kind == OMP_CLAUSE_AFFINITY) { if (c_parser_next_token_is_not (parser, CPP_NAME) || c_parser_peek_token (parser)->id_kind != C_ID_ID) @@ -13040,6 +13042,7 @@ c_parser_omp_variable_list (c_parser *parser, t = build_component_ref (op_loc, t, ident, comp_loc); } /* FALLTHROUGH */ + case OMP_CLAUSE_AFFINITY: case OMP_CLAUSE_DEPEND: case OMP_CLAUSE_REDUCTION: case OMP_CLAUSE_IN_REDUCTION: @@ -13090,7 +13093,7 @@ c_parser_omp_variable_list (c_parser *parser, t = tree_cons (low_bound, length, t); } - if (kind == OMP_CLAUSE_DEPEND + if ((kind == OMP_CLAUSE_DEPEND || kind == OMP_CLAUSE_AFFINITY) && t != error_mark_node && parser->tokens_avail != 2) { @@ -13130,7 +13133,7 @@ c_parser_omp_variable_list (c_parser *parser, else list = tree_cons (t, NULL_TREE, list); - if (kind == OMP_CLAUSE_DEPEND) + if (kind == OMP_CLAUSE_DEPEND || kind == OMP_CLAUSE_AFFINITY) { parser->tokens = &parser->tokens_buf[0]; parser->tokens_avail = tokens_avail; @@ -15508,6 +15511,52 @@ c_parser_omp_iterators (c_parser *parser) return ret ? ret : error_mark_node; } +/* OpenMP 5.0: + affinity( [depend-modifier :] variable-list) + depend-modifier: + iterator ( iterators-definition ) */ + +static tree +c_parser_omp_clause_affinity (c_parser *parser, tree list) +{ + location_t clause_loc = c_parser_peek_token (parser)->location; + tree nl, iterators = NULL_TREE; + + matching_parens parens; + if (!parens.require_open (parser)) + return list; + + if (c_parser_next_token_is (parser, CPP_NAME)) + { + const char *p = IDENTIFIER_POINTER (c_parser_peek_token (parser)->value); + if (strcmp ("iterator", p) == 0) + { + iterators = c_parser_omp_iterators (parser); + if (!c_parser_require (parser, CPP_COLON, "expected %<:%>")) + return list; + } + } + nl = c_parser_omp_variable_list (parser, clause_loc, OMP_CLAUSE_AFFINITY, + list); + if (iterators) + { + tree block = pop_scope (); + if (iterators == error_mark_node) + iterators = NULL_TREE; + else + { + TREE_VEC_ELT (iterators, 5) = block; + for (tree c = nl; c != list; c = OMP_CLAUSE_CHAIN (c)) + OMP_CLAUSE_DECL (c) = build_tree_list (iterators, + OMP_CLAUSE_DECL (c)); + } + } + + parens.skip_until_found_close (parser); + return nl; +} + + /* OpenMP 4.0: depend ( depend-kind: variable-list ) @@ -16474,6 +16523,10 @@ c_parser_omp_all_clauses (c_parser *parser, omp_clause_mask mask, clauses = c_parser_omp_clause_linear (parser, clauses); c_name = "linear"; break; + case PRAGMA_OMP_CLAUSE_AFFINITY: + clauses = c_parser_omp_clause_affinity (parser, clauses); + c_name = "affinity"; + break; case PRAGMA_OMP_CLAUSE_DEPEND: clauses = c_parser_omp_clause_depend (parser, clauses); c_name = "depend"; @@ -19239,7 +19292,8 @@ c_parser_omp_single (location_t loc, c_parser *parser, bool *if_p) | (OMP_CLAUSE_MASK_1 << PRAGMA_OMP_CLAUSE_PRIORITY) \ | (OMP_CLAUSE_MASK_1 << PRAGMA_OMP_CLAUSE_ALLOCATE) \ | (OMP_CLAUSE_MASK_1 << PRAGMA_OMP_CLAUSE_IN_REDUCTION) \ - | (OMP_CLAUSE_MASK_1 << PRAGMA_OMP_CLAUSE_DETACH)) + | (OMP_CLAUSE_MASK_1 << PRAGMA_OMP_CLAUSE_DETACH) \ + | (OMP_CLAUSE_MASK_1 << PRAGMA_OMP_CLAUSE_AFFINITY)) static tree c_parser_omp_task (location_t loc, c_parser *parser, bool *if_p) diff --git a/gcc/c/c-typeck.c b/gcc/c/c-typeck.c index 51a62c800f7..47713c8fd9f 100644 --- a/gcc/c/c-typeck.c +++ b/gcc/c/c-typeck.c @@ -13063,7 +13063,8 @@ handle_omp_array_sections_1 (tree c, tree t, vec &types, if (error_operand_p (t)) return error_mark_node; ret = t; - if (OMP_CLAUSE_CODE (c) != OMP_CLAUSE_DEPEND + if (OMP_CLAUSE_CODE (c) != OMP_CLAUSE_AFFINITY + && OMP_CLAUSE_CODE (c) != OMP_CLAUSE_DEPEND && TYPE_ATOMIC (strip_array_types (TREE_TYPE (t)))) { error_at (OMP_CLAUSE_LOCATION (c), "%<_Atomic%> %qE in %qs clause", @@ -13114,14 +13115,16 @@ handle_omp_array_sections_1 (tree c, tree t, vec &types, omp_clause_code_name[OMP_CLAUSE_CODE (c)]); return error_mark_node; } - else if (OMP_CLAUSE_CODE (c) != OMP_CLAUSE_DEPEND + else if (OMP_CLAUSE_CODE (c) != OMP_CLAUSE_AFFINITY + && OMP_CLAUSE_CODE (c) != OMP_CLAUSE_DEPEND && TYPE_ATOMIC (TREE_TYPE (t))) { error_at (OMP_CLAUSE_LOCATION (c), "%<_Atomic%> %qD in %qs clause", t, omp_clause_code_name[OMP_CLAUSE_CODE (c)]); return error_mark_node; } - else if (OMP_CLAUSE_CODE (c) != OMP_CLAUSE_DEPEND + else if (OMP_CLAUSE_CODE (c) != OMP_CLAUSE_AFFINITY + && OMP_CLAUSE_CODE (c) != OMP_CLAUSE_DEPEND && VAR_P (t) && DECL_THREAD_LOCAL_P (t)) { @@ -13130,7 +13133,8 @@ handle_omp_array_sections_1 (tree c, tree t, vec &types, omp_clause_code_name[OMP_CLAUSE_CODE (c)]); return error_mark_node; } - if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_DEPEND + if ((OMP_CLAUSE_CODE (c) == OMP_CLAUSE_AFFINITY + || OMP_CLAUSE_CODE (c) == OMP_CLAUSE_DEPEND) && TYPE_ATOMIC (TREE_TYPE (t)) && POINTER_TYPE_P (TREE_TYPE (t))) { @@ -13201,7 +13205,8 @@ handle_omp_array_sections_1 (tree c, tree t, vec &types, { if (!integer_nonzerop (length)) { - if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_DEPEND + if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_AFFINITY + || OMP_CLAUSE_CODE (c) == OMP_CLAUSE_DEPEND || OMP_CLAUSE_CODE (c) == OMP_CLAUSE_REDUCTION || OMP_CLAUSE_CODE (c) == OMP_CLAUSE_IN_REDUCTION || OMP_CLAUSE_CODE (c) == OMP_CLAUSE_TASK_REDUCTION) @@ -13269,7 +13274,8 @@ handle_omp_array_sections_1 (tree c, tree t, vec &types, } if (tree_int_cst_equal (size, low_bound)) { - if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_DEPEND + if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_AFFINITY + || OMP_CLAUSE_CODE (c) == OMP_CLAUSE_DEPEND || OMP_CLAUSE_CODE (c) == OMP_CLAUSE_REDUCTION || OMP_CLAUSE_CODE (c) == OMP_CLAUSE_IN_REDUCTION || OMP_CLAUSE_CODE (c) == OMP_CLAUSE_TASK_REDUCTION) @@ -13290,7 +13296,8 @@ handle_omp_array_sections_1 (tree c, tree t, vec &types, } else if (length == NULL_TREE) { - if (OMP_CLAUSE_CODE (c) != OMP_CLAUSE_DEPEND + if (OMP_CLAUSE_CODE (c) != OMP_CLAUSE_AFFINITY + && OMP_CLAUSE_CODE (c) != OMP_CLAUSE_DEPEND && OMP_CLAUSE_CODE (c) != OMP_CLAUSE_REDUCTION && OMP_CLAUSE_CODE (c) != OMP_CLAUSE_IN_REDUCTION && OMP_CLAUSE_CODE (c) != OMP_CLAUSE_TASK_REDUCTION) @@ -13328,7 +13335,8 @@ handle_omp_array_sections_1 (tree c, tree t, vec &types, } else if (length == NULL_TREE) { - if (OMP_CLAUSE_CODE (c) != OMP_CLAUSE_DEPEND + if (OMP_CLAUSE_CODE (c) != OMP_CLAUSE_AFFINITY + && OMP_CLAUSE_CODE (c) != OMP_CLAUSE_DEPEND && OMP_CLAUSE_CODE (c) != OMP_CLAUSE_REDUCTION && OMP_CLAUSE_CODE (c) != OMP_CLAUSE_IN_REDUCTION && OMP_CLAUSE_CODE (c) != OMP_CLAUSE_TASK_REDUCTION) @@ -13373,6 +13381,7 @@ handle_omp_array_sections_1 (tree c, tree t, vec &types, /* If there is a pointer type anywhere but in the very first array-section-subscript, the array section can't be contiguous. */ if (OMP_CLAUSE_CODE (c) != OMP_CLAUSE_DEPEND + && OMP_CLAUSE_CODE (c) != OMP_CLAUSE_AFFINITY && TREE_CODE (TREE_CHAIN (t)) == TREE_LIST) { error_at (OMP_CLAUSE_LOCATION (c), @@ -13409,7 +13418,8 @@ handle_omp_array_sections (tree c, enum c_omp_region_type ort) unsigned int first_non_one = 0; auto_vec types; tree *tp = &OMP_CLAUSE_DECL (c); - if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_DEPEND + if ((OMP_CLAUSE_CODE (c) == OMP_CLAUSE_DEPEND + || OMP_CLAUSE_CODE (c) == OMP_CLAUSE_AFFINITY) && TREE_CODE (*tp) == TREE_LIST && TREE_PURPOSE (*tp) && TREE_CODE (TREE_PURPOSE (*tp)) == TREE_VEC) @@ -13421,7 +13431,8 @@ handle_omp_array_sections (tree c, enum c_omp_region_type ort) return true; if (first == NULL_TREE) return false; - if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_DEPEND) + if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_DEPEND + || OMP_CLAUSE_CODE (c) == OMP_CLAUSE_AFFINITY) { tree t = *tp; tree tem = NULL_TREE; @@ -14509,6 +14520,7 @@ c_finish_omp_clauses (tree clauses, enum c_omp_region_type ort) } break; + case OMP_CLAUSE_AFFINITY: case OMP_CLAUSE_DEPEND: t = OMP_CLAUSE_DECL (c); if (t == NULL_TREE) @@ -14517,7 +14529,8 @@ c_finish_omp_clauses (tree clauses, enum c_omp_region_type ort) == OMP_CLAUSE_DEPEND_SOURCE); break; } - if (OMP_CLAUSE_DEPEND_KIND (c) == OMP_CLAUSE_DEPEND_SINK) + if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_DEPEND + && OMP_CLAUSE_DEPEND_KIND (c) == OMP_CLAUSE_DEPEND_SINK) { gcc_assert (TREE_CODE (t) == TREE_LIST); for (; t; t = TREE_CHAIN (t)) @@ -14563,7 +14576,8 @@ c_finish_omp_clauses (tree clauses, enum c_omp_region_type ort) { if (handle_omp_array_sections (c, ort)) remove = true; - else if (OMP_CLAUSE_DEPEND_KIND (c) == OMP_CLAUSE_DEPEND_DEPOBJ) + else if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_DEPEND + && OMP_CLAUSE_DEPEND_KIND (c) == OMP_CLAUSE_DEPEND_DEPOBJ) { error_at (OMP_CLAUSE_LOCATION (c), "% clause with % dependence " @@ -14578,17 +14592,24 @@ c_finish_omp_clauses (tree clauses, enum c_omp_region_type ort) { error_at (OMP_CLAUSE_LOCATION (c), "%qE is not lvalue expression nor array section in " - "% clause", t); + "%qs clause", t, + OMP_CLAUSE_CODE (c) == OMP_CLAUSE_DEPEND + ? "depend" : "affinity"); remove = true; } else if (TREE_CODE (t) == COMPONENT_REF && DECL_C_BIT_FIELD (TREE_OPERAND (t, 1))) { + gcc_assert (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_DEPEND + || OMP_CLAUSE_CODE (c) == OMP_CLAUSE_AFFINITY); error_at (OMP_CLAUSE_LOCATION (c), - "bit-field %qE in %qs clause", t, "depend"); + "bit-field %qE in %qs clause", t, + OMP_CLAUSE_CODE (c) == OMP_CLAUSE_DEPEND + ? "depend" : "affinity"); remove = true; } - else if (OMP_CLAUSE_DEPEND_KIND (c) == OMP_CLAUSE_DEPEND_DEPOBJ) + else if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_DEPEND + && OMP_CLAUSE_DEPEND_KIND (c) == OMP_CLAUSE_DEPEND_DEPOBJ) { if (!c_omp_depend_t_p (TREE_TYPE (t))) { @@ -14599,7 +14620,8 @@ c_finish_omp_clauses (tree clauses, enum c_omp_region_type ort) remove = true; } } - else if (c_omp_depend_t_p (TREE_TYPE (t))) + else if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_DEPEND + && c_omp_depend_t_p (TREE_TYPE (t))) { error_at (OMP_CLAUSE_LOCATION (c), "%qE should not have % type in " diff --git a/gcc/cp/parser.c b/gcc/cp/parser.c index e1b1617da68..30d6dc14eb5 100644 --- a/gcc/cp/parser.c +++ b/gcc/cp/parser.c @@ -35063,7 +35063,9 @@ cp_parser_omp_clause_name (cp_parser *parser) switch (p[0]) { case 'a': - if (!strcmp ("aligned", p)) + if (!strcmp ("affinity", p)) + result = PRAGMA_OMP_CLAUSE_AFFINITY; + else if (!strcmp ("aligned", p)) result = PRAGMA_OMP_CLAUSE_ALIGNED; else if (!strcmp ("allocate", p)) result = PRAGMA_OMP_CLAUSE_ALLOCATE; @@ -35322,7 +35324,7 @@ cp_parser_omp_var_list_no_open (cp_parser *parser, enum omp_clause_code kind, { tree name, decl; - if (kind == OMP_CLAUSE_DEPEND) + if (kind == OMP_CLAUSE_DEPEND || kind == OMP_CLAUSE_AFFINITY) cp_parser_parse_tentatively (parser); token = cp_lexer_peek_token (parser->lexer); if (kind != 0 @@ -35351,7 +35353,7 @@ cp_parser_omp_var_list_no_open (cp_parser *parser, enum omp_clause_code kind, /*optional_p=*/false); if (name == error_mark_node) { - if (kind == OMP_CLAUSE_DEPEND + if ((kind == OMP_CLAUSE_DEPEND || kind == OMP_CLAUSE_AFFINITY) && cp_parser_simulate_error (parser)) goto depend_lvalue; goto skip_comma; @@ -35363,7 +35365,7 @@ cp_parser_omp_var_list_no_open (cp_parser *parser, enum omp_clause_code kind, decl = name; if (decl == error_mark_node) { - if (kind == OMP_CLAUSE_DEPEND + if ((kind == OMP_CLAUSE_DEPEND || kind == OMP_CLAUSE_AFFINITY) && cp_parser_simulate_error (parser)) goto depend_lvalue; cp_parser_name_lookup_error (parser, name, decl, NLE_NULL, @@ -35409,6 +35411,7 @@ cp_parser_omp_var_list_no_open (cp_parser *parser, enum omp_clause_code kind, &idk, loc); } /* FALLTHROUGH. */ + case OMP_CLAUSE_AFFINITY: case OMP_CLAUSE_DEPEND: case OMP_CLAUSE_REDUCTION: case OMP_CLAUSE_IN_REDUCTION: @@ -35435,12 +35438,12 @@ cp_parser_omp_var_list_no_open (cp_parser *parser, enum omp_clause_code kind, /* Look for `:'. */ if (!cp_parser_require (parser, CPP_COLON, RT_COLON)) { - if (kind == OMP_CLAUSE_DEPEND + if ((kind == OMP_CLAUSE_DEPEND || kind == OMP_CLAUSE_AFFINITY) && cp_parser_simulate_error (parser)) goto depend_lvalue; goto skip_comma; } - if (kind == OMP_CLAUSE_DEPEND) + if (kind == OMP_CLAUSE_DEPEND || kind == OMP_CLAUSE_AFFINITY) cp_parser_commit_to_tentative_parse (parser); if (!cp_lexer_next_token_is (parser->lexer, CPP_CLOSE_SQUARE)) @@ -35454,7 +35457,7 @@ cp_parser_omp_var_list_no_open (cp_parser *parser, enum omp_clause_code kind, if (!cp_parser_require (parser, CPP_CLOSE_SQUARE, RT_CLOSE_SQUARE)) { - if (kind == OMP_CLAUSE_DEPEND + if ((kind == OMP_CLAUSE_DEPEND || kind == OMP_CLAUSE_AFFINITY) && cp_parser_simulate_error (parser)) goto depend_lvalue; goto skip_comma; @@ -35467,7 +35470,7 @@ cp_parser_omp_var_list_no_open (cp_parser *parser, enum omp_clause_code kind, break; } - if (kind == OMP_CLAUSE_DEPEND) + if (kind == OMP_CLAUSE_DEPEND || kind == OMP_CLAUSE_AFFINITY) { if (cp_lexer_next_token_is_not (parser->lexer, CPP_COMMA) && cp_lexer_next_token_is_not (parser->lexer, CPP_CLOSE_PAREN) @@ -37707,6 +37710,56 @@ cp_parser_omp_iterators (cp_parser *parser) return ret ? ret : error_mark_node; } +/* OpenMP 5.0: + affinity( [depend-modifier :] variable-list) + depend-modifier: + iterator ( iterators-definition ) */ + +static tree +cp_parser_omp_clause_affinity (cp_parser *parser, tree list) +{ + tree nlist, c, iterators = NULL_TREE; + + matching_parens parens; + if (!parens.require_open (parser)) + return list; + + if (cp_lexer_next_token_is (parser->lexer, CPP_NAME)) + { + tree id = cp_lexer_peek_token (parser->lexer)->u.value; + const char *p = IDENTIFIER_POINTER (id); + if (strcmp ("iterator", p) == 0) + { + begin_scope (sk_omp, NULL); + iterators = cp_parser_omp_iterators (parser); + if (!cp_parser_require (parser, CPP_COLON, RT_COLON)) + { + cp_parser_skip_to_closing_parenthesis (parser, + /*recovering=*/true, + /*or_comma=*/false, + /*consume_paren=*/true); + return list; + } + } + } + nlist = cp_parser_omp_var_list_no_open (parser, OMP_CLAUSE_AFFINITY, + list, NULL); + if (iterators) + { + tree block = poplevel (1, 1, 0); + if (iterators == error_mark_node) + iterators = NULL_TREE; + else + { + TREE_VEC_ELT (iterators, 5) = block; + for (c = nlist; c != list; c = OMP_CLAUSE_CHAIN (c)) + OMP_CLAUSE_DECL (c) = build_tree_list (iterators, + OMP_CLAUSE_DECL (c)); + } + } + return nlist; +} + /* OpenMP 4.0: depend ( depend-kind : variable-list ) @@ -38649,6 +38702,10 @@ cp_parser_omp_all_clauses (cp_parser *parser, omp_clause_mask mask, } c_name = "linear"; break; + case PRAGMA_OMP_CLAUSE_AFFINITY: + clauses = cp_parser_omp_clause_affinity (parser, clauses); + c_name = "affinity"; + break; case PRAGMA_OMP_CLAUSE_DEPEND: clauses = cp_parser_omp_clause_depend (parser, clauses, token->location); @@ -41234,7 +41291,8 @@ cp_parser_omp_single (cp_parser *parser, cp_token *pragma_tok, bool *if_p) | (OMP_CLAUSE_MASK_1 << PRAGMA_OMP_CLAUSE_PRIORITY) \ | (OMP_CLAUSE_MASK_1 << PRAGMA_OMP_CLAUSE_ALLOCATE) \ | (OMP_CLAUSE_MASK_1 << PRAGMA_OMP_CLAUSE_IN_REDUCTION) \ - | (OMP_CLAUSE_MASK_1 << PRAGMA_OMP_CLAUSE_DETACH)) + | (OMP_CLAUSE_MASK_1 << PRAGMA_OMP_CLAUSE_DETACH) \ + | (OMP_CLAUSE_MASK_1 << PRAGMA_OMP_CLAUSE_AFFINITY)) static tree cp_parser_omp_task (cp_parser *parser, cp_token *pragma_tok, bool *if_p) diff --git a/gcc/cp/semantics.c b/gcc/cp/semantics.c index 4520181d4e5..47640efcefa 100644 --- a/gcc/cp/semantics.c +++ b/gcc/cp/semantics.c @@ -4999,7 +4999,8 @@ handle_omp_array_sections_1 (tree c, tree t, vec &types, " clauses"); return error_mark_node; } - else if (OMP_CLAUSE_CODE (c) != OMP_CLAUSE_DEPEND + else if (OMP_CLAUSE_CODE (c) != OMP_CLAUSE_AFFINITY + && OMP_CLAUSE_CODE (c) != OMP_CLAUSE_DEPEND && VAR_P (t) && CP_DECL_THREAD_LOCAL_P (t)) { error_at (OMP_CLAUSE_LOCATION (c), @@ -5086,7 +5087,8 @@ handle_omp_array_sections_1 (tree c, tree t, vec &types, { if (!integer_nonzerop (length)) { - if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_DEPEND + if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_AFFINITY + || OMP_CLAUSE_CODE (c) == OMP_CLAUSE_DEPEND || OMP_CLAUSE_CODE (c) == OMP_CLAUSE_REDUCTION || OMP_CLAUSE_CODE (c) == OMP_CLAUSE_IN_REDUCTION || OMP_CLAUSE_CODE (c) == OMP_CLAUSE_TASK_REDUCTION) @@ -5154,7 +5156,8 @@ handle_omp_array_sections_1 (tree c, tree t, vec &types, } if (tree_int_cst_equal (size, low_bound)) { - if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_DEPEND + if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_AFFINITY + || OMP_CLAUSE_CODE (c) == OMP_CLAUSE_DEPEND || OMP_CLAUSE_CODE (c) == OMP_CLAUSE_REDUCTION || OMP_CLAUSE_CODE (c) == OMP_CLAUSE_IN_REDUCTION || OMP_CLAUSE_CODE (c) == OMP_CLAUSE_TASK_REDUCTION) @@ -5175,7 +5178,8 @@ handle_omp_array_sections_1 (tree c, tree t, vec &types, } else if (length == NULL_TREE) { - if (OMP_CLAUSE_CODE (c) != OMP_CLAUSE_DEPEND + if (OMP_CLAUSE_CODE (c) != OMP_CLAUSE_AFFINITY + && OMP_CLAUSE_CODE (c) != OMP_CLAUSE_DEPEND && OMP_CLAUSE_CODE (c) != OMP_CLAUSE_REDUCTION && OMP_CLAUSE_CODE (c) != OMP_CLAUSE_IN_REDUCTION && OMP_CLAUSE_CODE (c) != OMP_CLAUSE_TASK_REDUCTION) @@ -5213,7 +5217,8 @@ handle_omp_array_sections_1 (tree c, tree t, vec &types, } else if (length == NULL_TREE) { - if (OMP_CLAUSE_CODE (c) != OMP_CLAUSE_DEPEND + if (OMP_CLAUSE_CODE (c) != OMP_CLAUSE_AFFINITY + && OMP_CLAUSE_CODE (c) != OMP_CLAUSE_DEPEND && OMP_CLAUSE_CODE (c) != OMP_CLAUSE_REDUCTION && OMP_CLAUSE_CODE (c) != OMP_CLAUSE_IN_REDUCTION && OMP_CLAUSE_CODE (c) != OMP_CLAUSE_TASK_REDUCTION) @@ -5257,7 +5262,8 @@ handle_omp_array_sections_1 (tree c, tree t, vec &types, } /* If there is a pointer type anywhere but in the very first array-section-subscript, the array section can't be contiguous. */ - if (OMP_CLAUSE_CODE (c) != OMP_CLAUSE_DEPEND + if (OMP_CLAUSE_CODE (c) != OMP_CLAUSE_AFFINITY + && OMP_CLAUSE_CODE (c) != OMP_CLAUSE_DEPEND && TREE_CODE (TREE_CHAIN (t)) == TREE_LIST) { error_at (OMP_CLAUSE_LOCATION (c), @@ -5305,7 +5311,8 @@ handle_omp_array_sections (tree c, enum c_omp_region_type ort) unsigned int first_non_one = 0; auto_vec types; tree *tp = &OMP_CLAUSE_DECL (c); - if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_DEPEND + if ((OMP_CLAUSE_CODE (c) == OMP_CLAUSE_DEPEND + || OMP_CLAUSE_CODE (c) == OMP_CLAUSE_AFFINITY) && TREE_CODE (*tp) == TREE_LIST && TREE_PURPOSE (*tp) && TREE_CODE (TREE_PURPOSE (*tp)) == TREE_VEC) @@ -5317,7 +5324,8 @@ handle_omp_array_sections (tree c, enum c_omp_region_type ort) return true; if (first == NULL_TREE) return false; - if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_DEPEND) + if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_DEPEND + || OMP_CLAUSE_CODE (c) == OMP_CLAUSE_AFFINITY) { tree t = *tp; tree tem = NULL_TREE; @@ -7428,6 +7436,7 @@ finish_omp_clauses (tree clauses, enum c_omp_region_type ort) } goto handle_field_decl; + case OMP_CLAUSE_AFFINITY: case OMP_CLAUSE_DEPEND: t = OMP_CLAUSE_DECL (c); if (t == NULL_TREE) @@ -7436,7 +7445,8 @@ finish_omp_clauses (tree clauses, enum c_omp_region_type ort) == OMP_CLAUSE_DEPEND_SOURCE); break; } - if (OMP_CLAUSE_DEPEND_KIND (c) == OMP_CLAUSE_DEPEND_SINK) + if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_DEPEND + && OMP_CLAUSE_DEPEND_KIND (c) == OMP_CLAUSE_DEPEND_SINK) { if (cp_finish_omp_clause_depend_sink (c)) remove = true; @@ -7461,7 +7471,9 @@ finish_omp_clauses (tree clauses, enum c_omp_region_type ort) { if (handle_omp_array_sections (c, ort)) remove = true; - else if (OMP_CLAUSE_DEPEND_KIND (c) == OMP_CLAUSE_DEPEND_DEPOBJ) + else if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_DEPEND + && OMP_CLAUSE_DEPEND_KIND (c) + == OMP_CLAUSE_DEPEND_DEPOBJ) { error_at (OMP_CLAUSE_LOCATION (c), "% clause with % dependence " @@ -7486,22 +7498,31 @@ finish_omp_clauses (tree clauses, enum c_omp_region_type ort) if (DECL_P (t)) error_at (OMP_CLAUSE_LOCATION (c), "%qD is not lvalue expression nor array section " - "in % clause", t); + "in %qs clause", t, + OMP_CLAUSE_CODE (c) == OMP_CLAUSE_DEPEND + ? "depend" : "affinity"); else error_at (OMP_CLAUSE_LOCATION (c), "%qE is not lvalue expression nor array section " - "in % clause", t); + "in %qs clause", t, + OMP_CLAUSE_CODE (c) == OMP_CLAUSE_DEPEND + ? "depend" : "affinity"); remove = true; } else if (TREE_CODE (t) == COMPONENT_REF && TREE_CODE (TREE_OPERAND (t, 1)) == FIELD_DECL && DECL_BIT_FIELD (TREE_OPERAND (t, 1))) { + gcc_assert (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_DEPEND + || OMP_CLAUSE_CODE (c) == OMP_CLAUSE_AFFINITY); error_at (OMP_CLAUSE_LOCATION (c), - "bit-field %qE in %qs clause", t, "depend"); + "bit-field %qE in %qs clause", t, + OMP_CLAUSE_CODE (c) == OMP_CLAUSE_DEPEND + ? "depend" : "affinity"); remove = true; } - else if (OMP_CLAUSE_DEPEND_KIND (c) == OMP_CLAUSE_DEPEND_DEPOBJ) + else if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_DEPEND + && OMP_CLAUSE_DEPEND_KIND (c) == OMP_CLAUSE_DEPEND_DEPOBJ) { if (!c_omp_depend_t_p (TYPE_REF_P (TREE_TYPE (t)) ? TREE_TYPE (TREE_TYPE (t)) @@ -7514,9 +7535,10 @@ finish_omp_clauses (tree clauses, enum c_omp_region_type ort) remove = true; } } - else if (c_omp_depend_t_p (TYPE_REF_P (TREE_TYPE (t)) - ? TREE_TYPE (TREE_TYPE (t)) - : TREE_TYPE (t))) + else if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_DEPEND + && c_omp_depend_t_p (TYPE_REF_P (TREE_TYPE (t)) + ? TREE_TYPE (TREE_TYPE (t)) + : TREE_TYPE (t))) { error_at (OMP_CLAUSE_LOCATION (c), "%qE should not have % type in " diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c index b50265ac742..7edcf8988d8 100644 --- a/gcc/fortran/dump-parse-tree.c +++ b/gcc/fortran/dump-parse-tree.c @@ -1297,11 +1297,56 @@ show_code (int level, gfc_code *c) show_code_node (level, c); } +static void +show_iterator (gfc_namespace *ns) +{ + for (gfc_symbol *sym = ns->proc_name; sym; sym = sym->tlink) + { + gfc_constructor *c; + if (sym != ns->proc_name) + fputc (',', dumpfile); + fputs (sym->name, dumpfile); + fputc ('=', dumpfile); + c = gfc_constructor_first (sym->value->value.constructor); + show_expr (c->expr); + fputc (':', dumpfile); + c = gfc_constructor_next (c); + show_expr (c->expr); + c = gfc_constructor_next (c); + if (c) + { + fputc (':', dumpfile); + show_expr (c->expr); + } + } +} + static void show_omp_namelist (int list_type, gfc_omp_namelist *n) { + gfc_namespace *ns_iter = NULL, *ns_curr = gfc_current_ns; + gfc_omp_namelist *n2 = n; for (; n; n = n->next) { + gfc_current_ns = ns_curr; + if (list_type == OMP_LIST_AFFINITY || list_type == OMP_LIST_DEPEND) + { + gfc_current_ns = n->u2.ns ? n->u2.ns : ns_curr; + if (n->u2.ns != ns_iter) + { + if (n != n2) + fputs (list_type == OMP_LIST_AFFINITY + ? ") AFFINITY(" : ") DEPEND(", dumpfile); + if (n->u2.ns) + { + fputs ("ITERATOR(", dumpfile); + show_iterator (n->u2.ns); + fputc (')', dumpfile); + fputc (list_type == OMP_LIST_AFFINITY ? ':' : ',', dumpfile); + } + } + ns_iter = n->u2.ns; + } if (list_type == OMP_LIST_REDUCTION) switch (n->u.reduction_op) { @@ -1321,8 +1366,8 @@ show_omp_namelist (int list_type, gfc_omp_namelist *n) case OMP_REDUCTION_IOR: fputs ("ior:", dumpfile); break; case OMP_REDUCTION_IEOR: fputs ("ieor:", dumpfile); break; case OMP_REDUCTION_USER: - if (n->udr) - fprintf (dumpfile, "%s:", n->udr->udr->name); + if (n->u2.udr) + fprintf (dumpfile, "%s:", n->u2.udr->udr->name); break; default: break; } @@ -1387,6 +1432,7 @@ show_omp_namelist (int list_type, gfc_omp_namelist *n) if (n->next) fputc (',', dumpfile); } + gfc_current_ns = ns_curr; } @@ -1610,6 +1656,7 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses) case OMP_LIST_SHARED: type = "SHARED"; break; case OMP_LIST_COPYIN: type = "COPYIN"; break; case OMP_LIST_UNIFORM: type = "UNIFORM"; break; + case OMP_LIST_AFFINITY: type = "AFFINITY"; break; case OMP_LIST_ALIGNED: type = "ALIGNED"; break; case OMP_LIST_LINEAR: type = "LINEAR"; break; case OMP_LIST_DEPEND: type = "DEPEND"; break; diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index d12be0cdbab..1dda02edc72 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -1256,7 +1256,11 @@ typedef struct gfc_omp_namelist struct gfc_common_head *common; bool lastprivate_conditional; } u; - struct gfc_omp_namelist_udr *udr; + union + { + struct gfc_omp_namelist_udr *udr; + gfc_namespace *ns; + } u2; struct gfc_omp_namelist *next; locus where; } @@ -1274,6 +1278,7 @@ enum OMP_LIST_SHARED, OMP_LIST_COPYIN, OMP_LIST_UNIFORM, + OMP_LIST_AFFINITY, OMP_LIST_ALIGNED, OMP_LIST_LINEAR, OMP_LIST_DEPEND, @@ -3319,7 +3324,7 @@ void gfc_free_iterator (gfc_iterator *, int); void gfc_free_forall_iterator (gfc_forall_iterator *); void gfc_free_alloc_list (gfc_alloc *); void gfc_free_namelist (gfc_namelist *); -void gfc_free_omp_namelist (gfc_omp_namelist *); +void gfc_free_omp_namelist (gfc_omp_namelist *, bool); void gfc_free_equiv (gfc_equiv *); void gfc_free_equiv_until (gfc_equiv *, gfc_equiv *); void gfc_free_data (gfc_data *); diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c index 393755e4d93..29462013038 100644 --- a/gcc/fortran/match.c +++ b/gcc/fortran/match.c @@ -5470,20 +5470,22 @@ gfc_free_namelist (gfc_namelist *name) /* Free an OpenMP namelist structure. */ void -gfc_free_omp_namelist (gfc_omp_namelist *name) +gfc_free_omp_namelist (gfc_omp_namelist *name, bool free_ns) { gfc_omp_namelist *n; for (; name; name = n) { gfc_free_expr (name->expr); - if (name->udr) - { - if (name->udr->combiner) - gfc_free_statement (name->udr->combiner); - if (name->udr->initializer) - gfc_free_statement (name->udr->initializer); - free (name->udr); + if (free_ns) + gfc_free_namespace (name->u2.ns); + else if (name->u2.udr) + { + if (name->u2.udr->combiner) + gfc_free_statement (name->u2.udr->combiner); + if (name->u2.udr->initializer) + gfc_free_statement (name->u2.udr->initializer); + free (name->u2.udr); } n = name->next; free (name); diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c index a1b057227b7..c6f78a3cf70 100644 --- a/gcc/fortran/openmp.c +++ b/gcc/fortran/openmp.c @@ -25,6 +25,7 @@ along with GCC; see the file COPYING3. If not see #include "arith.h" #include "match.h" #include "parse.h" +#include "constructor.h" #include "diagnostic.h" #include "gomp-constants.h" @@ -103,7 +104,8 @@ gfc_free_omp_clauses (gfc_omp_clauses *c) gfc_free_expr (c->num_workers_expr); gfc_free_expr (c->vector_length_expr); for (i = 0; i < OMP_LIST_NUM; i++) - gfc_free_omp_namelist (c->lists[i]); + gfc_free_omp_namelist (c->lists[i], + i == OMP_LIST_AFFINITY || i == OMP_LIST_DEPEND); gfc_free_expr_list (c->wait_list); gfc_free_expr_list (c->tile_list); free (CONST_CAST (char *, c->critical_name)); @@ -261,6 +263,7 @@ gfc_match_omp_variable_list (const char *str, gfc_omp_namelist **list, case MATCH_YES: gfc_expr *expr; expr = NULL; + gfc_gobble_whitespace (); if ((allow_sections && gfc_peek_ascii_char () == '(') || (allow_derived && gfc_peek_ascii_char () == '%')) { @@ -354,7 +357,7 @@ syntax: gfc_error ("Syntax error in OpenMP variable list at %C"); cleanup: - gfc_free_omp_namelist (head); + gfc_free_omp_namelist (head, false); gfc_current_locus = old_loc; return MATCH_ERROR; } @@ -444,7 +447,7 @@ syntax: gfc_error ("Syntax error in OpenMP variable list at %C"); cleanup: - gfc_free_omp_namelist (head); + gfc_free_omp_namelist (head, false); gfc_current_locus = old_loc; return MATCH_ERROR; } @@ -551,7 +554,7 @@ syntax: gfc_error ("Syntax error in OpenMP DEPEND SINK list at %C"); cleanup: - gfc_free_omp_namelist (head); + gfc_free_omp_namelist (head, false); gfc_current_locus = old_loc; return MATCH_ERROR; } @@ -842,6 +845,7 @@ enum omp_mask1 OMP_CLAUSE_CAPTURE, /* OpenMP 5.0. */ OMP_CLAUSE_MEMORDER, /* OpenMP 5.0. */ OMP_CLAUSE_DETACH, /* OpenMP 5.0. */ + OMP_CLAUSE_AFFINITY, /* OpenMP 5.0. */ OMP_CLAUSE_NOWAIT, /* This must come last. */ OMP_MASK1_LAST @@ -995,6 +999,107 @@ gfc_match_omp_map_clause (gfc_omp_namelist **list, gfc_omp_map_op map_op, return false; } +static match +gfc_match_iterator (gfc_namespace **ns) +{ + if (gfc_match ("iterator ( ") != MATCH_YES) + return MATCH_NO; + + gfc_typespec ts; + gfc_symbol *last = NULL; + gfc_expr *begin, *end, *step; + *ns = gfc_build_block_ns (gfc_current_ns); + char name[GFC_MAX_SYMBOL_LEN + 1]; + while (true) + { + locus old_loc = gfc_current_locus; + if (gfc_match_type_spec (&ts) == MATCH_YES + && gfc_match (" :: ") == MATCH_YES) + { + if (ts.type != BT_INTEGER) + { + gfc_error ("Expected INTEGER type at %L", &old_loc); + return MATCH_ERROR; + } + } + else + { + ts.type = BT_INTEGER; + ts.kind = gfc_default_integer_kind; + gfc_current_locus = old_loc; + } + old_loc = gfc_current_locus; + if (gfc_match_name (name) != MATCH_YES) + { + gfc_error ("Expected identifier at %C"); + return MATCH_ERROR; + } + if (gfc_find_symtree ((*ns)->sym_root, name)) + { + gfc_error ("Same identifier %qs specified again at %C", name); + return MATCH_ERROR; + } + + gfc_symbol *sym = gfc_new_symbol (name, *ns); + if (last) + last->tlink = sym; + else + (*ns)->proc_name = sym; + last = sym; + sym->declared_at = old_loc; + sym->ts = ts; + sym->attr.flavor = FL_VARIABLE; + sym->attr.artificial = 1; + sym->attr.referenced = 1; + sym->refs++; + gfc_symtree *st = gfc_new_symtree (&(*ns)->sym_root, name); + st->n.sym = sym; + + old_loc = gfc_current_locus; + if (gfc_match (" = ") != MATCH_YES) + return MATCH_ERROR; + begin = end = step = NULL; + if (gfc_match ("%e : ", &begin) != MATCH_YES + || gfc_match ("%e ", &end) != MATCH_YES) + { + gfc_error ("Expected range-specification at %C"); + gfc_free_expr (begin); + gfc_free_expr (end); + return MATCH_ERROR; + } + if (':' == gfc_peek_ascii_char ()) + { + step = gfc_get_expr (); + if (gfc_match (": %e ", &step) != MATCH_YES) + { + gfc_free_expr (begin); + gfc_free_expr (end); + gfc_free_expr (step); + return MATCH_ERROR; + } + } + + gfc_expr *e = gfc_get_expr (); + e->where = old_loc; + e->expr_type = EXPR_ARRAY; + e->ts = ts; + e->rank = 1; + e->shape = gfc_get_shape (1); + mpz_init_set_ui (e->shape[0], step ? 3 : 2); + gfc_constructor_append_expr (&e->value.constructor, begin, &begin->where); + gfc_constructor_append_expr (&e->value.constructor, end, &end->where); + if (step) + gfc_constructor_append_expr (&e->value.constructor, step, &step->where); + sym->value = e; + + if (gfc_match (") ") == MATCH_YES) + break; + if (gfc_match (", ") != MATCH_YES) + return MATCH_ERROR; + } + return MATCH_YES; +} + /* reduction ( reduction-modifier, reduction-operator : variable-list ) in_reduction ( reduction-operator : variable-list ) task_reduction ( reduction-operator : variable-list ) */ @@ -1137,7 +1242,7 @@ gfc_match_omp_clause_reduction (char pc, gfc_omp_clauses *c, bool openacc, *head = NULL; gfc_error_now ("!$OMP DECLARE REDUCTION %s not found at %L", buffer, &old_loc); - gfc_free_omp_namelist (n); + gfc_free_omp_namelist (n, false); } else for (n = *head; n; n = n->next) @@ -1145,8 +1250,8 @@ gfc_match_omp_clause_reduction (char pc, gfc_omp_clauses *c, bool openacc, n->u.reduction_op = rop; if (udr) { - n->udr = gfc_get_omp_namelist_udr (); - n->udr->udr = udr; + n->u2.udr = gfc_get_omp_namelist_udr (); + n->u2.udr->udr = udr; } } return MATCH_YES; @@ -1201,7 +1306,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, if (end_colon && gfc_match (" %e )", &alignment) != MATCH_YES) { - gfc_free_omp_namelist (*head); + gfc_free_omp_namelist (*head, false); gfc_current_locus = old_loc; *head = NULL; break; @@ -1229,6 +1334,33 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, needs_space = true; continue; } + if ((mask & OMP_CLAUSE_AFFINITY) + && gfc_match ("affinity ( ") == MATCH_YES) + { + gfc_namespace *ns_iter = NULL, *ns_curr = gfc_current_ns; + match m = gfc_match_iterator (&ns_iter); + if (m == MATCH_ERROR) + break; + if (m == MATCH_YES && gfc_match (" : ") != MATCH_YES) + break; + if (ns_iter) + gfc_current_ns = ns_iter; + head = NULL; + m = gfc_match_omp_variable_list ("", &c->lists[OMP_LIST_AFFINITY], + false, NULL, &head, true); + gfc_current_ns = ns_curr; + if (m == MATCH_ERROR) + break; + if (ns_iter) + { + for (gfc_omp_namelist *n = *head; n; n = n->next) + { + n->u2.ns = ns_iter; + ns_iter->refs++; + } + } + continue; + } if ((mask & OMP_CLAUSE_ASYNC) && !c->async && gfc_match ("async") == MATCH_YES) @@ -1373,6 +1505,12 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, if ((mask & OMP_CLAUSE_DEPEND) && gfc_match ("depend ( ") == MATCH_YES) { + gfc_namespace *ns_iter = NULL, *ns_curr = gfc_current_ns; + match m_it = gfc_match_iterator (&ns_iter); + if (m_it == MATCH_ERROR) + break; + if (m_it == MATCH_YES && gfc_match (" , ") != MATCH_YES) + break; match m = MATCH_YES; gfc_omp_depend_op depend_op = OMP_DEPEND_OUT; if (gfc_match ("inout") == MATCH_YES) @@ -1388,11 +1526,24 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, else if (!c->depend_source && gfc_match ("source )") == MATCH_YES) { + if (m_it == MATCH_YES) + { + gfc_error ("ITERATOR may not be combined with SOURCE " + "at %C"); + gfc_free_omp_clauses (c); + return MATCH_ERROR; + } c->depend_source = true; continue; } else if (gfc_match ("sink : ") == MATCH_YES) { + if (m_it == MATCH_YES) + { + gfc_error ("ITERATOR may not be combined with SINK " + "at %C"); + break; + } if (gfc_match_omp_depend_sink (&c->lists[OMP_LIST_DEPEND]) == MATCH_YES) continue; @@ -1401,19 +1552,26 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, else m = MATCH_NO; head = NULL; - if (m == MATCH_YES - && gfc_match_omp_variable_list (" : ", - &c->lists[OMP_LIST_DEPEND], - false, NULL, &head, - true) == MATCH_YES) + if (ns_iter) + gfc_current_ns = ns_iter; + if (m == MATCH_YES) + m = gfc_match_omp_variable_list (" : ", + &c->lists[OMP_LIST_DEPEND], + false, NULL, &head, true); + gfc_current_ns = ns_curr; + if (m == MATCH_YES) { gfc_omp_namelist *n; for (n = *head; n; n = n->next) - n->u.depend_op = depend_op; + { + n->u.depend_op = depend_op; + n->u2.ns = ns_iter; + if (ns_iter) + ns_iter->refs++; + } continue; } - else - gfc_current_locus = old_loc; + break; } if ((mask & OMP_CLAUSE_DETACH) && !openacc @@ -1665,7 +1823,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, end_colon = true; else if (gfc_match (" )") != MATCH_YES) { - gfc_free_omp_namelist (*head); + gfc_free_omp_namelist (*head, false); gfc_current_locus = old_loc; *head = NULL; break; @@ -1673,7 +1831,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, } if (end_colon && gfc_match (" %e )", &step) != MATCH_YES) { - gfc_free_omp_namelist (*head); + gfc_free_omp_namelist (*head, false); gfc_current_locus = old_loc; *head = NULL; break; @@ -2808,7 +2966,7 @@ cleanup: | OMP_CLAUSE_SHARED | OMP_CLAUSE_IF | OMP_CLAUSE_DEFAULT \ | OMP_CLAUSE_UNTIED | OMP_CLAUSE_FINAL | OMP_CLAUSE_MERGEABLE \ | OMP_CLAUSE_DEPEND | OMP_CLAUSE_PRIORITY | OMP_CLAUSE_IN_REDUCTION \ - | OMP_CLAUSE_DETACH) + | OMP_CLAUSE_DETACH | OMP_CLAUSE_AFFINITY) #define OMP_TASKLOOP_CLAUSES \ (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE \ | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_SHARED | OMP_CLAUSE_IF \ @@ -3061,14 +3219,14 @@ gfc_match_omp_flush (void) { gfc_error ("List specified together with memory order clause in FLUSH " "directive at %C"); - gfc_free_omp_namelist (list); + gfc_free_omp_namelist (list, false); gfc_free_omp_clauses (c); return MATCH_ERROR; } if (gfc_match_omp_eos () != MATCH_YES) { gfc_error ("Unexpected junk after $OMP FLUSH statement at %C"); - gfc_free_omp_namelist (list); + gfc_free_omp_namelist (list, false); gfc_free_omp_clauses (c); return MATCH_ERROR; } @@ -4209,14 +4367,13 @@ gfc_match_omp_taskloop_simd (void) match gfc_match_omp_taskwait (void) { - if (gfc_match_omp_eos () != MATCH_YES) + if (gfc_match_omp_eos () == MATCH_YES) { - gfc_error ("Unexpected junk after TASKWAIT clause at %C"); - return MATCH_ERROR; + new_st.op = EXEC_OMP_TASKWAIT; + new_st.ext.omp_clauses = NULL; + return MATCH_YES; } - new_st.op = EXEC_OMP_TASKWAIT; - new_st.ext.omp_clauses = NULL; - return MATCH_YES; + return match_omp (EXEC_OMP_TASKWAIT, omp_mask (OMP_CLAUSE_DEPEND)); } @@ -4782,7 +4939,7 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, gfc_omp_linear_op linear_op = OMP_LINEAR_DEFAULT; static const char *clause_names[] = { "PRIVATE", "FIRSTPRIVATE", "LASTPRIVATE", "COPYPRIVATE", "SHARED", - "COPYIN", "UNIFORM", "ALIGNED", "LINEAR", "DEPEND", "MAP", + "COPYIN", "UNIFORM", "AFFINITY", "ALIGNED", "LINEAR", "DEPEND", "MAP", "TO", "FROM", "INCLUSIVE", "EXCLUSIVE", "REDUCTION", "REDUCTION" /*inscan*/, "REDUCTION" /*task*/, "IN_REDUCTION", "TASK_REDUCTION", @@ -5229,6 +5386,7 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, } } break; + case OMP_LIST_AFFINITY: case OMP_LIST_DEPEND: case OMP_LIST_MAP: case OMP_LIST_TO: @@ -5236,6 +5394,40 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, case OMP_LIST_CACHE: for (; n != NULL; n = n->next) { + if ((list == OMP_LIST_DEPEND || list == OMP_LIST_AFFINITY) + && n->u2.ns && !n->u2.ns->resolved) + { + n->u2.ns->resolved = 1; + for (gfc_symbol *sym = n->u2.ns->proc_name; sym; + sym = sym->tlink) + { + gfc_constructor *c; + c = gfc_constructor_first (sym->value->value.constructor); + if (!gfc_resolve_expr (c->expr) + || c->expr->ts.type != BT_INTEGER + || c->expr->rank != 0) + gfc_error ("Scalar integer expression for range begin" + " expected at %L", &c->expr->where); + c = gfc_constructor_next (c); + if (!gfc_resolve_expr (c->expr) + || c->expr->ts.type != BT_INTEGER + || c->expr->rank != 0) + gfc_error ("Scalar integer expression for range end " + "expected at %L", &c->expr->where); + c = gfc_constructor_next (c); + if (c && (!gfc_resolve_expr (c->expr) + || c->expr->ts.type != BT_INTEGER + || c->expr->rank != 0)) + gfc_error ("Scalar integer expression for range step " + "expected at %L", &c->expr->where); + else if (c + && c->expr->expr_type == EXPR_CONSTANT + && mpz_cmp_si (c->expr->value.integer, 0) == 0) + gfc_error ("Nonzero range step expected at %L", + &c->expr->where); + } + } + if (list == OMP_LIST_DEPEND) { if (n->u.depend_op == OMP_DEPEND_SINK_FIRST @@ -5377,7 +5569,8 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, n->sym->name, name, &n->where); break; } - else if (list == OMP_LIST_DEPEND + else if ((list == OMP_LIST_DEPEND + || list == OMP_LIST_AFFINITY) && ar->start[i] && ar->start[i]->expr_type == EXPR_CONSTANT && ar->end[i] @@ -5385,9 +5578,11 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, && mpz_cmp (ar->start[i]->value.integer, ar->end[i]->value.integer) > 0) { - gfc_error ("%qs in DEPEND clause at %L is a " + gfc_error ("%qs in %s clause at %L is a " "zero size array section", - n->sym->name, &n->where); + n->sym->name, + list == OMP_LIST_DEPEND + ? "DEPEND" : "AFFINITY", &n->where); break; } } @@ -5631,23 +5826,23 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, break; } if (!bad) - n->udr = NULL; + n->u2.udr = NULL; else { const char *udr_name = NULL; - if (n->udr) + if (n->u2.udr) { - udr_name = n->udr->udr->name; - n->udr->udr + udr_name = n->u2.udr->udr->name; + n->u2.udr->udr = gfc_find_omp_udr (NULL, udr_name, &n->sym->ts); - if (n->udr->udr == NULL) + if (n->u2.udr->udr == NULL) { - free (n->udr); - n->udr = NULL; + free (n->u2.udr); + n->u2.udr = NULL; } } - if (n->udr == NULL) + if (n->u2.udr == NULL) { if (udr_name == NULL) switch (n->u.reduction_op) @@ -5686,14 +5881,14 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, } else { - gfc_omp_udr *udr = n->udr->udr; + gfc_omp_udr *udr = n->u2.udr->udr; n->u.reduction_op = OMP_REDUCTION_USER; - n->udr->combiner + n->u2.udr->combiner = resolve_omp_udr_clause (n, udr->combiner_ns, udr->omp_out, udr->omp_in); if (udr->initializer_ns) - n->udr->initializer + n->u2.udr->initializer = resolve_omp_udr_clause (n, udr->initializer_ns, udr->omp_priv, @@ -7321,6 +7516,7 @@ gfc_resolve_omp_directive (gfc_code *code, gfc_namespace *ns) case EXEC_OMP_TARGET_PARALLEL: case EXEC_OMP_TARGET_TEAMS: case EXEC_OMP_TASK: + case EXEC_OMP_TASKWAIT: case EXEC_OMP_TEAMS: case EXEC_OMP_WORKSHARE: case EXEC_OMP_DEPOBJ: diff --git a/gcc/fortran/st.c b/gcc/fortran/st.c index 9e761996eec..f6a0a6b5d57 100644 --- a/gcc/fortran/st.c +++ b/gcc/fortran/st.c @@ -267,7 +267,7 @@ gfc_free_statement (gfc_code *p) break; case EXEC_OMP_FLUSH: - gfc_free_omp_namelist (p->ext.omp_namelist); + gfc_free_omp_namelist (p->ext.omp_namelist, false); break; case EXEC_OMP_BARRIER: diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c index bf3f2617776..6209ba8b38c 100644 --- a/gcc/fortran/trans-openmp.c +++ b/gcc/fortran/trans-openmp.c @@ -35,6 +35,7 @@ along with GCC; see the file COPYING3. If not see #include "trans-array.h" #include "trans-const.h" #include "arith.h" +#include "constructor.h" #include "gomp-constants.h" #include "omp-general.h" #include "omp-low.h" @@ -1750,7 +1751,7 @@ gfc_trans_omp_array_reduction_or_udr (tree c, gfc_omp_namelist *n, locus where) locus old_loc = gfc_current_locus; const char *iname; bool t; - gfc_omp_udr *udr = n->udr ? n->udr->udr : NULL; + gfc_omp_udr *udr = n->u2.udr ? n->u2.udr->udr : NULL; decl = OMP_CLAUSE_DECL (c); gfc_current_locus = where; @@ -1869,9 +1870,9 @@ gfc_trans_omp_array_reduction_or_udr (tree c, gfc_omp_namelist *n, locus where) t = gfc_resolve_expr (e2); gcc_assert (t); } - else if (n->udr->initializer->op == EXEC_ASSIGN) + else if (n->u2.udr->initializer->op == EXEC_ASSIGN) { - e2 = gfc_copy_expr (n->udr->initializer->expr2); + e2 = gfc_copy_expr (n->u2.udr->initializer->expr2); t = gfc_resolve_expr (e2); gcc_assert (t); } @@ -1880,7 +1881,7 @@ gfc_trans_omp_array_reduction_or_udr (tree c, gfc_omp_namelist *n, locus where) struct omp_udr_find_orig_data cd; cd.omp_udr = udr; cd.omp_orig_seen = false; - gfc_code_walker (&n->udr->initializer, + gfc_code_walker (&n->u2.udr->initializer, gfc_dummy_code_callback, omp_udr_find_orig, &cd); if (cd.omp_orig_seen) OMP_CLAUSE_REDUCTION_OMP_ORIG_REF (c) = 1; @@ -1930,11 +1931,11 @@ gfc_trans_omp_array_reduction_or_udr (tree c, gfc_omp_namelist *n, locus where) iname = "ieor"; break; case ERROR_MARK: - if (n->udr->combiner->op == EXEC_ASSIGN) + if (n->u2.udr->combiner->op == EXEC_ASSIGN) { gfc_free_expr (e3); - e3 = gfc_copy_expr (n->udr->combiner->expr1); - e4 = gfc_copy_expr (n->udr->combiner->expr2); + e3 = gfc_copy_expr (n->u2.udr->combiner->expr1); + e4 = gfc_copy_expr (n->u2.udr->combiner->expr2); t = gfc_resolve_expr (e3); gcc_assert (t); t = gfc_resolve_expr (e4); @@ -1984,7 +1985,7 @@ gfc_trans_omp_array_reduction_or_udr (tree c, gfc_omp_namelist *n, locus where) if (e2) stmt = gfc_trans_assignment (e1, e2, false, false); else - stmt = gfc_trans_call (n->udr->initializer, false, + stmt = gfc_trans_call (n->u2.udr->initializer, false, NULL_TREE, NULL_TREE, false); if (TREE_CODE (stmt) != BIND_EXPR) stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0)); @@ -1997,7 +1998,7 @@ gfc_trans_omp_array_reduction_or_udr (tree c, gfc_omp_namelist *n, locus where) if (e4) stmt = gfc_trans_assignment (e3, e4, false, true); else - stmt = gfc_trans_call (n->udr->combiner, false, + stmt = gfc_trans_call (n->u2.udr->combiner, false, NULL_TREE, NULL_TREE, false); if (TREE_CODE (stmt) != BIND_EXPR) stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0)); @@ -2272,12 +2273,70 @@ gfc_trans_omp_array_section (stmtblock_t *block, gfc_omp_namelist *n, ptr, ptr2); } +static tree +handle_iterator (gfc_namespace *ns, stmtblock_t *iter_block, tree block) +{ + tree list = NULL_TREE; + for (gfc_symbol *sym = ns->proc_name; sym; sym = sym->tlink) + { + gfc_constructor *c; + gfc_se se; + + tree last = make_tree_vec (6); + tree iter_var = gfc_get_symbol_decl (sym); + tree type = TREE_TYPE (iter_var); + TREE_VEC_ELT (last, 0) = iter_var; + DECL_CHAIN (iter_var) = BLOCK_VARS (block); + BLOCK_VARS (block) = iter_var; + + /* begin */ + c = gfc_constructor_first (sym->value->value.constructor); + gfc_init_se (&se, NULL); + gfc_conv_expr (&se, c->expr); + gfc_add_block_to_block (iter_block, &se.pre); + gfc_add_block_to_block (iter_block, &se.post); + TREE_VEC_ELT (last, 1) = fold_convert (type, se.expr); + + /* end */ + c = gfc_constructor_next (c); + gfc_init_se (&se, NULL); + gfc_conv_expr (&se, c->expr); + gfc_add_block_to_block (iter_block, &se.pre); + gfc_add_block_to_block (iter_block, &se.post); + TREE_VEC_ELT (last, 2) = fold_convert (type, se.expr); + + /* step */ + c = gfc_constructor_next (c); + tree step; + if (c) + { + gfc_init_se (&se, NULL); + gfc_conv_expr (&se, c->expr); + gfc_add_block_to_block (iter_block, &se.pre); + gfc_add_block_to_block (iter_block, &se.post); + gfc_conv_expr (&se, c->expr); + step = fold_convert (type, se.expr); + } + else + step = build_int_cst (type, 1); + TREE_VEC_ELT (last, 3) = step; + /* orig_step */ + TREE_VEC_ELT (last, 4) = save_expr (step); + TREE_CHAIN (last) = list; + list = last; + } + return list; +} + static tree gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, locus where, bool declare_simd = false, bool openacc = false) { tree omp_clauses = NULL_TREE, chunk_size, c; + tree iterator = NULL_TREE; + tree tree_block = NULL_TREE; + stmtblock_t iter_block; int list, ifc; enum omp_clause_code clause_code; gfc_se se; @@ -2482,10 +2541,22 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, } } break; + case OMP_LIST_AFFINITY: case OMP_LIST_DEPEND: for (; n != NULL; n = n->next) { - if (n->u.depend_op == OMP_DEPEND_SINK_FIRST) + gfc_init_block (&iter_block); + iterator = NULL_TREE; + if (n->u2.ns) + { + tree_block = make_node (BLOCK); + TREE_USED (tree_block) = 1; + BLOCK_VARS (tree_block) = NULL_TREE; + iterator = handle_iterator (n->u2.ns, &iter_block, + tree_block); + } + if (list == OMP_LIST_DEPEND + && n->u.depend_op == OMP_DEPEND_SINK_FIRST) { tree vec = NULL_TREE; unsigned int i; @@ -2539,7 +2610,10 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, if (!n->sym->attr.referenced) continue; - tree node = build_omp_clause (input_location, OMP_CLAUSE_DEPEND); + tree node = build_omp_clause (input_location, + list == OMP_LIST_DEPEND + ? OMP_CLAUSE_DEPEND + : OMP_CLAUSE_AFFINITY); if (n->expr == NULL || n->expr->ref->u.ar.type == AR_FULL) { tree decl = gfc_trans_omp_variable (n->sym, false); @@ -2573,33 +2647,42 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, gfc_conv_expr_descriptor (&se, n->expr); ptr = gfc_conv_array_data (se.expr); } - gfc_add_block_to_block (block, &se.pre); - gfc_add_block_to_block (block, &se.post); + gfc_add_block_to_block (&iter_block, &se.pre); + gfc_add_block_to_block (&iter_block, &se.post); ptr = fold_convert (build_pointer_type (char_type_node), ptr); OMP_CLAUSE_DECL (node) = build_fold_indirect_ref (ptr); } - switch (n->u.depend_op) + if (list == OMP_LIST_DEPEND) + switch (n->u.depend_op) + { + case OMP_DEPEND_IN: + OMP_CLAUSE_DEPEND_KIND (node) = OMP_CLAUSE_DEPEND_IN; + break; + case OMP_DEPEND_OUT: + OMP_CLAUSE_DEPEND_KIND (node) = OMP_CLAUSE_DEPEND_OUT; + break; + case OMP_DEPEND_INOUT: + OMP_CLAUSE_DEPEND_KIND (node) = OMP_CLAUSE_DEPEND_INOUT; + break; + case OMP_DEPEND_MUTEXINOUTSET: + OMP_CLAUSE_DEPEND_KIND (node) + = OMP_CLAUSE_DEPEND_MUTEXINOUTSET; + break; + case OMP_DEPEND_DEPOBJ: + OMP_CLAUSE_DEPEND_KIND (node) = OMP_CLAUSE_DEPEND_DEPOBJ; + break; + default: + gcc_unreachable (); + } + if (n->u2.ns) { - case OMP_DEPEND_IN: - OMP_CLAUSE_DEPEND_KIND (node) = OMP_CLAUSE_DEPEND_IN; - break; - case OMP_DEPEND_OUT: - OMP_CLAUSE_DEPEND_KIND (node) = OMP_CLAUSE_DEPEND_OUT; - break; - case OMP_DEPEND_INOUT: - OMP_CLAUSE_DEPEND_KIND (node) = OMP_CLAUSE_DEPEND_INOUT; - break; - case OMP_DEPEND_MUTEXINOUTSET: - OMP_CLAUSE_DEPEND_KIND (node) - = OMP_CLAUSE_DEPEND_MUTEXINOUTSET; - break; - case OMP_DEPEND_DEPOBJ: - OMP_CLAUSE_DEPEND_KIND (node) = OMP_CLAUSE_DEPEND_DEPOBJ; - break; - default: - gcc_unreachable (); + BLOCK_SUBBLOCKS (tree_block) = gfc_finish_block (&iter_block); + TREE_VEC_ELT (iterator, 5) = tree_block; + OMP_CLAUSE_DECL (node) = build_tree_list (iterator, OMP_CLAUSE_DECL (node)); } + else + gfc_add_block_to_block (block, &iter_block); omp_clauses = gfc_trans_add_clause (node, omp_clauses); } break; @@ -5675,10 +5758,23 @@ gfc_trans_omp_taskgroup (gfc_code *code) } static tree -gfc_trans_omp_taskwait (void) +gfc_trans_omp_taskwait (gfc_code *code) { - tree decl = builtin_decl_explicit (BUILT_IN_GOMP_TASKWAIT); - return build_call_expr_loc (input_location, decl, 0); + if (!code->ext.omp_clauses) + { + tree decl = builtin_decl_explicit (BUILT_IN_GOMP_TASKWAIT); + return build_call_expr_loc (input_location, decl, 0); + } + stmtblock_t block; + gfc_start_block (&block); + tree stmt = make_node (OMP_TASK); + TREE_TYPE (stmt) = void_type_node; + OMP_TASK_BODY (stmt) = NULL_TREE; + OMP_TASK_CLAUSES (stmt) = gfc_trans_omp_clauses (&block, + code->ext.omp_clauses, + code->loc); + gfc_add_expr_to_block (&block, stmt); + return gfc_finish_block (&block); } static tree @@ -6307,7 +6403,7 @@ gfc_trans_omp_directive (gfc_code *code) case EXEC_OMP_TASKLOOP_SIMD: return gfc_trans_omp_taskloop (code); case EXEC_OMP_TASKWAIT: - return gfc_trans_omp_taskwait (); + return gfc_trans_omp_taskwait (code); case EXEC_OMP_TASKYIELD: return gfc_trans_omp_taskyield (); case EXEC_OMP_TEAMS: diff --git a/gcc/gimplify.c b/gcc/gimplify.c index b65106b1459..cd03ca8d0cb 100644 --- a/gcc/gimplify.c +++ b/gcc/gimplify.c @@ -9506,6 +9506,10 @@ gimplify_scan_omp_clauses (tree *list_p, gimple_seq *pre_p, goto do_add; + case OMP_CLAUSE_AFFINITY: + /* Ignore. */ + remove = true; + break; case OMP_CLAUSE_DEPEND: if (OMP_CLAUSE_DEPEND_KIND (c) == OMP_CLAUSE_DEPEND_SINK) { diff --git a/gcc/testsuite/c-c++-common/gomp/affinity-1.c b/gcc/testsuite/c-c++-common/gomp/affinity-1.c new file mode 100644 index 00000000000..558e316bccd --- /dev/null +++ b/gcc/testsuite/c-c++-common/gomp/affinity-1.c @@ -0,0 +1,20 @@ +void +foo(int x) +{ + int a, b[5], cc, d[5][5]; +#pragma omp taskgroup + { + #pragma omp task affinity(a) + { } + #pragma omp task affinity(iterator(i=(int)__builtin_cos(1.0+a):5, jj =2:5:2) : b[i], d[i][jj]) + { } + #pragma omp task affinity(iterator(i=(int)__builtin_cos(1.0+a):5) : b[i], d[i][i]) + { } + #pragma omp task affinity (iterator(i=1:5): a) + { } + #pragma omp task affinity (iterator(i=1:5): a) affinity(iterator(i=1:5) : x) + { } + #pragma omp task affinity (iterator(unsigned long j=1:5, k=7:4:-1) : b[j+k],a) affinity (cc) + { } + } +} diff --git a/gcc/testsuite/c-c++-common/gomp/affinity-2.c b/gcc/testsuite/c-c++-common/gomp/affinity-2.c new file mode 100644 index 00000000000..7f3029605be --- /dev/null +++ b/gcc/testsuite/c-c++-common/gomp/affinity-2.c @@ -0,0 +1,232 @@ +/* { dg-do compile } */ +/* { dg-options "-fopenmp" } */ + +extern int a[][10], a2[][10]; +int b[10], c[10][2], d[10], e[10], f[10]; +int b2[10], c2[10][2], d2[10], e2[10], f2[10]; +int k[10], l[10], m[10], n[10], o; +int *p; +void bar (void); +int t[10]; +#pragma omp threadprivate (t) + +void +foo (int g[3][10], int h[4][8], int i[2][10], int j[][9], + int g2[3][10], int h2[4][8], int i2[2][10], int j2[][9]) +{ + #pragma omp task affinity( bar[2:5]) /* { dg-error "is not a variable" } */ + ; + #pragma omp task affinity( t[2:5]) + ; + #pragma omp task affinity( k[0.5:]) /* { dg-error "low bound \[^\n\r]* of array section does not have integral type" } */ + ; + #pragma omp task affinity( l[:7.5f]) /* { dg-error "length \[^\n\r]* of array section does not have integral type" } */ + ; + #pragma omp task affinity( m[p:]) /* { dg-error "low bound \[^\n\r]* of array section does not have integral type" } */ + ; + #pragma omp task affinity( n[:p]) /* { dg-error "length \[^\n\r]* of array section does not have integral type" } */ + ; + #pragma omp task affinity( o[2:5]) /* { dg-error "does not have pointer or array type" } */ + ; + #pragma omp task affinity( a[:][2:4]) /* { dg-error "array type length expression must be specified" } */ + ; + #pragma omp task affinity( b[-1:]) /* { dg-error "negative low bound in array section" } */ + ; + #pragma omp task affinity( c[:-3][1:1]) /* { dg-error "negative length in array section" } */ + ; + #pragma omp task affinity( d[11:]) /* { dg-error "low bound \[^\n\r]* above array section size" } */ + ; + #pragma omp task affinity( e[:11]) /* { dg-error "length \[^\n\r]* above array section size" } */ + ; + #pragma omp task affinity( f[1:10]) /* { dg-error "high bound \[^\n\r]* above array section size" } */ + ; + #pragma omp task affinity( g[:][2:4]) /* { dg-error "for array function parameter length expression must be specified" } */ + ; + #pragma omp task affinity( h[2:2][-1:]) /* { dg-error "negative low bound in array section" } */ + ; + #pragma omp task affinity( h[:1][:-3]) /* { dg-error "negative length in array section" } */ + ; + #pragma omp task affinity( i[:1][11:]) /* { dg-error "low bound \[^\n\r]* above array section size" } */ + ; + #pragma omp task affinity( j[3:4][:10]) /* { dg-error "length \[^\n\r]* above array section size" } */ + ; + #pragma omp task affinity( j[30:10][5:5]) /* { dg-error "high bound \[^\n\r]* above array section size" } */ + ; + #pragma omp task affinity( a2[:3][2:4]) + ; + #pragma omp task affinity( b2[0:]) + ; + #pragma omp task affinity( c2[:3][1:1]) + ; + #pragma omp task affinity( d2[9:]) + ; + #pragma omp task affinity( e2[:10]) + ; + #pragma omp task affinity( f2[1:9]) + ; + #pragma omp task affinity( g2[:2][2:4]) + ; + #pragma omp task affinity( h2[2:2][0:]) + ; + #pragma omp task affinity( h2[:1][:3]) + ; + #pragma omp task affinity( i2[:1][9:]) + ; + #pragma omp task affinity( j2[3:4][:9]) + ; + #pragma omp task affinity( j2[30:10][5:4]) + ; +} + +void bar2 (int a[10][10][10]); + +void +foo2 (int a[10][10][10], int **b) +{ + int c[10][10][10]; + #pragma omp task affinity( a[2:4][3:][:7], b[1:7][2:8]) + bar2 (a); + int i = 1, j = 3, k = 2, l = 6; + #pragma omp task affinity( a[++i:++j][++k:][:++l]) + bar2 (a); + #pragma omp task affinity( a[7:2][:][:], c[5:2][:][:]) + { + bar2 (c); + bar2 (a); + } +} + +void +foo3 (int a[10][10][10], int **b, int x) +{ + int c[10][10][10]; + #pragma omp task affinity( a[2:4][3:0][:7]) /* { dg-error "zero length array section" } */ + bar2 (a); + #pragma omp task affinity( b[:7][0:0][:0]) /* { dg-error "zero length array section" } */ + bar2 (a); + #pragma omp task affinity( c[:][:][10:]) /* { dg-error "zero length array section" } */ + bar2 (c); + #pragma omp task affinity( a[2:4][3:0][:x]) /* { dg-error "zero length array section" } */ + bar2 (a); + #pragma omp task affinity( b[:x][0:0][:0]) /* { dg-error "zero length array section" } */ + bar2 (a); + #pragma omp task affinity( c[:][x-2:x][10:]) /* { dg-error "zero length array section" } */ + bar2 (c); +} + +void +foo4 (int *p, int (*q)[10], int r[10], int s[10][10]) +{ + int a[10], b[10][10]; + #pragma omp task affinity ( p[-1:2]) + ; + #pragma omp task affinity ( q[-1:2][2:4]) + ; + #pragma omp task affinity ( q[-1:2][-2:4]) /* { dg-error "negative low bound in array section in" } */ + ; + #pragma omp task affinity ( r[-1:2]) + ; + #pragma omp task affinity ( s[-1:2][2:4]) + ; + #pragma omp task affinity ( s[-1:2][-2:4]) /* { dg-error "negative low bound in array section in" } */ + ; + #pragma omp task affinity ( a[-1:2]) /* { dg-error "negative low bound in array section in" } */ + ; + #pragma omp task affinity ( b[-1:2][2:4]) /* { dg-error "negative low bound in array section in" } */ + ; + #pragma omp task affinity ( b[1:2][-2:4]) /* { dg-error "negative low bound in array section in" } */ + ; + #pragma omp task affinity ( p[2:-3]) /* { dg-error "negative length in array section in" } */ + ; + #pragma omp task affinity ( q[2:-3][:]) /* { dg-error "negative length in array section in" } */ + ; + #pragma omp task affinity ( q[2:3][0:-1]) /* { dg-error "negative length in array section in" } */ + ; + #pragma omp task affinity ( r[2:-5]) /* { dg-error "negative length in array section in" } */ + ; + #pragma omp task affinity ( s[2:-5][:]) /* { dg-error "negative length in array section in" } */ + ; + #pragma omp task affinity ( s[2:5][0:-4]) /* { dg-error "negative length in array section in" } */ + ; + #pragma omp task affinity ( a[2:-5]) /* { dg-error "negative length in array section in" } */ + ; + #pragma omp task affinity ( b[2:-5][0:10]) /* { dg-error "negative length in array section in" } */ + ; + #pragma omp task affinity ( b[2:5][0:-4]) /* { dg-error "negative length in array section in" } */ + ; +} + +struct T { int c[3]; }; +struct S { int a; struct T *b; struct T g; }; +struct S sd[10]; +struct S *se[10]; +struct S *sf; +struct S sh; +struct U { int a : 5; }; +struct U si; + + +void +foo5 (void) +{ + #pragma omp task affinity( sd) + ; + #pragma omp task affinity( sd[2]) + ; + #pragma omp task affinity( sd[:]) + ; + #pragma omp task affinity( sd[2:2]) + ; + #pragma omp task affinity( sd[:2]) + ; + #pragma omp task affinity( sd[1].b->c[2]) + ; + #pragma omp task affinity( sd[0].a) + ; + #pragma omp task affinity( se[3]->a) + ; + #pragma omp task affinity( se[2]->b->c) + ; + #pragma omp task affinity( se[1]->b->c[2]) + ; + #pragma omp task affinity( (*sf).a) + ; + #pragma omp task affinity( sf->b->c[0]) + ; + #pragma omp task affinity( sf) + ; + #pragma omp task affinity( *sf) + ; + #pragma omp task affinity( sf[0]) + ; + #pragma omp task affinity( sf[0].a) + ; + #pragma omp task affinity( sh.g.c[2]) + ; +} + +void +foo6 (void) +{ + #pragma omp task affinity( sd[:2].b->c[2]) /* { dg-error "expected" } */ + ; + #pragma omp task affinity( sd[1:].b->c[2]) /* { dg-error "expected" } */ + ; + #pragma omp task affinity( sd[0:1].a) /* { dg-error "expected" } */ + ; + #pragma omp task affinity( se[3:2]->a) /* { dg-error "expected" } */ + ; + #pragma omp task affinity( se[2:2]->b->c) /* { dg-error "expected" } */ + ; + #pragma omp task affinity( se[1]->b->c[2:1]) /* { dg-error "expected" } */ + ; + #pragma omp task affinity( sf + 0) /* { dg-error "'sf' is not lvalue expression nor array section in 'affinity' clause" } */ + ; + #pragma omp task affinity( sf[0:1].a) /* { dg-error "expected" } */ + ; + #pragma omp task affinity( sh.g.c[2:1]) /* { dg-error "expected" } */ + ; + #pragma omp task affinity( si.a) /* { dg-error "bit-field 'si\\..*a' in 'affinity' clause" } */ + ; +} +/* { dg-additional-options "-Wno-volatile" { target c++ } } */ diff --git a/gcc/testsuite/c-c++-common/gomp/affinity-3.c b/gcc/testsuite/c-c++-common/gomp/affinity-3.c new file mode 100644 index 00000000000..1a476543048 --- /dev/null +++ b/gcc/testsuite/c-c++-common/gomp/affinity-3.c @@ -0,0 +1,77 @@ +/* { dg-additional-options "-Wno-volatile" { target c++ } } */ + +int arr[64], arr2[64]; +struct S { int a[4]; } k; +short arr4[4]; +volatile int v; +#define TEST_EQ(x,y) ({ int o[x == y ? 1 : -1]; 0; }) + +void +foo (unsigned char i, signed char j) +{ + #pragma omp task affinity (iterator (j=6:2:-2) : \ + arr[TEST_EQ (sizeof (j), sizeof (int)), \ + TEST_EQ (sizeof (i), sizeof (unsigned char)), \ + TEST_EQ (sizeof (k), sizeof (struct S)), j], \ + arr2[TEST_EQ (((__typeof (j)) -1) < 0, 1), \ + TEST_EQ (((__typeof (i)) -1) < 0, 0), \ + TEST_EQ (((__typeof (k.a[0])) -1) < 0, 1), j]) \ + affinity(arr[0]) \ + affinity (iterator (long long i=__LONG_LONG_MAX__ - 4:__LONG_LONG_MAX__ - 2:2, \ + unsigned short j=~0U-16:~0U-8:3, \ + short *k=&arr4[1]:&arr4[2]:1) : \ + arr[TEST_EQ (sizeof (i), sizeof (long long)), \ + TEST_EQ (sizeof (j), sizeof (unsigned short)), \ + TEST_EQ (sizeof (k), sizeof (short *)), \ + TEST_EQ (sizeof (*k), sizeof (short)), i - __LONG_LONG_MAX__ + 4], \ + arr2[TEST_EQ (((__typeof (i)) -1) < 0, 1), \ + TEST_EQ (((__typeof (j)) -1) < 0, 0), \ + TEST_EQ (((__typeof (*k)) -1) < 0, 1), j - (~0U-16)], \ + arr2[k - &arr4[0]]) \ + affinity( k) + v++; +} + +void +bar (unsigned char i, signed char j) +{ + int m = j; + int n = j + 2; + #pragma omp task affinity (iterator (j=6:2:m) : \ + arr[TEST_EQ (sizeof (j), sizeof (int)), \ + TEST_EQ (sizeof (i), sizeof (unsigned char)), \ + TEST_EQ (sizeof (k), sizeof (struct S)), j], \ + arr2[TEST_EQ (((__typeof (j)) -1) < 0, 1), \ + TEST_EQ (((__typeof (i)) -1) < 0, 0), \ + TEST_EQ (((__typeof (k.a[0])) -1) < 0, 1), j]) \ + affinity( arr[0]) \ + affinity (iterator (long long i=__LONG_LONG_MAX__ - 4 - n:__LONG_LONG_MAX__ - 2:2, \ + unsigned short j=~0U-16:~0U-8-n:3, \ + short *k=&arr4[1]:&arr4[n + 2]:1) : \ + arr[TEST_EQ (sizeof (i), sizeof (long long)), \ + TEST_EQ (sizeof (j), sizeof (unsigned short)), \ + TEST_EQ (sizeof (k), sizeof (short *)), \ + TEST_EQ (sizeof (*k), sizeof (short)), i - __LONG_LONG_MAX__ + 4], \ + arr2[TEST_EQ (((__typeof (i)) -1) < 0, 1), \ + TEST_EQ (((__typeof (j)) -1) < 0, 0), \ + TEST_EQ (((__typeof (*k)) -1) < 0, 1), j - (~0U-16)], \ + arr2[k - &arr4[0]:10]) \ + affinity( k) + v++; +} + +void +baz (void) +{ + #pragma omp parallel + #pragma omp master + { + #pragma omp task affinity(iterator(unsigned long int k = 0 : 2) : \ + arr[TEST_EQ (sizeof (k), sizeof (unsigned long)), \ + TEST_EQ (((__typeof (k)) -1) < 0, 0), k]) \ + affinity(iterator(signed char s = -3 : -12 : -1) : \ + arr[TEST_EQ (sizeof (s), sizeof (signed char)), \ + TEST_EQ (((__typeof (s)) -1) < 0, 1), s + 12]) + v++; + } +} diff --git a/gcc/testsuite/c-c++-common/gomp/affinity-4.c b/gcc/testsuite/c-c++-common/gomp/affinity-4.c new file mode 100644 index 00000000000..2a4df6dafa3 --- /dev/null +++ b/gcc/testsuite/c-c++-common/gomp/affinity-4.c @@ -0,0 +1,77 @@ +int a, b[64]; +struct S { int c; } *d, *e; +struct T; +struct T *f, *g; +int *h; + +void +f1 (void) +{ + #pragma omp task affinity (iterator : a) /* { dg-error "expected" } */ + ; + #pragma omp task affinity (iterator (for = 0 : 2) : a) /* { dg-error "expected" } */ + ; + #pragma omp task affinity (iterator (5 = 0 : 2) : a) /* { dg-error "expected" } */ + ; + #pragma omp task affinity (iterator (i : 0 : 2) : a) /* { dg-error "expected '='|name a type|expected" } */ + ; + #pragma omp task affinity (iterator (i = 0, 1 : 2) : a) /* { dg-error "expected" } */ + ; + #pragma omp task affinity (iterator (i = (0, 1) : 2) : a) + ; + #pragma omp task affinity (iterator (i = 0 : 1 : 2 : 3) : a) /* { dg-error "expected '.'" } */ + ; + #pragma omp task affinity (iterator (i = 0 : 2, 3) : a) /* { dg-error "expected" } */ + ; + #pragma omp task affinity (iterator (i = 0 : 10 : 2, 3) : a) /* { dg-error "expected" } */ + ; + #pragma omp task affinity (iterator (i = 0:1), iterator (j = 0:1) : a) /* { dg-error "expected ':' before ',' token" } */ + ; + #pragma omp task affinity (iterator (i = 0:32) : b[i*2:2]) + ; + #pragma omp task affinity (iterator (struct S i = 0:1) : a) /* { dg-error "iterator 'i' has neither integral nor pointer type" } */ + ; + #pragma omp task affinity (iterator (void i = 0:1) : a) /* { dg-error "iterator 'i' has neither integral nor pointer type" } */ + ; + #pragma omp task affinity (iterator (float f = 0.2:0.4) : a) /* { dg-error "iterator 'f' has neither integral nor pointer type" } */ + ; + #pragma omp task affinity (iterator (struct S *p = d:e:2) : a) + ; + #pragma omp task affinity (iterator (struct T *p = f:g) , a) /* { dg-error "expected ':' before ',' token" } */ + ; + #pragma omp task affinity (iterator (int i = 0:4, \ + struct U { int (*p)[i + 2]; } *p = 0:2) : a) /* { dg-error "type of iterator 'p' refers to outer iterator 'i'" "" { target c } } */ + ; /* { dg-error "types may not be defined in iterator type|not an integral constant" "" { target c++ } .-1 } */ + #pragma omp task affinity (iterator (i = 0:4, j = i:16) : a) /* { dg-error "begin expression refers to outer iterator 'i'" } */ + ; + #pragma omp task affinity (iterator (i = 0:4, j = 2:i:1) : a) /* { dg-error "end expression refers to outer iterator 'i'" } */ + ; + #pragma omp task affinity (iterator (i = 0:4, j = 2:8:i) : a) /* { dg-error "step expression refers to outer iterator 'i'" } */ + ; + #pragma omp task affinity (iterator (i = *d:2) : a) /* { dg-error "aggregate value used where an integer was expected" "" { target c } } */ + ; /* { dg-error "invalid cast from type 'S' to type 'int'" "" { target c++ } .-1 } */ + #pragma omp task affinity (iterator (i = 2:*d:2) : a) /* { dg-error "aggregate value used where an integer was expected" "" { target c } } */ + ; /* { dg-error "invalid cast from type 'S' to type 'int'" "" { target c++ } .-1 } */ + #pragma omp task affinity (iterator (i = 2:4:*d) : a) /* { dg-error "iterator step with non-integral type" } */ + ; + #pragma omp task affinity (iterator (i = 1.25:2.5:3) : a) + ; + #pragma omp task affinity (iterator (i = 1:2:3.5) : a) /* { dg-error "iterator step with non-integral type" } */ + ; + #pragma omp task affinity (iterator (int *p = 23 : h) : a) + ; + #pragma omp task affinity (iterator (short i=1:3:0) : a) /* { dg-error "iterator 'i' has zero step" } */ + ; + #pragma omp task affinity (iterator (i = 1 : 3 : 3 - 3) : a) /* { dg-error "iterator 'i' has zero step" } */ + ; + #pragma omp task affinity (iterator (int *p = &b[6]:&b[9]:4 - 4) : a) /* { dg-error "iterator 'p' has zero step" } */ + ; + #pragma omp task affinity (iterator (const int i = 0 : 2) : a) /* { dg-error "const qualified" } */ + ; + #pragma omp task affinity (iterator (const long long unsigned i = 0 : 2) : a) /* { dg-error "const qualified" } */ + ; +#if !defined (__cplusplus) && __STDC_VERSION__ >= 201112L + #pragma omp task affinity (iterator (_Atomic unsigned i = 0 : 2) : a) /* { dg-error "_Atomic" "" { target c } } */ + ; +#endif +} diff --git a/gcc/testsuite/gfortran.dg/gomp/affinity-clause-1.f90 b/gcc/testsuite/gfortran.dg/gomp/affinity-clause-1.f90 new file mode 100644 index 00000000000..3e99affdfb4 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/affinity-clause-1.f90 @@ -0,0 +1,31 @@ +! { dg-additional-options "-fdump-tree-original" } +subroutine foo(x) + integer :: x + integer :: a, b(5), cc, d(5,5) + !$omp taskgroup + !$omp task affinity(a) + !$omp end task + !$omp task affinity(iterator(i=int(cos(1.0+a)):5, jj =2:5:2) : b(i), d(i,jj)) + !$omp end task + !$omp task affinity(iterator(i=int(cos(1.0+a)):5) : b(i), d(i,i)) + !$omp end task + !$omp task affinity (iterator(i=1:5): a) + !$omp end task + !$omp task affinity (iterator(i=1:5): a) affinity(iterator(i=1:5) : x) + !$omp end task + !$omp task affinity (iterator(integer(8) :: j=1:5, k=7:4:-1) : b(j+k),a) affinity (cc) + !$omp end task + !$omp end taskgroup +end + +! { dg-final { scan-tree-dump-times "#pragma omp task affinity\\(a\\)" 1 "original" } } + +! { dg-final { scan-tree-dump-times "#pragma omp task affinity\\(iterator\\(integer\\(kind=4\\) jj=2:5:2, integer\\(kind=4\\) i=\\(integer\\(kind=4\\)\\) __builtin_cosf \\(\\(real\\(kind=4\\)\\) a \\+ 1.0e\\+0\\):5:1\\):\\*\\(c_char \\*\\) &b\\\[\\(integer\\(kind=8\\)\\) i \\+ -1\\\]\\) affinity\\(iterator\\(integer\\(kind=4\\) jj=2:5:2, integer\\(kind=4\\) i=\\(integer\\(kind=4\\)\\) __builtin_cosf \\(\\(real\\(kind=4\\)\\) a \\+ 1.0e\\+0\\):5:1\\):\\*\\(c_char \\*\\) &d\\\[\\(\\(integer\\(kind=8\\)\\) jj \\* 5 \\+ \\(integer\\(kind=8\\)\\) i\\) \\+ -6\\\]\\)" 1 "original" } } + +! { dg final { scan-tree-dump-times "#pragma omp task affinity\\(iterator\\(integer\\(kind=4\\) i=\\(integer\\(kind=4\\)\\) __builtin_cosf \\(\\(real\\(kind=4\\)\\) a \\+ 1.0e\\+0\\):5:1\\):\\*\\(c_char \\*\\) &b\\\[\\(integer\\(kind=8\\)\\) i \\+ -1\\\]\\) affinity\\(iterator\\(integer\\(kind=4\\) i=\\(integer\\(kind=4\\)\\) __builtin_cosf \\(\\(real\\(kind=4\\)\\) a \\+ 1.0e+0\\):5:1\\):\\*\\(c_char \\*\\) &d\\\[\\(\\(integer\\(kind=8\\)\\) i \\+ -1\\) \\* 6\\\]\\)" 1 "original" } } + +! { dg-final { scan-tree-dump-times "#pragma omp task affinity\\(iterator\\(integer\\(kind=4\\) i=1:5:1\\):a\\)\[^ \]" 1 "original" } } + +! { dg-final { scan-tree-dump-times "#pragma omp task affinity\\(iterator\\(integer\\(kind=4\\) i=1:5:1\\):a\\) affinity\\(iterator\\(integer\\(kind=4\\) i=1:5:1\\):\\*x\\)" 1 "original" } } + +! { dg-final { scan-tree-dump-times "#pragma omp task affinity\\(iterator\\(integer\\(kind=4\\) k=7:4:-1, integer\\(kind=8\\) j=1:5:1\\):\\*\\(c_char \\*\\) &b\\\[\\(\\(integer\\(kind=8\\)\\) k \\+ j\\) \\+ -1\\\]\\) affinity\\(iterator\\(integer\\(kind=4\\) k=7:4:-1, integer\\(kind=8\\) j=1:5:1\\):a\\) affinity\\(cc\\)" 1 "original" } } diff --git a/gcc/testsuite/gfortran.dg/gomp/affinity-clause-2.f90 b/gcc/testsuite/gfortran.dg/gomp/affinity-clause-2.f90 new file mode 100644 index 00000000000..6a21ad26a89 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/affinity-clause-2.f90 @@ -0,0 +1,27 @@ +subroutine foo + implicit none + external bar + integer :: i, b(10) + !$omp task affinity(bar(1)) ! { dg-error "not a variable" } + !!$omp end task + !$omp task affinity(b(1.0)) ! { dg-warning "Legacy Extension: REAL array index" } + !$omp end task + !$omp task affinity( iterator( real :: i=1.0:5:1) : b(i)) ! { dg-error "Expected INTEGER type" } + !!$omp end task + !$omp task affinity(iterator(i=1.0:5:1) : b(i)) ! { dg-error "Scalar integer expression for range begin expected" } + !$omp end task + !$omp task affinity(iterator(i=1:5.0:1) : b(i)) ! { dg-error "Scalar integer expression for range end expected" } + !$omp end task + !$omp task affinity(iterator(i=1:5:1.0) : b(i)) ! { dg-error "Scalar integer expression for range step expected" } + !$omp end task + !$omp task affinity(iterator(j=1:3:5, i=1:5:0) : b(i)) ! { dg-error "Nonzero range step expected" } + !$omp end task + !$omp task affinity(iterator(=1:5:0) : b(i)) ! { dg-error "Expected identifier" } + !!$omp end task + !$omp task affinity(iterator(b(2)=1:5:0) : b(i)) ! { dg-error "Failed to match clause" } + !!$omp end task + !$omp task affinity(iterator(i=1:5:0, i=4:6) : b(i)) ! { dg-error "Same identifier 'i' specified again" } + !!$omp end task + !$omp task affinity(iterator(i=1) : b(i)) ! { dg-error "Expected range-specification" } + !!$omp end task +end diff --git a/gcc/testsuite/gfortran.dg/gomp/depend-iterator-1.f90 b/gcc/testsuite/gfortran.dg/gomp/depend-iterator-1.f90 new file mode 100644 index 00000000000..cad36aaf8b7 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/depend-iterator-1.f90 @@ -0,0 +1,45 @@ +! { dg-do run } + +module mymod + implicit none (type, external) + integer, target :: var(0:5) = [0,1,2,3,4,5] +end module mymod + +program main + use mymod + implicit none + + type t + integer :: x(0:64) + integer :: y + end type t + type(t) :: dep2(0:64) + integer :: dep1(0:64) + + integer arr(0:63) + !$omp parallel + !$omp master + block + integer :: i + do i = 0, 63 + !$omp task depend (iterator (j=i:i+1) , out : dep1 (j)) + arr(i) = i + !$omp end task + !$omp task depend (iterator (j=i:i+1) , out : dep2 (j)) + arr(i) = i + !$omp end task + !$omp task depend (iterator (j=i:i+1) , out : dep2 (j)%y) + arr(i) = i + !$omp end task + !$omp task depend (iterator (j=i:i+1) , out : dep2 (j)%x(j)) + arr(i) = i + !$omp end task + !$omp task depend (out : dep2 (:4)) + arr(i) = i + !$omp end task + !$omp taskwait depend(out: dep1(1)) + end do + end block + !$omp end master + !$omp end parallel +end diff --git a/gcc/testsuite/gfortran.dg/gomp/depend-iterator-3.f90 b/gcc/testsuite/gfortran.dg/gomp/depend-iterator-3.f90 new file mode 100644 index 00000000000..85465ee4c7a --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/depend-iterator-3.f90 @@ -0,0 +1,27 @@ +subroutine foo + implicit none + external bar + integer :: i, b(10) + !$omp task depend(in : bar(1)) ! { dg-error "not a variable" } + !!$omp end task + !$omp task depend(out : b(1.0)) ! { dg-warning "Legacy Extension: REAL array index" } + !$omp end task + !$omp task depend( iterator( real :: i=1.0:5:1), in : b(i)) ! { dg-error "Expected INTEGER type" } + !!$omp end task + !$omp task depend(iterator(i=1.0:5:1), out : b(i)) ! { dg-error "Scalar integer expression for range begin expected" } + !$omp end task + !$omp task depend(iterator(i=1:5.0:1), in : b(i)) ! { dg-error "Scalar integer expression for range end expected" } + !$omp end task + !$omp task depend(iterator(i=1:5:1.0), in : b(i)) ! { dg-error "Scalar integer expression for range step expected" } + !$omp end task + !$omp task depend(iterator(j=1:3:5, i=1:5:0), out : b(i)) ! { dg-error "Nonzero range step expected" } + !$omp end task + !$omp task depend(iterator(=1:5:0), in : b(i)) ! { dg-error "Expected identifier" } + !!$omp end task + !$omp task depend(iterator(b(2)=1:5:1), in : b(i)) ! { dg-error "Failed to match clause" } + !!$omp end task + !$omp task depend(iterator(i=1:5:0, i=4:6), out: b(i)) ! { dg-error "Same identifier 'i' specified again" } + !!$omp end task + !$omp task depend(iterator(i=1) ,out: b(i)) ! { dg-error "Expected range-specification" } + !!$omp end task +end diff --git a/gcc/testsuite/gfortran.dg/taskwait.f90 b/gcc/testsuite/gfortran.dg/taskwait.f90 new file mode 100644 index 00000000000..ea49d298cb0 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/taskwait.f90 @@ -0,0 +1,7 @@ +! { dg-additional-arguments "-fdump-tree-original" } +!$omp taskwait +!$omp taskwait depend(out:foo) +end + +! { dg-final { scan-tree-dump-times "__builtin_GOMP_taskwait \\(\\)" 1 "original" } } +! { dg-final { scan-tree-dump-times "#pragma omp taskwait depend\\(out:foo\\)" 1 "original" } } diff --git a/gcc/tree-core.h b/gcc/tree-core.h index 07ddf91a230..e15e6c651f0 100644 --- a/gcc/tree-core.h +++ b/gcc/tree-core.h @@ -277,6 +277,9 @@ enum omp_clause_code { /* OpenMP clause: linear (variable-list[:linear-step]). */ OMP_CLAUSE_LINEAR, + /* OpenMP clause: affinity([depend-modifier :] variable-list). */ + OMP_CLAUSE_AFFINITY, + /* OpenMP clause: aligned (variable-list[:alignment]). */ OMP_CLAUSE_ALIGNED, diff --git a/gcc/tree-pretty-print.c b/gcc/tree-pretty-print.c index 0a575eb9dad..d8a4f55b2ae 100644 --- a/gcc/tree-pretty-print.c +++ b/gcc/tree-pretty-print.c @@ -743,6 +743,22 @@ dump_omp_clause (pretty_printer *pp, tree clause, int spc, dump_flags_t flags) pp_right_paren (pp); break; + case OMP_CLAUSE_AFFINITY: + pp_string (pp, "affinity("); + { + tree t = OMP_CLAUSE_DECL (clause); + if (TREE_CODE (t) == TREE_LIST + && TREE_PURPOSE (t) + && TREE_CODE (TREE_PURPOSE (t)) == TREE_VEC) + { + dump_omp_iterators (pp, TREE_PURPOSE (t), spc, flags); + pp_colon (pp); + t = TREE_VALUE (t); + } + dump_generic_node (pp, t, spc, flags, false); + } + pp_right_paren (pp); + break; case OMP_CLAUSE_DEPEND: pp_string (pp, "depend("); switch (OMP_CLAUSE_DEPEND_KIND (clause)) @@ -803,8 +819,11 @@ dump_omp_clause (pretty_printer *pp, tree clause, int spc, dump_flags_t flags) pp_colon (pp); t = TREE_VALUE (t); } - pp_string (pp, name); - pp_colon (pp); + if (name[0]) + { + pp_string (pp, name); + pp_colon (pp); + } dump_generic_node (pp, t, spc, flags, false); pp_right_paren (pp); } diff --git a/gcc/tree.c b/gcc/tree.c index 6129d911ee6..2d383e21e60 100644 --- a/gcc/tree.c +++ b/gcc/tree.c @@ -290,6 +290,7 @@ unsigned const char omp_clause_num_ops[] = 1, /* OMP_CLAUSE_COPYIN */ 1, /* OMP_CLAUSE_COPYPRIVATE */ 3, /* OMP_CLAUSE_LINEAR */ + 1, /* OMP_CLAUSE_AFFINITY */ 2, /* OMP_CLAUSE_ALIGNED */ 2, /* OMP_CLAUSE_ALLOCATE */ 1, /* OMP_CLAUSE_DEPEND */ @@ -376,6 +377,7 @@ const char * const omp_clause_code_name[] = "copyin", "copyprivate", "linear", + "affinity", "aligned", "allocate", "depend", @@ -12227,6 +12229,7 @@ walk_tree_1 (tree *tp, walk_tree_fn func, void *data, WALK_SUBTREE (OMP_CLAUSE_OPERAND (*tp, 1)); /* FALLTHRU */ + case OMP_CLAUSE_AFFINITY: case OMP_CLAUSE_ASYNC: case OMP_CLAUSE_WAIT: case OMP_CLAUSE_WORKER: diff --git a/libgomp/testsuite/libgomp.fortran/depend-iterator-2.f90 b/libgomp/testsuite/libgomp.fortran/depend-iterator-2.f90 new file mode 100644 index 00000000000..05090d36c80 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/depend-iterator-2.f90 @@ -0,0 +1,89 @@ +module m + implicit none (type, external) + integer, volatile :: v +contains +subroutine foo (p, i) + integer :: p(0:*) + integer :: i + !$omp task depend (out: p(0)) + v = v + 1 + !$omp end task + !$omp task depend (in: p(0)) + v = v + 1 + !$omp end task + !$omp task depend (inout: p(0)) + v = v + 1 + !$omp end task + !$omp task depend (mutexinoutset: p(0)) + v = v + 1 + !$omp end task + !$omp task depend (out: p(0)) depend (in: p(1)) + v = v + 1 + !$omp end task + !$omp task depend (in: p(0)) depend (inout: p(1)) + v = v + 1 + !$omp end task + !$omp task depend (inout: p(0)) depend (mutexinoutset: p(1)) + v = v + 1 + !$omp end task + !$omp task depend (mutexinoutset: p(0)) depend (out: p(1)) + v = v + 1 + !$omp end task + !$omp task depend (iterator (j=0:2) , out : p(j)) + v = v + 1 + !$omp end task + !$omp task depend (iterator (j=0:2) , in : p(j)) + v = v + 1 + !$omp end task + !$omp task depend (iterator (j=0:2) , inout : p(j)) + v = v + 1 + !$omp end task + !$omp task depend (iterator (j=0:2) , mutexinoutset : p(j)) + v = v + 1 + !$omp end task + !$omp task depend (iterator (j=0:2) , out : p(j)) depend (iterator (j=0:2) , in : p(j + 2)) + v = v + 1 + !$omp end task + !$omp task depend (iterator (j=0:2) , in : p(j)) depend (iterator (j=0:2) , inout : p(j + 2)) + v = v + 1 + !$omp end task + !$omp task depend (iterator (j=0:2) , inout : p(j)) depend (iterator (j=0:2) , mutexinoutset : p(j + 2)) + v = v + 1 + !$omp end task + !$omp task depend (iterator (j=0:2) , mutexinoutset : p(j)) depend (iterator (j=0:2) , out : p(j + 2)) + v = v + 1 + !$omp end task + !$omp task depend (iterator (j=0:i) , out : p(j)) + v = v + 1 + !$omp end task + !$omp task depend (iterator (j=0:i) , in : p(j)) + v = v + 1 + !$omp end task + !$omp task depend (iterator (j=0:i) , inout : p(j)) + v = v + 1 + !$omp end task + !$omp task depend (iterator (j=0:i) , mutexinoutset : p(j)) + v = v + 1 + !$omp end task + !$omp task depend (iterator (j=0:i) , out : p(j)) depend (iterator (j=0:i) , in : p(j + 2)) + v = v + 1 + !$omp end task + !$omp task depend (iterator (j=0:i) , in : p(j)) depend (iterator (j=0:i) , inout : p(j + 2)) + v = v + 1 + !$omp end task + !$omp task depend (iterator (j=0:i) , inout : p(j)) depend (iterator (j=0:i) , mutexinoutset : p(j + 2)) + v = v + 1 + !$omp end task + !$omp task depend (iterator (j=0:i) , mutexinoutset : p(j)) depend (iterator (j=0:i) , out : p(j + 2)) + v = v + 1 + !$omp end task +end +end module + +program main + use m + implicit none (external, type) + integer p(4) + call foo (p, 2) + call foo (p, -1) +end