From patchwork Fri Oct 21 17:39:45 2011 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Thomas Koenig X-Patchwork-Id: 121031 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) by ozlabs.org (Postfix) with SMTP id 53DAF1007D1 for ; Sat, 22 Oct 2011 04:40:17 +1100 (EST) Received: (qmail 11623 invoked by alias); 21 Oct 2011 17:40:12 -0000 Received: (qmail 11600 invoked by uid 22791); 21 Oct 2011 17:40:10 -0000 X-SWARE-Spam-Status: No, hits=-1.5 required=5.0 tests=AWL, BAYES_00, RCVD_IN_DNSWL_NONE, RP_MATCHES_RCVD X-Spam-Check-By: sourceware.org Received: from cc-smtpout2.netcologne.de (HELO cc-smtpout2.netcologne.de) (89.1.8.212) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Fri, 21 Oct 2011 17:39:52 +0000 Received: from cc-smtpin2.netcologne.de (cc-smtpin2.netcologne.de [89.1.8.202]) by cc-smtpout2.netcologne.de (Postfix) with ESMTP id B9EF0126C8; Fri, 21 Oct 2011 19:39:50 +0200 (CEST) Received: from [192.168.0.105] (xdsl-78-35-161-202.netcologne.de [78.35.161.202]) by cc-smtpin2.netcologne.de (Postfix) with ESMTPSA id 23C1011E88; Fri, 21 Oct 2011 19:39:46 +0200 (CEST) Message-ID: <4EA1AE61.6000003@netcologne.de> Date: Fri, 21 Oct 2011 19:39:45 +0200 From: Thomas Koenig User-Agent: Mozilla/5.0 (X11; U; Linux x86_64; de; rv:1.9.2.17) Gecko/20110414 SUSE/3.1.10 Thunderbird/3.1.10 MIME-Version: 1.0 To: Jakub Jelinek CC: Tobias Burnus , "fortran@gcc.gnu.org" , gcc-patches Subject: Re: [patch, Fortran] Fix PR 50690 References: <4E994C14.30008@netcologne.de> <20111015113600.GD2210@tyan-ft48-01.lab.bos.redhat.com> <4E9976CA.4000803@netcologne.de> <4E99B6A7.10905@net-b.de> <20111015171943.GE2210@tyan-ft48-01.lab.bos.redhat.com> <20111015172445.GF2210@tyan-ft48-01.lab.bos.redhat.com> In-Reply-To: <20111015172445.GF2210@tyan-ft48-01.lab.bos.redhat.com> Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org Jakub Jelinek wrote: > Though, what could be done is just special case OpenMP workshare regions, > insert everything into BLOCK local vars unless in OpenMP workshare, in that > case put the BLOCK with the temporary around the workshare rather than > inside of it. In the case of omp parallel workshare it would need > to go in between omp parallel and omp workshare. Well, here's a patch which implements this concept. I chose to insert the BLOCK in a separate pass because it was the cleanest way to avoid infinite recursion when inserting a block. Regression-tested. OK for trunk? Thomas 2011-10-21 Thomas Koenig PR fortran/50690 * frontend-passes.c (workshare_level): New variable. (create_var): Put the newly created variable into the block around the WORKSHARE. (enclose_workshare): New callback function to enclose WORKSHAREs in blocks. (optimize_namespace): Use it. (gfc_code_walker): Save/restore current namespace when following a BLOCK. Keep track of workshare level. 2011-10-21 Thomas Koenig PR fortran/50690 * gfortran.dg/gomp/workshare2.f90: New test. ! { dg-do run } ! { dg-options "-ffrontend-optimize" } ! PR 50690 - this used to ICE because workshare could not handle ! BLOCKs. program foo implicit none real, parameter :: eps = 3e-7 integer :: i real :: A(10), B(5), C(10) B(1) = 3.344 call random_number(a) c = a !$omp parallel default(shared) !$omp workshare A(:) = A(:)*cos(B(1))+A(:)*cos(B(1)) !$omp end workshare nowait !$omp end parallel ! sync is implied here ! c = c*cos(b(1)) + c*cos(b(1)) ! if (any(abs(a-c) > eps)) call abort end program foo Index: frontend-passes.c =================================================================== --- frontend-passes.c (Revision 180063) +++ frontend-passes.c (Arbeitskopie) @@ -66,6 +66,10 @@ static gfc_namespace *current_ns; static int forall_level; +/* If we are within an OMP WORKSHARE or OMP PARALLEL WORKSHARE. */ + +static int workshare_level; + /* Entry point - run all passes for a namespace. So far, only an optimization pass is run. */ @@ -245,8 +249,16 @@ create_var (gfc_expr * e) gfc_namespace *ns; int i; + /* Special treatment for WORKSHARE: The variable goes into the block + created by the earlier pass around it. */ + + if (workshare_level > 0) + { + ns = current_ns; + changed_statement = current_code; + } /* If the block hasn't already been created, do so. */ - if (inserted_block == NULL) + else if (inserted_block == NULL) { inserted_block = XCNEW (gfc_code); inserted_block->op = EXEC_BLOCK; @@ -497,6 +509,38 @@ convert_do_while (gfc_code **c, int *walk_subtrees return 0; } +/* Callback function to enclose OMP workshares into BLOCKs. This is done + so that later front end optimization can insert temporary variables into + the outer block scope. */ + +static int +enclose_workshare (gfc_code **c, int *walk_subtrees, + void *data ATTRIBUTE_UNUSED) +{ + gfc_code *co; + gfc_code *new_block; + gfc_namespace *ns; + + co = *c; + + if (co->op != EXEC_OMP_WORKSHARE && co->op != EXEC_OMP_PARALLEL_WORKSHARE) + return 0; + + /* Create the block. */ + new_block = XCNEW (gfc_code); + new_block->op = EXEC_BLOCK; + new_block->loc = co->loc; + ns = gfc_build_block_ns (current_ns); + new_block->ext.block.ns = ns; + new_block->ext.block.assoc = NULL; + ns->code = co; + + /* Insert the BLOCK at the right position. */ + *c = new_block; + *walk_subtrees = false; + return 0; +} + /* Optimize a namespace, including all contained namespaces. */ static void @@ -507,6 +551,12 @@ optimize_namespace (gfc_namespace *ns) forall_level = 0; gfc_code_walker (&ns->code, convert_do_while, dummy_expr_callback, NULL); + if (gfc_option.gfc_flag_openmp) + { + workshare_level = 0; + gfc_code_walker (&ns->code, enclose_workshare, dummy_expr_callback, NULL); + } + gfc_code_walker (&ns->code, cfe_code, cfe_expr_0, NULL); gfc_code_walker (&ns->code, optimize_code, optimize_expr, NULL); @@ -1148,6 +1198,7 @@ gfc_code_walker (gfc_code **c, walk_code_fn_t code gfc_code *b; gfc_actual_arglist *a; gfc_code *co; + gfc_namespace *save_ns; gfc_association_list *alist; /* There might be statement insertions before the current code, @@ -1159,7 +1210,11 @@ gfc_code_walker (gfc_code **c, walk_code_fn_t code { case EXEC_BLOCK: + save_ns = current_ns; + current_ns = co->ext.block.ns; WALK_SUBCODE (co->ext.block.ns->code); + current_ns = save_ns; + for (alist = co->ext.block.assoc; alist; alist = alist->next) WALK_SUBEXPR (alist->target); break; @@ -1329,14 +1384,18 @@ gfc_code_walker (gfc_code **c, walk_code_fn_t code WALK_SUBEXPR (co->ext.dt->extra_comma); break; + case EXEC_OMP_PARALLEL_WORKSHARE: + case EXEC_OMP_WORKSHARE: + workshare_level ++; + + /* Fall through. */ + case EXEC_OMP_DO: case EXEC_OMP_PARALLEL: case EXEC_OMP_PARALLEL_DO: case EXEC_OMP_PARALLEL_SECTIONS: - case EXEC_OMP_PARALLEL_WORKSHARE: case EXEC_OMP_SECTIONS: case EXEC_OMP_SINGLE: - case EXEC_OMP_WORKSHARE: case EXEC_OMP_END_SINGLE: case EXEC_OMP_TASK: if (co->ext.omp_clauses) @@ -1365,6 +1424,9 @@ gfc_code_walker (gfc_code **c, walk_code_fn_t code if (co->op == EXEC_FORALL) forall_level --; + if (co->op == EXEC_OMP_WORKSHARE + || co->op == EXEC_OMP_PARALLEL_WORKSHARE) + workshare_level --; } } return 0;