From patchwork Sat Sep 4 14:27:58 2010 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Mikael Morin X-Patchwork-Id: 63787 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 86870B7143 for ; Sun, 5 Sep 2010 00:28:52 +1000 (EST) Received: (qmail 767 invoked by alias); 4 Sep 2010 14:28:49 -0000 Received: (qmail 752 invoked by uid 22791); 4 Sep 2010 14:28:48 -0000 X-SWARE-Spam-Status: No, hits=1.7 required=5.0 tests=AWL, BAYES_00, RCVD_IN_DNSWL_NONE, RCVD_IN_JMF_BL, SPF_NEUTRAL, TW_TM, T_RP_MATCHES_RCVD X-Spam-Check-By: sourceware.org Received: from smtp22.services.sfr.fr (HELO smtp22.services.sfr.fr) (93.17.128.11) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Sat, 04 Sep 2010 14:28:44 +0000 Received: from filter.sfr.fr (localhost [127.0.0.1]) by msfrf2206.sfr.fr (SMTP Server) with ESMTP id EBCFC700008F; Sat, 4 Sep 2010 16:28:41 +0200 (CEST) Received: from gimli.local (122.183.72-86.rev.gaoland.net [86.72.183.122]) by msfrf2206.sfr.fr (SMTP Server) with ESMTP id 0AC377000090; Sat, 4 Sep 2010 16:28:39 +0200 (CEST) X-SFR-UUID: 20100904142840441.0AC377000090@msfrf2206.sfr.fr Message-ID: <4C82576E.7090207@sfr.fr> Date: Sat, 04 Sep 2010 16:27:58 +0200 From: Mikael Morin User-Agent: Mozilla/5.0 (X11; U; FreeBSD amd64; fr-FR; rv:1.9.1.11) Gecko/20100725 Thunderbird/3.0.6 MIME-Version: 1.0 To: "fortran@gcc.gnu.org" , gcc-patches Subject: [Patch, fortran] [6/11] Inline transpose part 1 References: <4C8254A0.9020907@sfr.fr> In-Reply-To: <4C8254A0.9020907@sfr.fr> X-IsSubscribed: yes 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 Same problem as before but reversed: we can't use loop bounds directly to set array bounds as transpose might be involved. OK for trunk? 2010-09-03 Mikael Morin * trans-array.c (gfc_get_array_ref_dim): New function. gfc_trans_create_temp_array): Reconstruct array bounds from loop bounds. Use array bounds instead of loop bounds. diff --git a/trans-array.c b/trans-array.c index da1ae09..148bf6b 100644 --- a/trans-array.c +++ b/trans-array.c @@ -704,6 +704,28 @@ gfc_trans_allocate_array_storage (stmtblock_t * pre, stmtblock_t * post, } +/* Get the array reference dimension corresponding to the given loop dimension. + It is different from the true array dimension given by the dim array in + the case of a partial array reference + It is different from the loop dimension in the case of a transposed array. + */ + +static int +get_array_ref_dim (gfc_ss_info *info, int loop_dim) +{ + int n, array_dim, array_ref_dim; + + array_ref_dim = 0; + array_dim = info->dim[loop_dim]; + + for (n = 0; n < info->dimen; n++) + if (n != loop_dim && info->dim[n] < array_dim) + array_ref_dim++; + + return array_ref_dim; +} + + /* Generate code to create and initialize the descriptor for a temporary array. This is used for both temporaries needed by the scalarizer, and functions returning arrays. Adjusts the loop variables to be @@ -724,6 +746,7 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, tree eltype, tree initial, bool dynamic, bool dealloc, bool callee_alloc, locus * where) { + tree from[GFC_MAX_DIMENSIONS], to[GFC_MAX_DIMENSIONS]; tree type; tree desc; tree tmp; @@ -731,8 +754,10 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, tree nelem; tree cond; tree or_expr; - int n; - int dim; + int n, dim, tmp_dim; + + memset (from, 0, sizeof (from)); + memset (to, 0, sizeof (to)); gcc_assert (info->dimen > 0); gcc_assert (loop->dimen == info->dimen); @@ -741,16 +766,29 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, gfc_warning ("Creating array temporary at %L", where); /* Set the lower bound to zero. */ - for (dim = 0; dim < info->dimen; dim++) + for (n = 0; n < loop->dimen; n++) { - n = loop->order[dim]; + dim = info->dim[n]; + /* Callee allocated arrays may not have a known bound yet. */ if (loop->to[n]) - loop->to[n] = gfc_evaluate_now (fold_build2 (MINUS_EXPR, - gfc_array_index_type, - loop->to[n], loop->from[n]), pre); + loop->to[n] = gfc_evaluate_now ( + fold_build2 (MINUS_EXPR, + gfc_array_index_type, + loop->to[n], loop->from[n]), + pre); loop->from[n] = gfc_index_zero_node; + /* We are constructing the temporary's descriptor based on the loop + dimensions. As the dimensions may be accessed in arbitrary order + (think of transpose) the size taken from the n'th loop may not map + to the n'th dimension of the array. We need to reconstruct loop infos + in the right order before using it to set the descriptor + bounds. */ + tmp_dim = get_array_ref_dim (info, n); + from[tmp_dim] = loop->from[n]; + to[tmp_dim] = loop->to[n]; + info->delta[dim] = gfc_index_zero_node; info->start[dim] = gfc_index_zero_node; info->end[dim] = gfc_index_zero_node; @@ -759,7 +797,7 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, /* Initialize the descriptor. */ type = - gfc_get_array_type_bounds (eltype, info->dimen, 0, loop->from, loop->to, 1, + gfc_get_array_type_bounds (eltype, info->dimen, 0, from, to, 1, GFC_ARRAY_UNKNOWN, true); desc = gfc_create_var (type, "atmp"); GFC_DECL_PACKED_ARRAY (desc) = 1; @@ -805,23 +843,23 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, of the descriptor fields. */ tmp = fold_build2 ( MINUS_EXPR, gfc_array_index_type, - gfc_conv_descriptor_ubound_get (desc, gfc_rank_cst[dim]), - gfc_conv_descriptor_lbound_get (desc, gfc_rank_cst[dim])); + gfc_conv_descriptor_ubound_get (desc, gfc_rank_cst[n]), + gfc_conv_descriptor_lbound_get (desc, gfc_rank_cst[n])); loop->to[n] = tmp; continue; } /* Store the stride and bound components in the descriptor. */ - gfc_conv_descriptor_stride_set (pre, desc, gfc_rank_cst[dim], size); + gfc_conv_descriptor_stride_set (pre, desc, gfc_rank_cst[n], size); - gfc_conv_descriptor_lbound_set (pre, desc, gfc_rank_cst[dim], + gfc_conv_descriptor_lbound_set (pre, desc, gfc_rank_cst[n], gfc_index_zero_node); - gfc_conv_descriptor_ubound_set (pre, desc, gfc_rank_cst[dim], - loop->to[n]); + gfc_conv_descriptor_ubound_set (pre, desc, gfc_rank_cst[n], + to[n]); tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type, - loop->to[n], gfc_index_one_node); + to[n], gfc_index_one_node); /* Check whether the size for this dimension is negative. */ cond = fold_build2 (LE_EXPR, boolean_type_node, tmp,