From patchwork Thu Nov 11 15:04:04 2021 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Tobias Burnus X-Patchwork-Id: 47480 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 1590B385BC23 for ; Thu, 11 Nov 2021 15:04:41 +0000 (GMT) X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from esa2.mentor.iphmx.com (esa2.mentor.iphmx.com [68.232.141.98]) by sourceware.org (Postfix) with ESMTPS id 278DA385840A; Thu, 11 Nov 2021 15:04:14 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org 278DA385840A 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: RkMwkjc+qqrsS/1a/SWxCk9qwPpOLAl9bYdgnFj/34jSaa7ZVbxwQvX7Y/iiCCor5HQyxveUHR nygHUs394w5MHnxHv4jkA4wMczLfXIJ+yAxJMXAwLBWUULP/vFhcefrWSSfIeo2bNHGiw/tF/s g4r8/OVjTHqyfqWNEzC0vyVvR/zeB0uUW1sACEe8fbGGV3GgjzQw2TPO4lKM+0eSwHZFlzTVLA vlAqGfpQg4fZlF2hzpIcDeN9MQ7xfj5WE3oEV664M31mP4KM4eEpDyN33Ye8JHs+n764Eih9EV SvFtRt8QxlOMiaideo9xyfcJ X-IronPort-AV: E=Sophos;i="5.87,226,1631606400"; d="diff'?scan'208";a="68368503" Received: from orw-gwy-02-in.mentorg.com ([192.94.38.167]) by esa2.mentor.iphmx.com with ESMTP; 11 Nov 2021 07:04:12 -0800 IronPort-SDR: LA/gSdLSJUZRv2Mllroyec2bOkXu04iDCicTJL+86I67JbF9iYnt6gwHkXPS++auwWr0zwE8Hs 9n6AXpJzohJl4MjznUy7b7S+CFKMZHTwUuGHMsgq55HNzGcFlA5xPXmI67UQebH0VtdIsI9PRX B2ZIZVcr9Uw7kkS5UmNmIWHG6rbww3trFoFP6W/cvHNiaJAT7FIlkwykTKRUtT3i2S8jMdsQH8 8sZm1zqOWtqhG/U+gRPLxKGQpKLUPYwtdutywbRdpBY5xBCH9p3gnZ/dLOJcOmOx44dubVstrO jRE= Message-ID: <597484f4-e8a3-07f4-d259-176387503c39@codesourcery.com> Date: Thu, 11 Nov 2021 16:04:04 +0100 MIME-Version: 1.0 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:91.0) Gecko/20100101 Thunderbird/91.3.0 Content-Language: en-US To: gcc-patches , Jakub Jelinek , fortran From: Tobias Burnus Subject: [Patch] Fortran/openmp: Add support for 2 argument num_teams clause X-Originating-IP: [137.202.0.90] X-ClientProxiedBy: svr-ies-mbx-02.mgc.mentorg.com (139.181.222.2) To svr-ies-mbx-01.mgc.mentorg.com (139.181.222.1) X-Spam-Status: No, score=-11.6 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" Just the Fortran FE work + Fortranized version for the C tests. 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 support for 2 argument num_teams clause Fortran part to commit r12-5146-g48d7327f2aaf65 gcc/fortran/ChangeLog: * gfortran.h (struct gfc_omp_clauses): Rename num_teams to num_teams_upper, add num_teams_upper. * dump-parse-tree.c (show_omp_clauses): Update to handle lower-bound num_teams clause. * frontend-passes.c (gfc_code_walker): Likewise * openmp.c (gfc_free_omp_clauses, gfc_match_omp_clauses, resolve_omp_clauses): Likewise. * trans-openmp.c (gfc_trans_omp_clauses, gfc_split_omp_clauses, gfc_trans_omp_target): Likewise. libgomp/ChangeLog: * testsuite/libgomp.fortran/teams-1.f90: New test. gcc/testsuite/ChangeLog: * gfortran.dg/gomp/num-teams-1.f90: New test. * gfortran.dg/gomp/num-teams-2.f90: New test. gcc/fortran/dump-parse-tree.c | 9 ++++- gcc/fortran/frontend-passes.c | 3 +- gcc/fortran/gfortran.h | 3 +- gcc/fortran/openmp.c | 32 +++++++++++++--- gcc/fortran/trans-openmp.c | 35 ++++++++++++----- gcc/testsuite/gfortran.dg/gomp/num-teams-1.f90 | 53 ++++++++++++++++++++++++++ gcc/testsuite/gfortran.dg/gomp/num-teams-2.f90 | 37 ++++++++++++++++++ libgomp/testsuite/libgomp.fortran/teams-1.f90 | 22 +++++++++++ 8 files changed, 175 insertions(+), 19 deletions(-) diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c index 14a307856fc..04660d5074a 100644 --- a/gcc/fortran/dump-parse-tree.c +++ b/gcc/fortran/dump-parse-tree.c @@ -1741,10 +1741,15 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses) } fprintf (dumpfile, " BIND(%s)", type); } - if (omp_clauses->num_teams) + if (omp_clauses->num_teams_upper) { fputs (" NUM_TEAMS(", dumpfile); - show_expr (omp_clauses->num_teams); + if (omp_clauses->num_teams_lower) + { + show_expr (omp_clauses->num_teams_lower); + fputc (':', dumpfile); + } + show_expr (omp_clauses->num_teams_upper); fputc (')', dumpfile); } if (omp_clauses->device) diff --git a/gcc/fortran/frontend-passes.c b/gcc/fortran/frontend-passes.c index 145bff50f3e..f5ba7cecd54 100644 --- a/gcc/fortran/frontend-passes.c +++ b/gcc/fortran/frontend-passes.c @@ -5634,7 +5634,8 @@ gfc_code_walker (gfc_code **c, walk_code_fn_t codefn, walk_expr_fn_t exprfn, WALK_SUBEXPR (co->ext.omp_clauses->chunk_size); WALK_SUBEXPR (co->ext.omp_clauses->safelen_expr); WALK_SUBEXPR (co->ext.omp_clauses->simdlen_expr); - WALK_SUBEXPR (co->ext.omp_clauses->num_teams); + WALK_SUBEXPR (co->ext.omp_clauses->num_teams_lower); + WALK_SUBEXPR (co->ext.omp_clauses->num_teams_upper); WALK_SUBEXPR (co->ext.omp_clauses->device); WALK_SUBEXPR (co->ext.omp_clauses->thread_limit); WALK_SUBEXPR (co->ext.omp_clauses->dist_chunk_size); diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 9378b4b8a24..1ad2f0df702 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -1502,7 +1502,8 @@ typedef struct gfc_omp_clauses struct gfc_expr *chunk_size; struct gfc_expr *safelen_expr; struct gfc_expr *simdlen_expr; - struct gfc_expr *num_teams; + struct gfc_expr *num_teams_lower; + struct gfc_expr *num_teams_upper; struct gfc_expr *device; struct gfc_expr *thread_limit; struct gfc_expr *grainsize; diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c index dcf22ac2c2f..7b2df0d0be3 100644 --- a/gcc/fortran/openmp.c +++ b/gcc/fortran/openmp.c @@ -85,7 +85,8 @@ gfc_free_omp_clauses (gfc_omp_clauses *c) gfc_free_expr (c->chunk_size); gfc_free_expr (c->safelen_expr); gfc_free_expr (c->simdlen_expr); - gfc_free_expr (c->num_teams); + gfc_free_expr (c->num_teams_lower); + gfc_free_expr (c->num_teams_upper); gfc_free_expr (c->device); gfc_free_expr (c->thread_limit); gfc_free_expr (c->dist_chunk_size); @@ -2420,11 +2421,22 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, continue; } if ((mask & OMP_CLAUSE_NUM_TEAMS) - && (m = gfc_match_dupl_check (!c->num_teams, "num_teams", true, - &c->num_teams)) != MATCH_NO) + && (m = gfc_match_dupl_check (!c->num_teams_upper, "num_teams", + true)) != MATCH_NO) { if (m == MATCH_ERROR) goto error; + if (gfc_match ("%e ", &c->num_teams_upper) != MATCH_YES) + goto error; + if (gfc_peek_ascii_char () == ':') + { + c->num_teams_lower = c->num_teams_upper; + c->num_teams_upper = NULL; + if (gfc_match (": %e ", &c->num_teams_upper) != MATCH_YES) + goto error; + } + if (gfc_match (") ") != MATCH_YES) + goto error; continue; } if ((mask & OMP_CLAUSE_NUM_THREADS) @@ -7293,8 +7305,18 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, resolve_positive_int_expr (omp_clauses->safelen_expr, "SAFELEN"); if (omp_clauses->simdlen_expr) resolve_positive_int_expr (omp_clauses->simdlen_expr, "SIMDLEN"); - if (omp_clauses->num_teams) - resolve_positive_int_expr (omp_clauses->num_teams, "NUM_TEAMS"); + if (omp_clauses->num_teams_lower) + resolve_positive_int_expr (omp_clauses->num_teams_lower, "NUM_TEAMS"); + if (omp_clauses->num_teams_upper) + resolve_positive_int_expr (omp_clauses->num_teams_upper, "NUM_TEAMS"); + if (omp_clauses->num_teams_lower + && omp_clauses->num_teams_lower->expr_type == EXPR_CONSTANT + && omp_clauses->num_teams_upper->expr_type == EXPR_CONSTANT + && mpz_cmp (omp_clauses->num_teams_lower->value.integer, + omp_clauses->num_teams_upper->value.integer) > 0) + gfc_warning (0, "NUM_TEAMS lower bound at %L larger than upper bound at %L", + &omp_clauses->num_teams_lower->where, + &omp_clauses->num_teams_upper->where); if (omp_clauses->device) resolve_nonnegative_int_expr (omp_clauses->device, "DEVICE"); if (omp_clauses->filter) diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c index 22d66629c07..6bc7e9a6017 100644 --- a/gcc/fortran/trans-openmp.c +++ b/gcc/fortran/trans-openmp.c @@ -3927,18 +3927,27 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, } } - if (clauses->num_teams) + if (clauses->num_teams_upper) { - tree num_teams; + tree num_teams_lower = NULL_TREE, num_teams_upper; gfc_init_se (&se, NULL); - gfc_conv_expr (&se, clauses->num_teams); + gfc_conv_expr (&se, clauses->num_teams_upper); gfc_add_block_to_block (block, &se.pre); - num_teams = gfc_evaluate_now (se.expr, block); + num_teams_upper = gfc_evaluate_now (se.expr, block); gfc_add_block_to_block (block, &se.post); + if (clauses->num_teams_lower) + { + gfc_init_se (&se, NULL); + gfc_conv_expr (&se, clauses->num_teams_lower); + gfc_add_block_to_block (block, &se.pre); + num_teams_lower = gfc_evaluate_now (se.expr, block); + gfc_add_block_to_block (block, &se.post); + } c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_NUM_TEAMS); - OMP_CLAUSE_NUM_TEAMS_UPPER_EXPR (c) = num_teams; + OMP_CLAUSE_NUM_TEAMS_LOWER_EXPR (c) = num_teams_lower; + OMP_CLAUSE_NUM_TEAMS_UPPER_EXPR (c) = num_teams_upper; omp_clauses = gfc_trans_add_clause (c, omp_clauses); } @@ -5873,8 +5882,10 @@ gfc_split_omp_clauses (gfc_code *code, if (mask & GFC_OMP_MASK_TEAMS) { /* First the clauses that are unique to some constructs. */ - clausesa[GFC_OMP_SPLIT_TEAMS].num_teams - = code->ext.omp_clauses->num_teams; + clausesa[GFC_OMP_SPLIT_TEAMS].num_teams_lower + = code->ext.omp_clauses->num_teams_lower; + clausesa[GFC_OMP_SPLIT_TEAMS].num_teams_upper + = code->ext.omp_clauses->num_teams_upper; clausesa[GFC_OMP_SPLIT_TEAMS].thread_limit = code->ext.omp_clauses->thread_limit; /* Shared and default clauses are allowed on parallel, teams @@ -6649,7 +6660,7 @@ gfc_trans_omp_target (gfc_code *code) break; default: if (flag_openmp - && (clausesa[GFC_OMP_SPLIT_TEAMS].num_teams + && (clausesa[GFC_OMP_SPLIT_TEAMS].num_teams_upper || clausesa[GFC_OMP_SPLIT_TEAMS].thread_limit)) { gfc_omp_clauses clausesb; @@ -6658,9 +6669,13 @@ gfc_trans_omp_target (gfc_code *code) thread_limit clauses are evaluated before entering the target construct. */ memset (&clausesb, '\0', sizeof (clausesb)); - clausesb.num_teams = clausesa[GFC_OMP_SPLIT_TEAMS].num_teams; + clausesb.num_teams_lower + = clausesa[GFC_OMP_SPLIT_TEAMS].num_teams_lower; + clausesb.num_teams_upper + = clausesa[GFC_OMP_SPLIT_TEAMS].num_teams_upper; clausesb.thread_limit = clausesa[GFC_OMP_SPLIT_TEAMS].thread_limit; - clausesa[GFC_OMP_SPLIT_TEAMS].num_teams = NULL; + clausesa[GFC_OMP_SPLIT_TEAMS].num_teams_lower = NULL; + clausesa[GFC_OMP_SPLIT_TEAMS].num_teams_upper = NULL; clausesa[GFC_OMP_SPLIT_TEAMS].thread_limit = NULL; teams_clauses = gfc_trans_omp_clauses (&block, &clausesb, code->loc); diff --git a/gcc/testsuite/gfortran.dg/gomp/num-teams-1.f90 b/gcc/testsuite/gfortran.dg/gomp/num-teams-1.f90 new file mode 100644 index 00000000000..df31cc7884b --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/num-teams-1.f90 @@ -0,0 +1,53 @@ +module m + implicit none (type, external) + + interface + integer function fn(i); integer :: i; end + end interface + +contains + +subroutine foo + !$omp teams num_teams (4 : 6) + !$omp end teams + + !$omp teams num_teams (7) + !$omp end teams +end + +subroutine bar + !$omp target teams num_teams (5 : 19) + !$omp end target teams + + !$omp target teams num_teams (21) + !$omp end target teams +end + +subroutine baz + !$omp teams num_teams (fn (1) : fn (2)) + !$omp end teams + + !$omp teams num_teams (fn (3)) + !$omp end teams +end + +subroutine qux + !$omp target teams num_teams (fn (4) : fn (5)) + !$omp end target teams + + !$omp target teams num_teams (fn (6)) + !$omp end target teams +end + +subroutine corge + !$omp target + !$omp teams num_teams (fn (7) : fn (8)) + !$omp end teams + !$omp end target + + !$omp target + !$omp teams num_teams (fn (9)) + !$omp end teams + !$omp end target +end +end module m diff --git a/gcc/testsuite/gfortran.dg/gomp/num-teams-2.f90 b/gcc/testsuite/gfortran.dg/gomp/num-teams-2.f90 new file mode 100644 index 00000000000..e7814a11a5a --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/num-teams-2.f90 @@ -0,0 +1,37 @@ +module m + implicit none (type, external) + +contains + +subroutine foo (i) + integer :: i + + !$omp teams num_teams (6 : 4) ! { dg-warning "NUM_TEAMS lower bound at .1. larger than upper bound at .2." } + !$omp end teams + + !$omp teams num_teams (-7) ! { dg-warning "INTEGER expression of NUM_TEAMS clause at .1. must be positive" } + !$omp end teams + + !$omp teams num_teams (i : -7) ! { dg-warning "INTEGER expression of NUM_TEAMS clause at .1. must be positive" } + !$omp end teams + + !$omp teams num_teams (-7 : 8) ! { dg-warning "INTEGER expression of NUM_TEAMS clause at .1. must be positive" } + !$omp end teams +end + +subroutine bar (i) + integer :: i + + !$omp target teams num_teams (6 : 4) ! { dg-warning "NUM_TEAMS lower bound at .1. larger than upper bound at .2." } + !$omp end target teams + + !$omp target teams num_teams (-7) ! { dg-warning "INTEGER expression of NUM_TEAMS clause at .1. must be positive" } + !$omp end target teams + + !$omp target teams num_teams (i : -7) ! { dg-warning "INTEGER expression of NUM_TEAMS clause at .1. must be positive" } + !$omp end target teams + + !$omp target teams num_teams (-7 : 8) ! { dg-warning "INTEGER expression of NUM_TEAMS clause at .1. must be positive" } + !$omp end target teams +end +end module diff --git a/libgomp/testsuite/libgomp.fortran/teams-1.f90 b/libgomp/testsuite/libgomp.fortran/teams-1.f90 new file mode 100644 index 00000000000..9969fe48884 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/teams-1.f90 @@ -0,0 +1,22 @@ +program main + use omp_lib + implicit none (type, external) + integer :: i + + !$omp teams num_teams (5) + if (omp_get_num_teams () /= 5) stop 1 + !$omp distribute dist_schedule(static,1) + do i = 0, 4 + if (omp_get_team_num () /= i) stop 2 + end do + !$omp end teams + + !$omp teams num_teams (7 : 9) + if (omp_get_num_teams () < 7 .or. omp_get_num_teams () > 9) & + stop 3 + !$omp distribute dist_schedule(static,1) + do i = 0, omp_get_num_teams () - 1 + if (omp_get_team_num () /= i) stop 4 + end do + !$omp end teams +end program main