From patchwork Thu Oct 7 13:59:00 2021 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Chung-Lin Tang X-Patchwork-Id: 45960 Return-Path: X-Original-To: patchwork@sourceware.org Delivered-To: patchwork@sourceware.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id A32C8385840C for ; Thu, 7 Oct 2021 13:59:50 +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 5F45B3858419; Thu, 7 Oct 2021 13:59:19 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org 5F45B3858419 Authentication-Results: sourceware.org; dmarc=none (p=none dis=none) header.from=codesourcery.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=mentor.com IronPort-SDR: X3TkVk9b3UsDrlP5IFTew+hnnqryNf991Z8chsVUtGAEplfuicC0KHOfe3hIocwUc3BX0y5fH3 Jyuc7wketKCH8SyPtVrCOcRbuNBGINabZPfp+ub0rUQac0ST1Rckf9R89+KDP1umZRPwfMcHxO 3VO9hN0K1oqyW+t2fmr0dnx2r8LWUwHPNj9yG7+zI474POwOWOtTNjeBqab7WyCQhkHi1zqHsF 0BEDNG3dPma0Zq1EZ4Bw7VQwkyCnepYdONzo/Gtb8VOHUC4nW8Aag/SHZJNTBGH4NN9QYSTmwz g8308kNpaIc1uhvOf4PWjUa9 X-IronPort-AV: E=Sophos;i="5.85,354,1624348800"; d="scan'208";a="69342059" Received: from orw-gwy-02-in.mentorg.com ([192.94.38.167]) by esa1.mentor.iphmx.com with ESMTP; 07 Oct 2021 05:59:19 -0800 IronPort-SDR: aHKrQOAYhsBijZ7pTdO1werqA1Nn4fvMcpBUiX6LzD8w5Sgw49EvJPMznE5vNoEUbjqkMkGj0d W4VkNK5QVfXmAK6QUOkRkvGSsoBxX+FTYbK7ipw5QxruZIH3xs8phDmz+oJbeJOAPDnzwSjYHZ vL+Bfd+8Jt5aSx9LuscUQChuSor9KjE2EeHBadLn7/Bpw4tosjqs/dM6yP7Ghyt7cNFg3/tudD pt8IF5dSj77LwxqAaJdVC+TdQKo0V7UU0Yz+qcMhWibTmbMXRW5LlR44b4kCTpypQl7WM0XWFl WP8= From: Chung-Lin Tang Subject: [PATCH, OpenMP 5.1, Fortran] Strictly-structured block support for OpenMP directives To: gcc-patches , Fortran List , Tobias Burnus , Catherine Moore , Jakub Jelinek Message-ID: <8d20877d-d52e-d90c-8a4e-a38f43921df1@codesourcery.com> Date: Thu, 7 Oct 2021 21:59:00 +0800 User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.13; rv:78.0) Gecko/20100101 Thunderbird/78.14.0 MIME-Version: 1.0 Content-Language: en-US X-ClientProxiedBy: svr-orw-mbx-08.mgc.mentorg.com (147.34.90.208) To svr-orw-mbx-02.mgc.mentorg.com (147.34.90.202) X-Spam-Status: No, score=-10.4 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.4 X-Spam-Checker-Version: SpamAssassin 3.4.4 (2020-01-24) 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+patchwork=sourceware.org@gcc.gnu.org Sender: "Gcc-patches" Hi all, this patch add support for "strictly-structured blocks" introduced in OpenMP 5.1, basically allowing BLOCK constructs to serve as the body for directives: !$omp target block ... end block [!$omp end target] !! end directive is optional !$omp parallel block ... end block ... !$omp end parallel !! error, considered as not match to above parallel directive The parsing loop in parse_omp_structured_block() has been modified to allow a BLOCK construct after the first statement has been detected to be ST_BLOCK. This is done by a hard modification of the state into (the new) COMP_OMP_STRICTLY_STRUCTURED_BLOCK after the statement is known (I'm not sure if there's a way to 'peek' the next statement/token in the Fortran FE, open to suggestions on how to better write this) Tested with no regressions on trunk, is this okay to commit? Thanks, Chung-Lin 2021-10-07 Chung-Lin Tang gcc/fortran/ChangeLog: * decl.c (gfc_match_end): Add COMP_OMP_STRICTLY_STRUCTURED_BLOCK case together with COMP_BLOCK. * parse.c (parse_omp_structured_block): Adjust declaration, add 'bool strictly_structured_block' default true parameter, add handling for strictly-structured block case, adjust recursive calls to parse_omp_structured_block. (parse_executable): Adjust calls to parse_omp_structured_block. * parse.h (enum gfc_compile_state): Add COMP_OMP_STRICTLY_STRUCTURED_BLOCK. * trans-openmp.c (gfc_trans_omp_workshare): Add EXEC_BLOCK case handling. gcc/testsuite/ChangeLog: * gfortran.dg/gomp/strictly-structured-block-1.f90: New test. diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index b3c65b7175b..ff66d1f9475 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -8445,6 +8445,7 @@ gfc_match_end (gfc_statement *st) break; case COMP_BLOCK: + case COMP_OMP_STRICTLY_STRUCTURED_BLOCK: *st = ST_END_BLOCK; target = " block"; eos_ok = 0; diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c index 7d765a0866d..d78bf9b8fa5 100644 --- a/gcc/fortran/parse.c +++ b/gcc/fortran/parse.c @@ -5451,8 +5451,9 @@ parse_oacc_loop (gfc_statement acc_st) /* Parse the statements of an OpenMP structured block. */ -static void -parse_omp_structured_block (gfc_statement omp_st, bool workshare_stmts_only) +static gfc_statement +parse_omp_structured_block (gfc_statement omp_st, bool workshare_stmts_only, + bool strictly_structured_block = true) { gfc_statement st, omp_end_st; gfc_code *cp, *np; @@ -5538,6 +5539,32 @@ parse_omp_structured_block (gfc_statement omp_st, bool workshare_stmts_only) gcc_unreachable (); } + bool block_construct = false; + gfc_namespace* my_ns = NULL; + gfc_namespace* my_parent = NULL; + + st = next_statement (); + + if (strictly_structured_block && st == ST_BLOCK) + { + /* Adjust state to a strictly-structured block, now that we found that + the body starts with a BLOCK construct. */ + s.state = COMP_OMP_STRICTLY_STRUCTURED_BLOCK; + + block_construct = true; + gfc_notify_std (GFC_STD_F2008, "BLOCK construct at %C"); + + my_ns = gfc_build_block_ns (gfc_current_ns); + gfc_current_ns = my_ns; + my_parent = my_ns->parent; + + new_st.op = EXEC_BLOCK; + new_st.ext.block.ns = my_ns; + new_st.ext.block.assoc = NULL; + accept_statement (ST_BLOCK); + st = parse_spec (ST_NONE); + } + do { if (workshare_stmts_only) @@ -5554,7 +5581,6 @@ parse_omp_structured_block (gfc_statement omp_st, bool workshare_stmts_only) restrictions apply recursively. */ bool cycle = true; - st = next_statement (); for (;;) { switch (st) @@ -5576,17 +5602,20 @@ parse_omp_structured_block (gfc_statement omp_st, bool workshare_stmts_only) parse_forall_block (); break; + case ST_OMP_PARALLEL_SECTIONS: + st = parse_omp_structured_block (st, false, false); + continue; + case ST_OMP_PARALLEL: case ST_OMP_PARALLEL_MASKED: case ST_OMP_PARALLEL_MASTER: - case ST_OMP_PARALLEL_SECTIONS: - parse_omp_structured_block (st, false); - break; + st = parse_omp_structured_block (st, false); + continue; case ST_OMP_PARALLEL_WORKSHARE: case ST_OMP_CRITICAL: - parse_omp_structured_block (st, true); - break; + st = parse_omp_structured_block (st, true); + continue; case ST_OMP_PARALLEL_DO: case ST_OMP_PARALLEL_DO_SIMD: @@ -5609,7 +5638,7 @@ parse_omp_structured_block (gfc_statement omp_st, bool workshare_stmts_only) } } else - st = parse_executable (ST_NONE); + st = parse_executable (st); if (st == ST_NONE) unexpected_eof (); else if (st == ST_OMP_SECTION @@ -5619,9 +5648,27 @@ parse_omp_structured_block (gfc_statement omp_st, bool workshare_stmts_only) np = new_level (np); np->op = cp->op; np->block = NULL; + st = next_statement (); + } + else if (block_construct && st == ST_END_BLOCK) + { + accept_statement (st); + gfc_current_ns = my_parent; + pop_state (); + + st = next_statement (); + if (st == omp_end_st) + { + accept_statement (st); + st = next_statement (); + } + return st; } else if (st != omp_end_st) - unexpected_statement (st); + { + unexpected_statement (st); + st = next_statement (); + } } while (st != omp_end_st); @@ -5657,6 +5704,8 @@ parse_omp_structured_block (gfc_statement omp_st, bool workshare_stmts_only) gfc_commit_symbols (); gfc_warning_check (); pop_state (); + st = next_statement (); + return st; } @@ -5779,16 +5828,19 @@ parse_executable (gfc_statement st) parse_oacc_structured_block (st); break; + case ST_OMP_PARALLEL_SECTIONS: + case ST_OMP_SECTIONS: + st = parse_omp_structured_block (st, false, false); + continue; + case ST_OMP_PARALLEL: case ST_OMP_PARALLEL_MASKED: case ST_OMP_PARALLEL_MASTER: - case ST_OMP_PARALLEL_SECTIONS: case ST_OMP_ORDERED: case ST_OMP_CRITICAL: case ST_OMP_MASKED: case ST_OMP_MASTER: case ST_OMP_SCOPE: - case ST_OMP_SECTIONS: case ST_OMP_SINGLE: case ST_OMP_TARGET: case ST_OMP_TARGET_DATA: @@ -5797,13 +5849,13 @@ parse_executable (gfc_statement st) case ST_OMP_TEAMS: case ST_OMP_TASK: case ST_OMP_TASKGROUP: - parse_omp_structured_block (st, false); - break; + st = parse_omp_structured_block (st, false); + continue; case ST_OMP_WORKSHARE: case ST_OMP_PARALLEL_WORKSHARE: - parse_omp_structured_block (st, true); - break; + st = parse_omp_structured_block (st, true); + continue; case ST_OMP_DISTRIBUTE: case ST_OMP_DISTRIBUTE_PARALLEL_DO: diff --git a/gcc/fortran/parse.h b/gcc/fortran/parse.h index 55f02299304..66b275de89b 100644 --- a/gcc/fortran/parse.h +++ b/gcc/fortran/parse.h @@ -31,7 +31,7 @@ enum gfc_compile_state COMP_STRUCTURE, COMP_UNION, COMP_MAP, COMP_DO, COMP_SELECT, COMP_FORALL, COMP_WHERE, COMP_CONTAINS, COMP_ENUM, COMP_SELECT_TYPE, COMP_SELECT_RANK, COMP_OMP_STRUCTURED_BLOCK, COMP_CRITICAL, - COMP_DO_CONCURRENT + COMP_DO_CONCURRENT, COMP_OMP_STRICTLY_STRUCTURED_BLOCK }; /* Stack element for the current compilation state. These structures diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c index d234d1b070f..9fdea8c67fd 100644 --- a/gcc/fortran/trans-openmp.c +++ b/gcc/fortran/trans-openmp.c @@ -6993,7 +6993,11 @@ gfc_trans_omp_workshare (gfc_code *code, gfc_omp_clauses *clauses) res = gfc_trans_omp_directive (code); ompws_flags = saved_ompws_flags; break; - + + case EXEC_BLOCK: + res = gfc_trans_block_construct (code); + break; + default: gfc_internal_error ("gfc_trans_omp_workshare(): Bad statement code"); } diff --git a/gcc/testsuite/gfortran.dg/gomp/strictly-structured-block-1.f90 b/gcc/testsuite/gfortran.dg/gomp/strictly-structured-block-1.f90 new file mode 100644 index 00000000000..bc798c1c218 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/strictly-structured-block-1.f90 @@ -0,0 +1,295 @@ +! { dg-do compile } +! { dg-options "-fopenmp" } + +program main + integer :: x + + !$omp parallel + block + x = x + 1 + end block + + !$omp parallel + block + x = x + 1 + end block + !$omp end parallel + + !$omp parallel + block + x = x + 1 + end block + x = x + 1 + !$omp end parallel ! { dg-error "Unexpected !.OMP END PARALLEL statement" } + + !$omp teams + block + x = x + 1 + end block + + !$omp teams + block + x = x + 1 + end block + !$omp end teams + + !$omp teams + block + x = x + 1 + end block + x = x + 1 + !$omp end teams ! { dg-error "Unexpected !.OMP END TEAMS statement" } + + !$omp masked + block + x = x + 1 + end block + + !$omp masked + block + x = x + 1 + end block + !$omp end masked + + !$omp masked + block + x = x + 1 + end block + x = x + 1 + !$omp end masked ! { dg-error "Unexpected !.OMP END MASKED statement" } + + !$omp scope + block + x = x + 1 + end block + + !$omp scope + block + x = x + 1 + end block + !$omp end scope + + !$omp scope + block + x = x + 1 + end block + x = x + 1 + !$omp end scope ! { dg-error "Unexpected !.OMP END SCOPE statement" } + + !$omp single + block + x = x + 1 + end block + + !$omp single + block + x = x + 1 + end block + !$omp end single + + !$omp single + block + x = x + 1 + end block + x = x + 1 + !$omp end single ! { dg-error "Unexpected !.OMP END SINGLE statement" } + + !$omp workshare + block + x = x + 1 + end block + + !$omp workshare + block + x = x + 1 + end block + !$omp end workshare + + !$omp workshare + block + x = x + 1 + end block + x = x + 1 + !$omp end workshare ! { dg-error "Unexpected !.OMP END WORKSHARE statement" } + + !$omp task + block + x = x + 1 + end block + + !$omp task + block + x = x + 1 + end block + !$omp end task + + !$omp task + block + x = x + 1 + end block + x = x + 1 + !$omp end task ! { dg-error "Unexpected !.OMP END TASK statement" } + + !$omp target data map(x) + block + x = x + 1 + end block + + !$omp target data map(x) + block + x = x + 1 + end block + !$omp end target data + + !$omp target data map(x) + block + x = x + 1 + end block + x = x + 1 + !$omp end target data ! { dg-error "Unexpected !.OMP END TARGET DATA statement" } + + !$omp target + block + x = x + 1 + end block + + !$omp target + block + x = x + 1 + end block + !$omp end target + + !$omp target + block + x = x + 1 + end block + x = x + 1 + !$omp end target ! { dg-error "Unexpected !.OMP END TARGET statement" } + + !$omp parallel workshare + block + x = x + 1 + end block + + !$omp parallel workshare + block + x = x + 1 + end block + !$omp end parallel workshare + + !$omp parallel workshare + block + x = x + 1 + end block + x = x + 1 + !$omp end parallel workshare ! { dg-error "Unexpected !.OMP END PARALLEL WORKSHARE statement" } + + !$omp parallel masked + block + x = x + 1 + end block + + !$omp parallel masked + block + x = x + 1 + end block + !$omp end parallel masked + + !$omp parallel masked + block + x = x + 1 + end block + x = x + 1 + !$omp end parallel masked ! { dg-error "Unexpected !.OMP END PARALLEL MASKED statement" } + + !$omp target parallel + block + x = x + 1 + end block + + !$omp target parallel + block + x = x + 1 + end block + !$omp end target parallel + + !$omp target parallel + block + x = x + 1 + end block + x = x + 1 + !$omp end target parallel ! { dg-error "Unexpected !.OMP END TARGET PARALLEL statement" } + + !$omp target teams + block + x = x + 1 + end block + + !$omp target teams + block + x = x + 1 + end block + !$omp end target teams + + !$omp target teams + block + x = x + 1 + end block + x = x + 1 + !$omp end target teams ! { dg-error "Unexpected !.OMP END TARGET TEAMS statement" } + + !$omp critical + block + x = x + 1 + end block + + !$omp critical + block + x = x + 1 + end block + !$omp end critical + + !$omp critical + block + x = x + 1 + end block + x = x + 1 + !$omp end critical ! { dg-error "Unexpected !.OMP END CRITICAL statement" } + + !$omp taskgroup + block + x = x + 1 + end block + + !$omp taskgroup + block + x = x + 1 + end block + !$omp end taskgroup + + !$omp taskgroup + block + x = x + 1 + end block + x = x + 1 + !$omp end taskgroup ! { dg-error "Unexpected !.OMP END TASKGROUP statement" } + + !$omp ordered + block + x = x + 1 + end block + + !$omp ordered + block + x = x + 1 + end block + !$omp end ordered + + !$omp ordered + block + x = x + 1 + end block + x = x + 1 + !$omp end ordered ! { dg-error "Unexpected !.OMP END ORDERED statement" } + +end program