Re: [PATCH] Middle-end arrays, forward-ported to trunk (again)

[Richard Guenther <rguenther@suse.de>]

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);