On Wed, 22 Jun 2011, Michael Matz wrote:
> Hi,
>
> On Tue, 21 Jun 2011, Richard Guenther wrote:
>
> > I failed to see where the scalarizer inserts the temporary vars it
> > creates into the scope blocks (thus the gimplify.c hunk ...). Any help
> > here is welcome.
>
> The scoping of the scalarizer is a bit funny. gfc_start_scalarized_body
> sets up scopes for all dimensions and leaves with the 'body' scope open.
> The bound expressions are inserted (for your testcase) into the 'block'
> scope. In between there are the loop->code[n] scopes.
>
> You can't decide to not go into gfc_start_scalarized_body early, because
> lse.expr will only be set later, so you have to
> properly finish_block all these in-between blocks and wire them into
> loop.pre and then block, like gfc_trans_scalarizing_loops would do. Of
> course you don't want to actually generate loops, which
> gfc_trans_scalarizing_loops does. So you have to manually unwind the
> blocks. If you do that, then you also don't need the ??? marked
> gfc_add_block_to_block (&block, &loop.pre).
>
> So, the code in the VLA_VIEW_EXPR case should be roughly this:
>
> else if (TREE_CODE (lse.expr) == VLA_VIEW_EXPR)
> {
> int dim;
> stmtblock_t *pblock;
>
> pblock = &body;
> for (dim = 0; dim < loop.dimen + loop.codimen; dim++)
> {
> n = loop.order[dim];
> tmp = gfc_finish_block (pblock);
> gfc_add_expr_to_block (&loop.code[n], tmp);
> loop.loopvar[n] = NULL_TREE;
> pblock = &loop.code[n];
> }
>
> tmp = gfc_finish_block (pblock);
> gfc_add_expr_to_block (&loop.pre, tmp);
> gfc_add_block_to_block (&block, &loop.pre);
> gfc_add_block_to_block (&block, &loop.post);
> gfc_cleanup_loop (&loop);
> }
>
> Sorry, no real patch, my quilt queue is busted somehow.
Thanks, that seems to work.
The following is an updated Fortran patch (requiring an updated
middle-end patch as well) which also adds code to handle
intrinsic ALL/ANY (in the hope more runtime tests get coverage
that way).
Richard.
Index: trunk/gcc/fortran/trans-array.c
===================================================================
*** trunk.orig/gcc/fortran/trans-array.c 2011-06-22 14:28:27.000000000
+0200
--- trunk/gcc/fortran/trans-array.c 2011-06-22 14:39:40.000000000 +0200
*************** gfc_conv_scalarized_array_ref (gfc_se *
*** 2570,2575 ****
--- 2570,2637 ----
int n;
info = &se->ss->data.info;
+
+ {
+ tree vv = build_vl_exp (VLA_VIEW_EXPR, 2 + 2 * info->dimen);
+ tree vi = build_vl_exp (VLA_IDX_EXPR, 2 + info->dimen);
+ tree offset = NULL_TREE;
+ tree elt_type;
+ tree type;
+ tree tem;
+ elt_type = TREE_TYPE (se->expr);
+ if (POINTER_TYPE_P (elt_type))
+ elt_type = TREE_TYPE (elt_type);
+ while (TREE_CODE (elt_type) == ARRAY_TYPE)
+ elt_type = TREE_TYPE (elt_type);
+ type = elt_type;
+ for (n = 0; n < info->dimen; ++n)
+ {
+ TREE_OPERAND (vv, 2 + 2 * n) /* extent */
+ = build2 (MINUS_EXPR, TREE_TYPE (info->end[n]),
+ info->end[n], info->start[n]);
+ TREE_OPERAND (vv, 3 + 2 * n) /* stride */
+ = info->stride[n];
+ /* Accumulate start offset. */
+ if (offset)
+ offset = fold_build2_loc (input_location,
+ PLUS_EXPR, TREE_TYPE (offset),
+ offset,
+ fold_build2_loc (input_location,
+ MULT_EXPR, TREE_TYPE
(offset),
+ info->start[n],
+ info->stride[n]));
+ else
+ offset = fold_build2_loc (input_location,
+ MULT_EXPR, TREE_TYPE (info->start[n]),
+ info->start[n],
+ info->stride[n]);
+ type = build_array_type (type, build_index_type
+ (TREE_OPERAND (vv, 2 + 2 * n)));
+ }
+ /* Start address. */
+ tem = info->descriptor;
+ if (!POINTER_TYPE_P (TREE_TYPE (tem)))
+ tem = build_fold_addr_expr (tem);
+ TREE_OPERAND (vv, 1)
+ = fold_build2 (MEM_REF, type,
+ fold_build2_loc (input_location,
+ POINTER_PLUS_EXPR,
+ TREE_TYPE (tem), tem,
+ fold_convert (sizetype, offset)),
+ build_int_cst (build_pointer_type (elt_type), 0));
+ /* Type. */
+ TREE_TYPE (vv) = type;
+ TREE_OPERAND (vi, 1) = vv;
+ for (n = 0; n < info->dimen; ++n)
+ {
+ TREE_OPERAND (vi, 2 + n) /* Index placeholder. */
+ = se->loop->loopvar[n];
+ }
+ TREE_TYPE (vi) = elt_type;
+ se->expr = vi;
+ return;
+ }
+
if (ar)
n = se->loop->order[0];
else
Index: trunk/gcc/fortran/trans-expr.c
===================================================================
*** trunk.orig/gcc/fortran/trans-expr.c 2011-06-22 14:28:27.000000000 +0200
--- trunk/gcc/fortran/trans-expr.c 2011-06-22 14:35:59.000000000 +0200
*************** gfc_trans_assignment_1 (gfc_expr * expr1
*** 6126,6131 ****
--- 6126,6142 ----
else
gfc_conv_expr (&lse, expr1);
+ /* ??? Fixup array LHS. */
+ if (TREE_CODE (lse.expr) == VLA_IDX_EXPR)
+ {
+ tree vi = lse.expr;
+ lse.expr = TREE_OPERAND (vi, 1);
+ TREE_OPERAND (vi, 1) = rse.expr;
+ TREE_SET_CODE (vi, VLA_RIDX_EXPR);
+ TREE_TYPE (vi) = TREE_TYPE (lse.expr);
+ rse.expr = vi;
+ }
+
/* Assignments of scalar derived types with allocatable components
to arrays must be done with a deep copy and the rhs temporary
must have its components deallocated afterwards. */
*************** gfc_trans_assignment_1 (gfc_expr * expr1
*** 6170,6175 ****
--- 6181,6208 ----
/* Use the scalar assignment as is. */
gfc_add_block_to_block (&block, &body);
}
+ /* ??? Skip regular scalarization. */
+ else if (TREE_CODE (lse.expr) == VLA_VIEW_EXPR)
+ {
+ int dim;
+ stmtblock_t *pblock;
+
+ pblock = &body;
+ for (dim = 0; dim < loop.dimen + loop.codimen; dim++)
+ {
+ n = loop.order[dim];
+ tmp = gfc_finish_block (pblock);
+ gfc_add_expr_to_block (&loop.code[n], tmp);
+ loop.loopvar[n] = NULL_TREE;
+ pblock = &loop.code[n];
+ }
+
+ tmp = gfc_finish_block (pblock);
+ gfc_add_expr_to_block (&loop.pre, tmp);
+ gfc_add_block_to_block (&block, &loop.pre);
+ gfc_add_block_to_block (&block, &loop.post);
+ gfc_cleanup_loop (&loop);
+ }
else
{
gcc_assert (lse.ss == gfc_ss_terminator
Index: trunk/gcc/fortran/trans-intrinsic.c
===================================================================
*** trunk.orig/gcc/fortran/trans-intrinsic.c 2011-06-22 14:28:27.000000000
+0200
--- trunk/gcc/fortran/trans-intrinsic.c 2011-06-22 15:03:11.000000000 +0200
*************** gfc_conv_intrinsic_anyall (gfc_se * se,
*** 2392,2397 ****
--- 2392,2398 ----
tree resvar;
stmtblock_t block;
stmtblock_t body;
+ stmtblock_t *pblock;
tree type;
tree tmp;
tree found;
*************** gfc_conv_intrinsic_anyall (gfc_se * se,
*** 2400,2405 ****
--- 2401,2407 ----
gfc_ss *arrayss;
gfc_se arrayse;
tree exit_label;
+ int dim;
if (se->ss)
{
*************** gfc_conv_intrinsic_anyall (gfc_se * se,
*** 2455,2468 ****
arrayse.ss = arrayss;
gfc_conv_expr_val (&arrayse, actual->expr);
! gfc_add_block_to_block (&body, &arrayse.pre);
! tmp = fold_build2_loc (input_location, op, boolean_type_node, arrayse.expr,
! build_int_cst (TREE_TYPE (arrayse.expr), 0));
tmp = build3_v (COND_EXPR, tmp, found, build_empty_stmt (input_location));
gfc_add_expr_to_block (&body, tmp);
gfc_add_block_to_block (&body, &arrayse.post);
! gfc_trans_scalarizing_loops (&loop, &body);
/* Add the exit label. */
tmp = build1_v (LABEL_EXPR, exit_label);
--- 2457,2490 ----
arrayse.ss = arrayss;
gfc_conv_expr_val (&arrayse, actual->expr);
! tmp = arrayse.expr;
! for (dim = 0; dim < loop.dimen; ++dim)
! {
! tree saved = tmp;
! tmp = build_vl_exp (VLA_DELTA_EXPR, 5);
! TREE_TYPE (tmp) = TREE_TYPE (arrayse.expr);
! TREE_OPERAND (tmp, 1)
! = size_int ((int) (op == NE_EXPR ? BIT_IOR_EXPR : BIT_AND_EXPR));
! TREE_OPERAND (tmp, 2) = saved;
! TREE_OPERAND (tmp, 3) = fold_build2_loc (input_location, MINUS_EXPR,
! TREE_TYPE (loop.to[dim]),
! loop.to[dim], loop.from[dim]);
! TREE_OPERAND (tmp, 4) = loop.loopvar[dim];
! }
! tmp = fold_build2_loc (input_location, op, boolean_type_node, tmp,
! build_int_cst (TREE_TYPE (tmp), 0));
tmp = build3_v (COND_EXPR, tmp, found, build_empty_stmt (input_location));
gfc_add_expr_to_block (&body, tmp);
gfc_add_block_to_block (&body, &arrayse.post);
! pblock = &body;
! for (dim = 0; dim < loop.dimen; ++dim)
! {
! gfc_add_expr_to_block (&loop.code[loop.order[dim]],
! gfc_finish_block (pblock));
! pblock = &loop.code[loop.order[dim]];
! }
! gfc_add_expr_to_block (&loop.pre, gfc_finish_block (pblock));
/* Add the exit label. */
tmp = build1_v (LABEL_EXPR, exit_label);
