[PATCH] PR fortran/31593: Speed up loops with DO variables as procedure arguments

[Steven Bosscher]

2009/8/24 Tobias Schlüter <tobias.schlueter@physik.uni-muenchen.de>:
> diff -r 395e36e913de gcc/fortran/trans-stmt.c

Patches are often a bit more readable if you use diff -p (shows the
function you're patching)...


> --- a/gcc/fortran/trans-stmt.c  Sun Aug 23 18:13:56 2009 +0000
> +++ b/gcc/fortran/trans-stmt.c  Mon Aug 24 21:43:32 2009 +0200
> @@ -756,6 +756,49 @@
>  }
>
>

Comment here to explain what you are doing (stack of DO loop vars) and
why (show the transformations you intend to do)?

> +typedef struct do_var_stack {
> +  struct do_var_stack *prev;
> +  gfc_symbol *sym;
> +} do_var_stack;
> +
> +static do_var_stack *dvs_top = NULL;
> +
> +
> +static void
> +push_do_var (gfc_symbol *s)

Comment before the function please.  Same for pop_do_var() and gfc_is_do_var()


> +{
> +  do_var_stack *p
> +    = (do_var_stack *)gfc_getmem(sizeof(do_var_stack));

Since you're putting them on a stack -- why not use an obstack of
objects instead? See obstack examples throughout the middle-end.

> +  p->prev = dvs_top;
> +  p->sym = s;
> +  dvs_top = p;
> +}
> +
> +
> +static void
> +pop_do_var (void)
> +{
> +  do_var_stack *p = dvs_top;
> +  gcc_assert (p);
> +  dvs_top = p->prev;
> +  gfc_free (p);
> +}
> +
> +
> +bool
> +gfc_is_do_var (const gfc_symbol* s)
> +{
> +  do_var_stack *p = dvs_top;
> +  while (p)
> +    {
> +      if (p->sym == s)
> +       return true;
> +      p = p->prev;
> +    }
> +  return false;
> +}
> +
> +
>  /* Translate the simple DO construct.  This is where the loop variable has
>    integer type and step +-1.  We can't use this in the general case
>    because integer overflow and floating point errors could give incorrect
> @@ -874,6 +917,8 @@
>   tmp = build1_v (LABEL_EXPR, exit_label);
>   gfc_add_expr_to_block (pblock, tmp);
>
> +  pop_do_var();
> +
>   return gfc_finish_block (pblock);
>  }
>
> @@ -938,6 +983,7 @@
>   gfc_conv_expr_lhs (&se, code->ext.iterator->var);
>   gfc_add_block_to_block (&block, &se.pre);
>   dovar = se.expr;
> +  push_do_var (code->ext.iterator->var->symtree->n.sym);
>   type = TREE_TYPE (dovar);
>
>   gfc_init_se (&se, NULL);
> @@ -1117,6 +1163,8 @@
>   tmp = build1_v (LABEL_EXPR, exit_label);
>   gfc_add_expr_to_block (&block, tmp);
>
> +  pop_do_var();
> +
>   return gfc_finish_block (&block);
>  }
>
> diff -r 395e36e913de gcc/fortran/trans.h
> --- a/gcc/fortran/trans.h       Sun Aug 23 18:13:56 2009 +0000
> +++ b/gcc/fortran/trans.h       Mon Aug 24 21:43:32 2009 +0200
> @@ -498,6 +498,9 @@
>  /* Build a function decl for a library function.  */
>  tree gfc_build_library_function_decl (tree, tree, int, ...);
>
> +/* See if we're looking at the DO variable of an enclosing block.  */
> +bool gfc_is_do_var (const gfc_symbol *);
> +
>  /* somewhere! */
>  tree pushdecl (tree);
>  tree pushdecl_top_level (tree);
> diff -r 395e36e913de gcc/fortran/trans-expr.c
> --- a/gcc/fortran/trans-expr.c  Sun Aug 23 18:13:56 2009 +0000
> +++ b/gcc/fortran/trans-expr.c  Mon Aug 24 21:43:32 2009 +0200
> @@ -4148,6 +4148,30 @@
>
>   if (expr->expr_type == EXPR_VARIABLE)
>     {
> +      /* The DO variable may not be changed inside a loop.  Yet, if it
> +        is used as argument in a procedure call, the optimizers in
> +        their current state have to assume that it changed inside the
> +        procedure and it has to be committed to memory before
> +        subsequent calls to any other procedure, because the
> +        reference could have escaped.  This can severely slow down
> +        the code.  Therefore, we pass a temporary copy instead of the
> +        DO variable itself.  We cannot do this for a variable with
> +        the TARGET attribute, because the callee could set a POINTER
> +        to the variable that is accessed only after the loop has
> +        terminated.  A stricter criterion would be that the
> +        corresponding dummy argument doesn't have the TARGET
> +        attribute, but that information is not available here.  */

Ah, you explained it here.  Maybe just point to here from the other site.


> +      if (gfc_is_do_var (expr->symtree->n.sym)
> +         && !expr->symtree->n.sym->attr.target)

I would put the TARGET check before the gfc_is_do_var() check.


> +       {
> +         se->want_pointer = 0;
> +         gfc_conv_expr (se, expr);
> +         var = gfc_create_var (TREE_TYPE (se->expr), "arg");
> +         gfc_add_modify (&se->pre, var, se->expr);
> +         se->expr = gfc_build_addr_expr (NULL_TREE, var);
> +         gcc_assert (!se->post.head);
> +         return;
> +       }
>       se->want_pointer = 1;
>       gfc_conv_expr (se, expr);
>       if (se->post.head)


This patch speeds up one of my toy codes by ~12%. Nice :-)

Ciao!
Steven