From patchwork Wed Dec 14 10:47:21 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Tobias Burnus X-Patchwork-Id: 1715721 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@legolas.ozlabs.org Authentication-Results: legolas.ozlabs.org; spf=pass (sender SPF authorized) smtp.mailfrom=gcc.gnu.org (client-ip=2620:52:3:1:0:246e:9693:128c; helo=sourceware.org; envelope-from=gcc-patches-bounces+incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Received: from sourceware.org (server2.sourceware.org [IPv6:2620:52:3:1:0:246e:9693:128c]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange X25519 server-signature ECDSA (P-384) server-digest SHA384) (No client certificate requested) by legolas.ozlabs.org (Postfix) with ESMTPS id 4NXBsJ36N5z23yr for ; Wed, 14 Dec 2022 21:47:46 +1100 (AEDT) Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 0125C38362DA for ; Wed, 14 Dec 2022 10:47:45 +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 92E2E383A0EC; Wed, 14 Dec 2022 10:47:28 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org 92E2E383A0EC Authentication-Results: sourceware.org; dmarc=none (p=none dis=none) header.from=codesourcery.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=mentor.com X-IronPort-AV: E=Sophos;i="5.96,244,1665475200"; d="diff'?scan'208";a="92862473" Received: from orw-gwy-01-in.mentorg.com ([192.94.38.165]) by esa1.mentor.iphmx.com with ESMTP; 14 Dec 2022 02:47:27 -0800 IronPort-SDR: lWTE8RRZ6l6kmMwgkgODxzRWJ8+skLnvEGdoYlO5cZ5XUfN8RAYS7GS3VpN3smUcLHFOqlnIgE tUS9/FAelA3EKhY8L7qZ0U8JN4iijQqwUzP22toKY0sUCIuYF6tz+8ZVmV0DOM9yLBsDFr7JV7 BUegwIdQQGvi6r02uBt16Yj3yWSJXfXHz/vGuSvP5pVHaEa4I/J8qefHS3cf4egihmnL5wZF1y pQYajWsG3HnYXS3UI6YioSN3cbeOCY6xKh9hFa3t+iMeJrtpPqXi6gVh6xnN/XIfDm+64mWiMT 1h8= Message-ID: <11d6c8f4-cdb1-ddb6-8d48-f76c4c8e6382@codesourcery.com> Date: Wed, 14 Dec 2022 11:47:21 +0100 MIME-Version: 1.0 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:102.0) Gecko/20100101 Thunderbird/102.5.1 Content-Language: en-US To: gcc-patches , Jakub Jelinek , fortran From: Tobias Burnus Subject: [Patch] Fortran/OpenMP: Add parsing support for allocators directive X-Originating-IP: [137.202.0.90] X-ClientProxiedBy: svr-ies-mbx-15.mgc.mentorg.com (139.181.222.15) To svr-ies-mbx-12.mgc.mentorg.com (139.181.222.12) X-Spam-Status: No, score=-11.4 required=5.0 tests=BAYES_00, GIT_PATCH_0, HEADER_FROM_DIFFERENT_DOMAINS, KAM_DMARC_STATUS, KAM_SHORT, SPF_HELO_PASS, SPF_PASS, TXREP 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.29 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: gcc-patches-bounces+incoming=patchwork.ozlabs.org@gcc.gnu.org Sender: "Gcc-patches" This patch adds parsing/argument-checking support for '!$omp allocators allocate([align(int),allocator(a) :] list)' This is kind of logical follow-up and prep patch for the '!$omp allocate(list) [align(v) allocator(a)]' support that was submitted as part of a larger patchset by Abid; cf. review at "[PATCH 1/5] [gfortran] Add parsing support for allocate directive (OpenMP 5.0)." https://gcc.gnu.org/pipermail/gcc-patches/2022-October/603258.html My follow-up patch will add parsing support for declarative/executable '!$omp allocate'. OK for mainline? Tobias ----------------- Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201, 80634 München; Gesellschaft mit beschränkter Haftung; Geschäftsführer: Thomas Heurung, Frank Thürauf; Sitz der Gesellschaft: München; Registergericht München, HRB 106955 Fortran/OpenMP: Add parsing support for allocators directive gcc/fortran/ChangeLog: * gfortran.h (enum gfc_statement): Add ST_OMP_ALLOCATORS and ST_OMP_END_ALLOCATORS. (enum gfc_exec_op): Add EXEC_OMP_ALLOCATORS. * dump-parse-tree.cc (show_omp_node, show_code_node): Handle OpenMP's ALLOCATORS directive. * match.h (gfc_match_omp_allocators): New prototype. * openmp.cc (OMP_ALLOCATORS_CLAUSES): Define. (gfc_match_omp_allocators): New. (resolve_omp_clauses, omp_code_to_statement, gfc_resolve_omp_directive): Handle EXEC_OMP_ALLOCATORS. * parse.cc (parse_openmp_allocate_block): New. (case_exec_markers): Add ST_OMP_ALLOCATORS. (decode_omp_directive, gfc_ascii_statement, parse_executable): Parse OpenMP allocators directive. * resolve.cc (gfc_resolve_blocks): Handle EXEC_OMP_ALLOCATORS. * st.cc (gfc_free_statement): Likewise. * trans.cc (trans_code): Likewise. * trans-openmp.cc (gfc_trans_omp_directive): Show 'sorry' for EXEC_OMP_ALLOCATORS. gcc/testsuite/ChangeLog: * gfortran.dg/gomp/allocators-1.f90: New test. * gfortran.dg/gomp/allocators-2.f90: New test. gcc/fortran/dump-parse-tree.cc | 2 + gcc/fortran/gfortran.h | 3 +- gcc/fortran/match.h | 1 + gcc/fortran/openmp.cc | 31 ++++++++++++++- gcc/fortran/parse.cc | 50 ++++++++++++++++++++++++- gcc/fortran/resolve.cc | 2 + gcc/fortran/st.cc | 1 + gcc/fortran/trans-openmp.cc | 3 ++ gcc/fortran/trans.cc | 1 + gcc/testsuite/gfortran.dg/gomp/allocators-1.f90 | 28 ++++++++++++++ gcc/testsuite/gfortran.dg/gomp/allocators-2.f90 | 22 +++++++++++ 11 files changed, 140 insertions(+), 4 deletions(-) diff --git a/gcc/fortran/dump-parse-tree.cc b/gcc/fortran/dump-parse-tree.cc index 5ae72dc1cac..4565b71c758 100644 --- a/gcc/fortran/dump-parse-tree.cc +++ b/gcc/fortran/dump-parse-tree.cc @@ -2081,6 +2081,7 @@ show_omp_node (int level, gfc_code *c) case EXEC_OACC_CACHE: name = "CACHE"; is_oacc = true; break; case EXEC_OACC_ENTER_DATA: name = "ENTER DATA"; is_oacc = true; break; case EXEC_OACC_EXIT_DATA: name = "EXIT DATA"; is_oacc = true; break; + case EXEC_OMP_ALLOCATORS: name = "ALLOCATORS"; break; case EXEC_OMP_ASSUME: name = "ASSUME"; break; case EXEC_OMP_ATOMIC: name = "ATOMIC"; break; case EXEC_OMP_BARRIER: name = "BARRIER"; break; @@ -3409,6 +3410,7 @@ show_code_node (int level, gfc_code *c) case EXEC_OACC_CACHE: case EXEC_OACC_ENTER_DATA: case EXEC_OACC_EXIT_DATA: + case EXEC_OMP_ALLOCATORS: case EXEC_OMP_ASSUME: case EXEC_OMP_ATOMIC: case EXEC_OMP_CANCEL: diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 5f8a81ae4a1..63f38d26666 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -318,6 +318,7 @@ enum gfc_statement 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_ERROR, ST_OMP_ASSUME, ST_OMP_END_ASSUME, ST_OMP_ASSUMES, + ST_OMP_ALLOCATORS, ST_OMP_END_ALLOCATORS, /* Note: gfc_match_omp_nothing returns ST_NONE. */ ST_OMP_NOTHING, ST_NONE }; @@ -2959,7 +2960,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_ERROR + EXEC_OMP_ERROR, EXEC_OMP_ALLOCATORS }; typedef struct gfc_code diff --git a/gcc/fortran/match.h b/gcc/fortran/match.h index 2a805815d9c..b1f5db80125 100644 --- a/gcc/fortran/match.h +++ b/gcc/fortran/match.h @@ -149,6 +149,7 @@ match gfc_match_oacc_routine (void); /* OpenMP directive matchers. */ match gfc_match_omp_eos_error (void); +match gfc_match_omp_allocators (void); match gfc_match_omp_assume (void); match gfc_match_omp_assumes (void); match gfc_match_omp_atomic (void); diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc index 686f924b47a..e978f8774c4 100644 --- a/gcc/fortran/openmp.cc +++ b/gcc/fortran/openmp.cc @@ -55,7 +55,7 @@ struct gfc_omp_directive { static const struct gfc_omp_directive gfc_omp_directives[] = { /* {"allocate", GFC_OMP_DIR_DECLARATIVE, ST_OMP_ALLOCATE}, */ - /* {"allocators", GFC_OMP_DIR_EXECUTABLE, ST_OMP_ALLOCATORS}, */ + {"allocators", GFC_OMP_DIR_EXECUTABLE, ST_OMP_ALLOCATORS}, {"assumes", GFC_OMP_DIR_INFORMATIONAL, ST_OMP_ASSUMES}, {"assume", GFC_OMP_DIR_INFORMATIONAL, ST_OMP_ASSUME}, {"atomic", GFC_OMP_DIR_EXECUTABLE, ST_OMP_ATOMIC}, @@ -4270,6 +4270,8 @@ cleanup: (omp_mask (OMP_CLAUSE_AT) | OMP_CLAUSE_MESSAGE | OMP_CLAUSE_SEVERITY) #define OMP_WORKSHARE_CLAUSES \ omp_mask (OMP_CLAUSE_NOWAIT) +#define OMP_ALLOCATORS_CLAUSES \ + omp_mask (OMP_CLAUSE_ALLOCATE) static match @@ -4285,6 +4287,13 @@ match_omp (gfc_exec_op op, const omp_mask mask) } +match +gfc_match_omp_allocators (void) +{ + return match_omp (EXEC_OMP_ALLOCATORS, OMP_ALLOCATORS_CLAUSES); +} + + match gfc_match_omp_assume (void) { @@ -7382,6 +7391,23 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, "in an explicit privatization clause", n->sym->name, &n->where); } + if (code && code->op == EXEC_OMP_ALLOCATORS + && code->block->next && code->block->next->op == EXEC_ALLOCATE) + { + gfc_alloc *a; + for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n; n = n->next) + { + for (a = code->block->next->ext.alloc.list; a; a = a->next) + if (a->expr->expr_type == EXPR_VARIABLE + && a->expr->symtree->n.sym == n->sym) + break; + if (a == NULL) + gfc_error ("%qs specified in % clause at %L but not " + "in the associated ALLOCATE statement", + n->sym->name, &n->where); + } + } + } /* OpenACC reductions. */ @@ -9551,6 +9577,8 @@ omp_code_to_statement (gfc_code *code) return ST_OMP_DO; case EXEC_OMP_LOOP: return ST_OMP_LOOP; + case EXEC_OMP_ALLOCATORS: + return ST_OMP_ALLOCATORS; case EXEC_OMP_ASSUME: return ST_OMP_ASSUME; case EXEC_OMP_ATOMIC: @@ -10072,6 +10100,7 @@ gfc_resolve_omp_directive (gfc_code *code, gfc_namespace *ns) case EXEC_OMP_TEAMS_LOOP: resolve_omp_do (code); break; + case EXEC_OMP_ALLOCATORS: case EXEC_OMP_ASSUME: case EXEC_OMP_CANCEL: case EXEC_OMP_ERROR: diff --git a/gcc/fortran/parse.cc b/gcc/fortran/parse.cc index bc2b2188eea..2ab5ed0d6aa 100644 --- a/gcc/fortran/parse.cc +++ b/gcc/fortran/parse.cc @@ -885,6 +885,7 @@ decode_omp_directive (void) switch (c) { case 'a': + matcho ("allocators", gfc_match_omp_allocators, ST_OMP_ALLOCATORS); matcho ("assumes", gfc_match_omp_assumes, ST_OMP_ASSUMES); matchs ("assume", gfc_match_omp_assume, ST_OMP_ASSUME); matcho ("atomic", gfc_match_omp_atomic, ST_OMP_ATOMIC); @@ -915,6 +916,7 @@ decode_omp_directive (void) break; case 'e': matcho ("error", gfc_match_omp_error, ST_OMP_ERROR); + matcho ("end allocators", gfc_match_omp_eos_error, ST_OMP_END_ALLOCATORS); matchs ("end assume", gfc_match_omp_eos_error, ST_OMP_END_ASSUME); matcho ("end atomic", gfc_match_omp_eos_error, ST_OMP_END_ATOMIC); matcho ("end critical", gfc_match_omp_end_critical, ST_OMP_END_CRITICAL); @@ -1720,7 +1722,7 @@ next_statement (void) case ST_OMP_TARGET_SIMD: case ST_OMP_TASKLOOP: case ST_OMP_TASKLOOP_SIMD: \ case ST_OMP_LOOP: case ST_OMP_PARALLEL_LOOP: case ST_OMP_TEAMS_LOOP: \ case ST_OMP_TARGET_PARALLEL_LOOP: case ST_OMP_TARGET_TEAMS_LOOP: \ - case ST_OMP_ASSUME: \ + case ST_OMP_ALLOCATORS: case ST_OMP_ASSUME: \ case ST_CRITICAL: \ case ST_OACC_PARALLEL_LOOP: case ST_OACC_PARALLEL: case ST_OACC_KERNELS: \ case ST_OACC_DATA: case ST_OACC_HOST_DATA: case ST_OACC_LOOP: \ @@ -2359,6 +2361,9 @@ gfc_ascii_statement (gfc_statement st, bool strip_sentinel) case ST_OACC_END_ATOMIC: p = "!$ACC END ATOMIC"; break; + case ST_OMP_ALLOCATORS: + p = "!$OMP ALLOCATORS"; + break; case ST_OMP_ASSUME: p = "!$OMP ASSUME"; break; @@ -2413,6 +2418,9 @@ gfc_ascii_statement (gfc_statement st, bool strip_sentinel) case ST_OMP_DO_SIMD: p = "!$OMP DO SIMD"; break; + case ST_OMP_END_ALLOCATORS: + p = "!$OMP END ALLOCATORS"; + break; case ST_OMP_END_ASSUME: p = "!$OMP END ASSUME"; break; case ST_NONE: @@ -5525,6 +5532,41 @@ parse_oacc_loop (gfc_statement acc_st) return st; } +/* Parse an OpenMP allocate block, including optional ALLOCATORS + end directive. */ + +static gfc_statement +parse_openmp_allocate_block (gfc_statement omp_st) +{ + gfc_statement st; + gfc_code *cp, *np; + gfc_state_data s; + + accept_statement (omp_st); + + cp = gfc_state_stack->tail; + push_state (&s, COMP_OMP_STRUCTURED_BLOCK, NULL); + np = new_level (cp); + np->op = cp->op; + np->block = NULL; + + st = next_statement (); + if (st != ST_ALLOCATE) + { + gfc_error_now ("Unexpected %s at %C; expected ALLOCATE statement " + "after %s", gfc_ascii_statement (st), + gfc_ascii_statement (omp_st)); + } + accept_statement (st); + pop_state (); + st = next_statement (); + if (st == ST_OMP_END_ALLOCATORS) + { + accept_statement (st); + st = next_statement (); + } + return st; +} /* Parse the statements of an OpenMP structured block. */ @@ -5923,6 +5965,10 @@ parse_executable (gfc_statement st) parse_oacc_structured_block (st); break; + case ST_OMP_ALLOCATORS: + st = parse_openmp_allocate_block (st); + continue; + case ST_OMP_ASSUME: case ST_OMP_PARALLEL: case ST_OMP_PARALLEL_MASKED: diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc index 0f5f1d277e4..0cb4ff76853 100644 --- a/gcc/fortran/resolve.cc +++ b/gcc/fortran/resolve.cc @@ -10909,6 +10909,7 @@ gfc_resolve_blocks (gfc_code *b, gfc_namespace *ns) case EXEC_OACC_ENTER_DATA: case EXEC_OACC_EXIT_DATA: case EXEC_OACC_ROUTINE: + case EXEC_OMP_ALLOCATORS: case EXEC_OMP_ASSUME: case EXEC_OMP_CRITICAL: case EXEC_OMP_DISTRIBUTE: @@ -12384,6 +12385,7 @@ start: gfc_resolve_oacc_directive (code, ns); break; + case EXEC_OMP_ALLOCATORS: case EXEC_OMP_ASSUME: case EXEC_OMP_ATOMIC: case EXEC_OMP_BARRIER: diff --git a/gcc/fortran/st.cc b/gcc/fortran/st.cc index 8b4ca5ec2ea..ca852626432 100644 --- a/gcc/fortran/st.cc +++ b/gcc/fortran/st.cc @@ -214,6 +214,7 @@ gfc_free_statement (gfc_code *p) case EXEC_OACC_ENTER_DATA: case EXEC_OACC_EXIT_DATA: case EXEC_OACC_ROUTINE: + case EXEC_OMP_ALLOCATORS: case EXEC_OMP_ASSUME: case EXEC_OMP_ATOMIC: case EXEC_OMP_CANCEL: diff --git a/gcc/fortran/trans-openmp.cc b/gcc/fortran/trans-openmp.cc index 7a4a3390b6d..f4ff891a4be 100644 --- a/gcc/fortran/trans-openmp.cc +++ b/gcc/fortran/trans-openmp.cc @@ -7536,6 +7536,9 @@ gfc_trans_omp_directive (gfc_code *code) { switch (code->op) { + case EXEC_OMP_ALLOCATORS: + sorry ("% not yet supported"); + return NULL_TREE; case EXEC_OMP_ASSUME: return gfc_trans_omp_assume (code); case EXEC_OMP_ATOMIC: diff --git a/gcc/fortran/trans.cc b/gcc/fortran/trans.cc index 8a64882ea9e..34b2a976da5 100644 --- a/gcc/fortran/trans.cc +++ b/gcc/fortran/trans.cc @@ -2174,6 +2174,7 @@ trans_code (gfc_code * code, tree cond) res = gfc_trans_dt_end (code); break; + case EXEC_OMP_ALLOCATORS: case EXEC_OMP_ASSUME: case EXEC_OMP_ATOMIC: case EXEC_OMP_BARRIER: diff --git a/gcc/testsuite/gfortran.dg/gomp/allocators-1.f90 b/gcc/testsuite/gfortran.dg/gomp/allocators-1.f90 new file mode 100644 index 00000000000..b39f6d272c1 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/allocators-1.f90 @@ -0,0 +1,28 @@ +implicit none +integer, allocatable :: a, b +integer :: q +integer :: arr(2) + +!$omp allocators allocate(align(64): a) +block ! { dg-error "expected ALLOCATE statement after !.OMP ALLOCATORS" } +end block ! { dg-error "Expecting END PROGRAM statement" } + + +!$omp allocators allocate(align(64): a) + allocate(a, b) ! OK +!$omp end allocators + +!$omp allocators allocate(align(128): b) + allocate(a, b) ! OK (assuming not allocated) + + +!$omp allocators allocate(align(64): a) + allocate(a, b, stat=arr) ! { dg-error "Stat-variable at .1. must be a scalar INTEGER variable" } +!$omp end allocators + + +!$omp allocators allocate(align(64): a) + allocate(q) ! { dg-error "is neither a data pointer nor an allocatable variable" } +!$omp end allocators ! { dg-error "Unexpected !.OMP END ALLOCATORS" } + +end diff --git a/gcc/testsuite/gfortran.dg/gomp/allocators-2.f90 b/gcc/testsuite/gfortran.dg/gomp/allocators-2.f90 new file mode 100644 index 00000000000..5dabce0f10a --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/allocators-2.f90 @@ -0,0 +1,22 @@ +implicit none +integer, allocatable :: a, b +integer :: q +integer :: arr(2) + +!$omp allocators allocate(align(64): a) + allocate(a, b) ! OK +!$omp end allocators + +!$omp allocators allocate(align(128): b) + allocate(a, b) ! OK (assuming not allocated) + + +!$omp allocators allocate(align(62.0): a) ! { dg-error "a scalar positive constant integer alignment expression" } + allocate(a) + + +!$omp allocators allocate(align(64): a, b) ! { dg-error "'b' specified in 'allocate' clause at \\(1\\) but not in the associated ALLOCATE statement" } + allocate(a) +!$omp end allocators + +end