From patchwork Wed Jun 14 22:08:03 2023 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Sandra Loosemore X-Patchwork-Id: 71125 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 00460383905D for ; Wed, 14 Jun 2023 22:09:41 +0000 (GMT) X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from esa3.mentor.iphmx.com (esa3.mentor.iphmx.com [68.232.137.180]) by sourceware.org (Postfix) with ESMTPS id DF26B3856961 for ; Wed, 14 Jun 2023 22:09:18 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org DF26B3856961 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="6.00,243,1681200000"; d="scan'208";a="8811628" Received: from orw-gwy-01-in.mentorg.com ([192.94.38.165]) by esa3.mentor.iphmx.com with ESMTP; 14 Jun 2023 14:09:12 -0800 IronPort-SDR: PrvrLXDxDHf6dlculjtnfN1UVNStMadAy3JY4QOLBieCKOyL3Hki5Pu6l4YGpGDKhS+PBinwC8 VRihLYhAbp6PKpLUBnhDd7UKYQ83azH7Bl8kNau51Wix9cQMnEyQMLEJWqNYdpnYFCGC/RrHgR O2eb36SOUj8hLH5rnoXllQSLGWs05M9mWYJOCeoC6oUC9vPGCp2VjVWrCOQ4F1sk5LuYTZgTb3 ND+Jwp19a8OWzqcn/gquDImFYdSWpg+lE4FxBEf/WPJC28CU85UFDAWd2ZTXRhqdT/29BgOyx1 gHs= From: Sandra Loosemore To: Subject: [OG13 5/6] OpenMP: Refactor and tidy Fortran front-end code for loop transformations Date: Wed, 14 Jun 2023 16:08:03 -0600 Message-ID: <20230614220804.917436-6-sandra@codesourcery.com> X-Mailer: git-send-email 2.34.1 In-Reply-To: <20230614220804.917436-1-sandra@codesourcery.com> References: <20230614220804.917436-1-sandra@codesourcery.com> MIME-Version: 1.0 X-ClientProxiedBy: svr-orw-mbx-14.mgc.mentorg.com (147.34.90.214) To svr-orw-mbx-13.mgc.mentorg.com (147.34.90.213) X-Spam-Status: No, score=-9.9 required=5.0 tests=BAYES_00, GIT_PATCH_0, HEADER_FROM_DIFFERENT_DOMAINS, KAM_DMARC_STATUS, SPF_HELO_PASS, SPF_PASS, TXREP, T_SCC_BODY_TEXT_LINE autolearn=ham autolearn_force=no version=3.4.6 X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on server2.sourceware.org X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.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" This patch rearranges some code previously added to support loop transformations to simplify merging support for imperfectly-nested loops in a subsequent patch. There is no new functionality added here. gcc/fortran/ChangeLog * openmp.cc (find_nested_loop_in_chain): Move up in file. (find_nested_loop_in_block): Likewise. (resolve_nested_loops): New helper function to consolidate code from... (resolve_omp_do, resolve_omp_tile): ...these functions. Also, remove the redundant call to resolve_nested_loop_transforms, and use uniform error message wording. gcc/testsuite/ChangeLog * gfortran.dg/gomp/collapse1.f90: Adjust expected error message. * gfortran.dg/gomp/collapse2.f90: Likewise. * gfortran.dg/gomp/loop-transforms/tile-2.f90: Likewise. --- gcc/fortran/ChangeLog.omp | 10 + gcc/fortran/openmp.cc | 447 +++++++----------- gcc/testsuite/ChangeLog.omp | 6 + gcc/testsuite/gfortran.dg/gomp/collapse1.f90 | 2 +- gcc/testsuite/gfortran.dg/gomp/collapse2.f90 | 4 +- .../gomp/loop-transforms/tile-2.f90 | 2 +- 6 files changed, 204 insertions(+), 267 deletions(-) diff --git a/gcc/fortran/ChangeLog.omp b/gcc/fortran/ChangeLog.omp index 3791eddc6c5..04ed7f88175 100644 --- a/gcc/fortran/ChangeLog.omp +++ b/gcc/fortran/ChangeLog.omp @@ -1,3 +1,13 @@ +2023-06-13 Sandra Loosemore + + * openmp.cc (find_nested_loop_in_chain): Move up in file. + (find_nested_loop_in_block): Likewise. + (resolve_nested_loops): New helper function to consolidate code + from... + (resolve_omp_do, resolve_omp_tile): ...these functions. Also, + remove the redundant call to resolve_nested_loop_transforms, and + use uniform error message wording. + 2023-06-12 Tobias Burnus * trans-openmp.cc (gfc_omp_deep_map_kind_p): Fix conditions for diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc index ca9a8e665d1..5ab64b5231f 100644 --- a/gcc/fortran/openmp.cc +++ b/gcc/fortran/openmp.cc @@ -10045,6 +10045,52 @@ static struct fortran_omp_context static gfc_code *omp_current_do_code; static int omp_current_do_collapse; +/* Forward declaration for mutually recursive functions. */ +static gfc_code * +find_nested_loop_in_block (gfc_code *block); + +/* Return the first nested DO loop in CHAIN, or NULL if there + isn't one. Does no error checking on intervening code. */ + +static gfc_code * +find_nested_loop_in_chain (gfc_code *chain) +{ + gfc_code *code; + + if (!chain) + return NULL; + + for (code = chain; code; code = code->next) + { + if (code->op == EXEC_DO) + return code; + else if (loop_transform_p (code->op) && code->block) + { + code = code->block; + continue; + } + else if (code->op == EXEC_BLOCK) + { + gfc_code *c = find_nested_loop_in_block (code); + if (c) + return c; + } + } + return NULL; +} + +/* Return the first nested DO loop in BLOCK, or NULL if there + isn't one. Does no error checking on intervening code. */ +static gfc_code * +find_nested_loop_in_block (gfc_code *block) +{ + gfc_namespace *ns; + gcc_assert (block->op == EXEC_BLOCK); + ns = block->ext.block.ns; + gcc_assert (ns); + return find_nested_loop_in_chain (ns->code); +} + void gfc_resolve_omp_do_blocks (gfc_code *code, gfc_namespace *ns) { @@ -10282,51 +10328,6 @@ gfc_resolve_omp_local_vars (gfc_namespace *ns) } -/* Forward declaration for mutually recursive functions. */ -static gfc_code * -find_nested_loop_in_block (gfc_code *block); - -/* Return the first nested DO loop in CHAIN, or NULL if there - isn't one. Does no error checking on intervening code. */ - -static gfc_code * -find_nested_loop_in_chain (gfc_code *chain) -{ - gfc_code *code; - - if (!chain) - return NULL; - - for (code = chain; code; code = code->next) - { - if (code->op == EXEC_DO) - return code; - else if (loop_transform_p (code->op) && code->block) - { - code = code->block; - continue; - } - else if (code->op == EXEC_BLOCK) - { - gfc_code *c = find_nested_loop_in_block (code); - if (c) - return c; - } - } - return NULL; -} - -/* Return the first nested DO loop in BLOCK, or NULL if there - isn't one. Does no error checking on intervening code. */ -static gfc_code * -find_nested_loop_in_block (gfc_code *block) -{ - gfc_namespace *ns; - gcc_assert (block->op == EXEC_BLOCK); - ns = block->ext.block.ns; - gcc_assert (ns); - return find_nested_loop_in_chain (ns->code); -} /* CODE is an OMP loop construct. Return true if VAR matches an iteration variable outer to level DEPTH. */ static bool @@ -10547,13 +10548,140 @@ resolve_omp_unroll (gfc_code *code) descr, loc); } +/* Shared helper function for resolve_omp_do and resolve_omp_tile: + check that we have NUM_LOOPS nested loops at DO_CODE. CODE and NAME + are for the outer OMP construct, used for error checking. */ + +static void +resolve_nested_loops (gfc_code *code, const char *name, gfc_code *do_code, + int num_loops, bool is_simd, bool is_tile) +{ + for (int i = 1; i <= num_loops; i++) + { + gfc_symbol *dovar; + gfc_symbol *start_var = NULL, *end_var = NULL; + gfc_code *c; + + if (do_code->op == EXEC_DO_WHILE) + { + gfc_error ("%s cannot be a DO WHILE or DO without loop control " + "at %L", name, &do_code->loc); + break; + } + if (do_code->op == EXEC_DO_CONCURRENT) + { + gfc_error ("%s cannot be a DO CONCURRENT loop at %L", name, + &do_code->loc); + break; + } + if (do_code->op != EXEC_DO) + { + gfc_error ("%s must be DO loop at %L", name, + &do_code->loc); + break; + } + dovar = do_code->ext.iterator->var->symtree->n.sym; + if (!is_tile) + { + int list; + gfc_omp_namelist *n; + + if (do_code->ext.iterator->var->ts.type != BT_INTEGER) + gfc_error ("%s iteration variable must be of type integer at %L", + name, &do_code->loc); + if (dovar->attr.threadprivate) + gfc_error ("%s iteration variable must not be THREADPRIVATE " + "at %L", name, &do_code->loc); + if (code->ext.omp_clauses) + for (list = 0; list < OMP_LIST_NUM; list++) + if (!is_simd || code->ext.omp_clauses->collapse > 1 + ? (list != OMP_LIST_PRIVATE && list != OMP_LIST_LASTPRIVATE + && list != OMP_LIST_ALLOCATE) + : (list != OMP_LIST_PRIVATE && list != OMP_LIST_LASTPRIVATE + && list != OMP_LIST_ALLOCATE && list != OMP_LIST_LINEAR)) + for (n = code->ext.omp_clauses->lists[list]; n; n = n->next) + if (dovar == n->sym) + { + if (!is_simd || code->ext.omp_clauses->collapse > 1) + gfc_error ("%s iteration variable present on clause " + "other than PRIVATE, LASTPRIVATE or " + "ALLOCATE at %L", name, &do_code->loc); + else + gfc_error ("%s iteration variable present on clause " + "other than PRIVATE, LASTPRIVATE, " + "ALLOCATE or LINEAR at %L", + name, &do_code->loc); + break; + } + } + if (is_outer_iteration_variable (code, i, dovar)) + { + gfc_error ("%s iteration variable used in more than one loop at %L " + "(depth %d)", + name, &do_code->loc, i); + break; + } + else if (!bound_expr_is_canonical (code, i, + do_code->ext.iterator->start, + &start_var)) + { + gfc_error ("%s loop start expression not in canonical form at %L", + name, &do_code->loc); + break; + } + else if (!bound_expr_is_canonical (code, i, + do_code->ext.iterator->end, + &end_var)) + { + gfc_error ("%s loop end expression not in canonical form at %L", + name, &do_code->loc); + break; + } + else if (start_var && end_var && start_var != end_var) + { + gfc_error ("%s loop bounds reference different " + "iteration variables at %L", name, &do_code->loc); + break; + } + else if (!expr_is_invariant (code, i, do_code->ext.iterator->step)) + { + gfc_error ("%s loop increment not in canonical form at %L", + name, &do_code->loc); + break; + } + if (start_var || end_var) + code->ext.omp_clauses->non_rectangular = 1; + + for (c = do_code->next; c; c = c->next) + if (c->op != EXEC_NOP && c->op != EXEC_CONTINUE) + { + gfc_error ("%s loops not perfectly nested at %L", + name, &c->loc); + break; + } + if (i == num_loops || c) + break; + do_code = do_code->block->next; + + if (do_code) + do_code = resolve_nested_loop_transforms (do_code, name, + num_loops - i, + &code->loc); + if (!do_code + || (do_code->op != EXEC_DO && do_code->op != EXEC_DO_WHILE)) + { + gfc_error ("not enough DO loops for %s at %L", + name, &code->loc); + break; + } + } +} + static void resolve_omp_do (gfc_code *code) { - gfc_code *do_code, *c; - int list, i, collapse; - gfc_omp_namelist *n; - gfc_symbol *dovar; + gfc_code *do_code; + int collapse; const char *name; bool is_simd = false; @@ -10667,238 +10795,31 @@ resolve_omp_do (gfc_code *code) collapse = 1; } + do_code = resolve_nested_loop_transforms (code->block->next, name, collapse, + &code->loc); + /* While the spec defines the loop nest depth independently of the COLLAPSE clause, in practice the middle end only pays attention to the COLLAPSE depth and treats any further inner loops as the final-loop-body. So here we also check canonical loop nest form only for the number of outer loops specified by the COLLAPSE clause too. */ - do_code = resolve_nested_loop_transforms (code->block->next, name, collapse, - &code->loc); - - for (i = 1; i <= collapse; i++) - { - gfc_symbol *start_var = NULL, *end_var = NULL; - if (do_code->op == EXEC_DO_WHILE) - { - gfc_error ("%s cannot be a DO WHILE or DO without loop control " - "at %L", name, &do_code->loc); - break; - } - if (do_code->op == EXEC_DO_CONCURRENT) - { - gfc_error ("%s cannot be a DO CONCURRENT loop at %L", name, - &do_code->loc); - break; - } - if (do_code->op != EXEC_DO) - { - gfc_error ("%s must be DO loop at %L", name, - &do_code->loc); - break; - } - - gcc_assert (do_code->op != EXEC_OMP_UNROLL); - gcc_assert (do_code->op == EXEC_DO); - if (do_code->ext.iterator->var->ts.type != BT_INTEGER) - gfc_error ("%s iteration variable must be of type integer at %L", - name, &do_code->loc); - dovar = do_code->ext.iterator->var->symtree->n.sym; - if (dovar->attr.threadprivate) - gfc_error ("%s iteration variable must not be THREADPRIVATE " - "at %L", name, &do_code->loc); - if (code->ext.omp_clauses) - for (list = 0; list < OMP_LIST_NUM; list++) - if (!is_simd || code->ext.omp_clauses->collapse > 1 - ? (list != OMP_LIST_PRIVATE && list != OMP_LIST_LASTPRIVATE - && list != OMP_LIST_ALLOCATE) - : (list != OMP_LIST_PRIVATE && list != OMP_LIST_LASTPRIVATE - && list != OMP_LIST_ALLOCATE && list != OMP_LIST_LINEAR)) - for (n = code->ext.omp_clauses->lists[list]; n; n = n->next) - if (dovar == n->sym) - { - if (!is_simd || code->ext.omp_clauses->collapse > 1) - gfc_error ("%s iteration variable present on clause " - "other than PRIVATE, LASTPRIVATE or " - "ALLOCATE at %L", name, &do_code->loc); - else - gfc_error ("%s iteration variable present on clause " - "other than PRIVATE, LASTPRIVATE, ALLOCATE or " - "LINEAR at %L", name, &do_code->loc); - break; - } - if (is_outer_iteration_variable (code, i, dovar)) - { - gfc_error ("%s iteration variable used in more than one loop at %L", - name, &do_code->loc); - break; - } - else if (!bound_expr_is_canonical (code, i, - do_code->ext.iterator->start, - &start_var)) - { - gfc_error ("%s loop start expression not in canonical form at %L", - name, &do_code->loc); - break; - } - else if (!bound_expr_is_canonical (code, i, - do_code->ext.iterator->end, - &end_var)) - { - gfc_error ("%s loop end expression not in canonical form at %L", - name, &do_code->loc); - break; - } - else if (start_var && end_var && start_var != end_var) - { - gfc_error ("%s loop bounds reference different " - "iteration variables at %L", name, &do_code->loc); - break; - } - else if (!expr_is_invariant (code, i, do_code->ext.iterator->step)) - { - gfc_error ("%s loop increment not in canonical form at %L", - name, &do_code->loc); - break; - } - if (start_var || end_var) - code->ext.omp_clauses->non_rectangular = 1; - - for (c = do_code->next; c; c = c->next) - if (c->op != EXEC_NOP && c->op != EXEC_CONTINUE) - { - gfc_error ("collapsed %s loops not perfectly nested at %L", - name, &c->loc); - break; - } - if (i == collapse || c) - break; - do_code = do_code->block; - do_code = resolve_nested_loop_transforms (do_code, name, collapse - i, - &code->loc); - if (do_code->op != EXEC_DO && do_code->op != EXEC_DO_WHILE) - { - gfc_error ("not enough DO loops for collapsed %s at %L", - name, &code->loc); - break; - } - do_code = do_code->next; - do_code = resolve_nested_loop_transforms (do_code, name, collapse - i, - &code->loc); - if (do_code == NULL - || (do_code->op != EXEC_DO && do_code->op != EXEC_DO_WHILE)) - { - gfc_error ("not enough DO loops for collapsed %s at %L", - name, &code->loc); - break; - } - } + resolve_nested_loops (code, name, do_code, collapse, is_simd, false); } static void resolve_omp_tile (gfc_code *code) { - gfc_code *do_code, *next; - gfc_symbol *dovar; + gfc_code *do_code; const char *name = "!$OMP TILE"; - unsigned num_loops = 0; + int num_loops = 0; gcc_assert (code->ext.omp_clauses->tile_sizes); for (gfc_expr_list *el = code->ext.omp_clauses->tile_sizes; el; el = el->next) num_loops++; do_code = resolve_nested_loop_transforms (code, name, num_loops, &code->loc); - - for (unsigned i = 1; i <= num_loops; i++) - { - - gfc_symbol *start_var = NULL, *end_var = NULL; - - if (do_code->op == EXEC_DO_WHILE) - { - gfc_error ("%s cannot be a DO WHILE or DO without loop control " - "at %L", name, &do_code->loc); - return; - } - if (do_code->op == EXEC_DO_CONCURRENT) - { - gfc_error ("%s cannot be a DO CONCURRENT loop at %L", name, - &do_code->loc); - return; - } - if (do_code->op != EXEC_DO) - { - gfc_error ("%s must be DO loop at %L", name, - &do_code->loc); - return; - } - - gcc_assert (do_code->op != EXEC_OMP_UNROLL); - gcc_assert (do_code->op == EXEC_DO); - dovar = do_code->ext.iterator->var->symtree->n.sym; - if (is_outer_iteration_variable (code, i, dovar)) - { - gfc_error ("%s iteration variable used in more than one loop at %L (depth %d)", - name, &do_code->loc, i); - return; - } - else if (!bound_expr_is_canonical (code, i, - do_code->ext.iterator->start, - &start_var)) - { - gfc_error ("%s loop start expression not in canonical form at %L", - name, &do_code->loc); - return; - } - else if (!bound_expr_is_canonical (code, i, - do_code->ext.iterator->end, - &end_var)) - { - gfc_error ("%s loop end expression not in canonical form at %L", - name, &do_code->loc); - return; - } - else if (start_var && end_var && start_var != end_var) - { - gfc_error ("%s loop bounds reference different " - "iteration variables at %L", name, &do_code->loc); - return; - } - else if (!expr_is_invariant (code, i, do_code->ext.iterator->step)) - { - gfc_error ("%s loop increment not in canonical form at %L", - name, &do_code->loc); - return; - } - if (start_var || end_var) - code->ext.omp_clauses->non_rectangular = 1; - for (next = do_code->next; next; next = next->next) - if (next->op != EXEC_NOP && next->op != EXEC_CONTINUE) - { - gfc_error ("%s loops not perfectly nested at %L", - name, &next->loc); - break; - } - if (i == num_loops || next) - break; - do_code = do_code->block; - do_code = resolve_nested_loop_transforms (do_code, name, num_loops - i, &code->loc); - if (do_code->op != EXEC_DO && do_code->op != EXEC_DO_WHILE) - { - gfc_error ("not enough DO loops for %s at %L", - name, &code->loc); - break; - } - do_code = do_code->next; - do_code = resolve_nested_loop_transforms (do_code, name, num_loops - i, &code->loc); - if (do_code == NULL - || (do_code->op != EXEC_DO && do_code->op != EXEC_DO_WHILE)) - { - gfc_error ("not enough DO loops for %s at %L", - name, &code->loc); - break; - } - } + resolve_nested_loops (code, name, do_code, num_loops, false, true); } static gfc_statement diff --git a/gcc/testsuite/ChangeLog.omp b/gcc/testsuite/ChangeLog.omp index 72d7b52256a..24a8bc43b10 100644 --- a/gcc/testsuite/ChangeLog.omp +++ b/gcc/testsuite/ChangeLog.omp @@ -1,3 +1,9 @@ +2023-06-13 Sandra Loosemore + + * gfortran.dg/gomp/collapse1.f90: Adjust expected error message. + * gfortran.dg/gomp/collapse2.f90: Likewise. + * gfortran.dg/gomp/loop-transforms/tile-2.f90: Likewise. + 2023-06-13 Sandra Loosemore * c-c++-common/gomp/imperfect1.c: New. diff --git a/gcc/testsuite/gfortran.dg/gomp/collapse1.f90 b/gcc/testsuite/gfortran.dg/gomp/collapse1.f90 index 77b2bdd7fcb..d938e1b569d 100644 --- a/gcc/testsuite/gfortran.dg/gomp/collapse1.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/collapse1.f90 @@ -9,7 +9,7 @@ subroutine collapse1 !$omp threadprivate (thr) l = .false. a(:, :, :) = 0 - !$omp parallel do collapse(4) schedule(static, 4) ! { dg-error "not enough DO loops for collapsed" } + !$omp parallel do collapse(4) schedule(static, 4) ! { dg-error "not enough DO loops for" } do i = 1, 3 do j = 4, 6 do k = 5, 7 diff --git a/gcc/testsuite/gfortran.dg/gomp/collapse2.f90 b/gcc/testsuite/gfortran.dg/gomp/collapse2.f90 index 1ab934e3d0d..0aa7d9391e5 100644 --- a/gcc/testsuite/gfortran.dg/gomp/collapse2.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/collapse2.f90 @@ -17,13 +17,13 @@ program p end do x = 5 ! { dg-error "loops not perfectly nested" } end do - !$omp parallel do collapse(2) ! { dg-error "not enough DO loops for collapsed" } + !$omp parallel do collapse(2) ! { dg-error "not enough DO loops for" } do i = 1, 8 x = 5 do j = 1, 8 end do end do - !$omp parallel do ordered(2) ! { dg-error "not enough DO loops for collapsed" } + !$omp parallel do ordered(2) ! { dg-error "not enough DO loops for" } do i = 1, 8 x = 5 do j = 1, 8 diff --git a/gcc/testsuite/gfortran.dg/gomp/loop-transforms/tile-2.f90 b/gcc/testsuite/gfortran.dg/gomp/loop-transforms/tile-2.f90 index 8a5eae3a188..f4c24f76eac 100644 --- a/gcc/testsuite/gfortran.dg/gomp/loop-transforms/tile-2.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/loop-transforms/tile-2.f90 @@ -64,7 +64,7 @@ subroutine test3 implicit none integer :: i, j, k - !$omp taskloop collapse(3) ! { dg-error {not enough DO loops for collapsed \!\$OMP TASKLOOP at \(1\)} } + !$omp taskloop collapse(3) ! { dg-error {not enough DO loops for \!\$OMP TASKLOOP at \(1\)} } !$omp tile sizes (1,2) ! { dg-error {loop nest depth after \!\$OMP TILE at \(1\) is insufficient for outer \!\$OMP TASKLOOP} } !$omp tile sizes (1,2) do i = 1,100