ipa: special pass-through op for Fortran strides

Hi,

when Fortran functions pass array descriptors they receive as a
parameter to another function, they actually rebuild it.  Thanks to
work done mainly by Feng, IPA-CP can already handle the cases when
they pass directly the values loaded from the original descriptor.
Unfortunately, perhaps the most important one, stride, is first
checked against zero and is replaced with one in that case:

  _12 = *a_11(D).dim[0].stride;
  if (_12 != 0)
    goto <bb 4>; [50.00%]
  else
    goto <bb 3>; [50.00%]

  <bb 3>
    // empty BB
  <bb 4>
  # iftmp.22_9 = PHI <_12(2), 1(3)>
   ...
   parm.6.dim[0].stride = iftmp.22_9;
   ...
   __x_MOD_foo (&parm.6, b_31(D));

in the most important and hopefully common cases, the incoming value
is already 1 and we fail to propagate it.

I would therefore like to propose the following way of encoding this
situation in pass-through jump functions using using ASSERTT_EXPR
operation code meaning that if the incoming value is the same as the
"operand" in the jump function, it is passed on, otherwise the result
is unknown.  This of course captures only the single (but most
important) case but is an improvement and does not need enlarging the
jump function structure and is simple to pattern match.  Encoding that
zero needs to be changed to one would need another field and matching
it would be slightly more complicated too.

Bootstrapped and tested on x86_64-linux, LTO bootstrap is underway.  OK
if it passes?

Thanks,

Martin


2020-06-12  Martin Jambor  <mjambor@suse.cz>

	* ipa-prop.h (ipa_pass_through_data): Expand comment describing
	operation.
	* ipa-prop.c (analyze_agg_content_value): Detect new special case and
	encode it as ASSERT_EXPR.
	* ipa-cp.c (values_equal_for_ipcp_p): Move before
	ipa_get_jf_arith_result.
	(ipa_get_jf_arith_result): Special case ASSERT_EXPR.

	testsuite/
	* gfortran.dg/ipcp-array-2.f90: New test.
---
 gcc/ipa-cp.c                               |  48 ++++---
 gcc/ipa-prop.c                             | 148 ++++++++++++++-------
 gcc/ipa-prop.h                             |  11 +-
 gcc/testsuite/gfortran.dg/ipcp-array-2.f90 |  45 +++++++
 4 files changed, 179 insertions(+), 73 deletions(-)
 create mode 100644 gcc/testsuite/gfortran.dg/ipcp-array-2.f90

On Fri, Jun 12, 2020 at 11:28 PM Martin Jambor <mjambor@suse.cz> wrote:
>
> Hi,
>
> when Fortran functions pass array descriptors they receive as a
> parameter to another function, they actually rebuild it.  Thanks to
> work done mainly by Feng, IPA-CP can already handle the cases when
> they pass directly the values loaded from the original descriptor.
> Unfortunately, perhaps the most important one, stride, is first
> checked against zero and is replaced with one in that case:
>
>   _12 = *a_11(D).dim[0].stride;
>   if (_12 != 0)
>     goto <bb 4>; [50.00%]
>   else
>     goto <bb 3>; [50.00%]
>
>   <bb 3>
>     // empty BB
>   <bb 4>
>   # iftmp.22_9 = PHI <_12(2), 1(3)>
>    ...
>    parm.6.dim[0].stride = iftmp.22_9;
>    ...
>    __x_MOD_foo (&parm.6, b_31(D));
>
> in the most important and hopefully common cases, the incoming value
> is already 1 and we fail to propagate it.
>
> I would therefore like to propose the following way of encoding this
> situation in pass-through jump functions using using ASSERTT_EXPR
> operation code meaning that if the incoming value is the same as the
> "operand" in the jump function, it is passed on, otherwise the result
> is unknown.  This of course captures only the single (but most
> important) case but is an improvement and does not need enlarging the
> jump function structure and is simple to pattern match.  Encoding that
> zero needs to be changed to one would need another field and matching
> it would be slightly more complicated too.
>
> Bootstrapped and tested on x86_64-linux, LTO bootstrap is underway.  OK
> if it passes?

Looks reasonable - I wonder if we somehow track enough info to
infer the _12 != 0 check in IPA propagation?  So whether there's the
possibility to not use "conditional 1" as I understand you do but
"conditional *a_11(D).dim[0].stride"?  Because AFAICS you
compare _12 against 1 in IPA propagation to enable the propagation,
why not compare it against 0?  Or even allow all cases to be resolved
if _12 is a constant?  That is, propagate a "_12 != 0 ? 12 : 1" jump
function which you should be able to resolve in the exact same
way via values_equal_for_ipa_cp_p?

Thanks,
Richard.

> Thanks,
>
> Martin
>
>
> 2020-06-12  Martin Jambor  <mjambor@suse.cz>
>
>         * ipa-prop.h (ipa_pass_through_data): Expand comment describing
>         operation.
>         * ipa-prop.c (analyze_agg_content_value): Detect new special case and
>         encode it as ASSERT_EXPR.
>         * ipa-cp.c (values_equal_for_ipcp_p): Move before
>         ipa_get_jf_arith_result.
>         (ipa_get_jf_arith_result): Special case ASSERT_EXPR.
>
>         testsuite/
>         * gfortran.dg/ipcp-array-2.f90: New test.
> ---
>  gcc/ipa-cp.c                               |  48 ++++---
>  gcc/ipa-prop.c                             | 148 ++++++++++++++-------
>  gcc/ipa-prop.h                             |  11 +-
>  gcc/testsuite/gfortran.dg/ipcp-array-2.f90 |  45 +++++++
>  4 files changed, 179 insertions(+), 73 deletions(-)
>  create mode 100644 gcc/testsuite/gfortran.dg/ipcp-array-2.f90
>
> diff --git a/gcc/ipa-cp.c b/gcc/ipa-cp.c
> index b0c8f405260..4a2714c634f 100644
> --- a/gcc/ipa-cp.c
> +++ b/gcc/ipa-cp.c
> @@ -1290,6 +1290,26 @@ initialize_node_lattices (struct cgraph_node *node)
>        }
>  }
>
> +/* Return true iff X and Y should be considered equal values by IPA-CP.  */
> +
> +static bool
> +values_equal_for_ipcp_p (tree x, tree y)
> +{
> +  gcc_checking_assert (x != NULL_TREE && y != NULL_TREE);
> +
> +  if (x == y)
> +    return true;
> +
> +  if (TREE_CODE (x) == ADDR_EXPR
> +      && TREE_CODE (y) == ADDR_EXPR
> +      && TREE_CODE (TREE_OPERAND (x, 0)) == CONST_DECL
> +      && TREE_CODE (TREE_OPERAND (y, 0)) == CONST_DECL)
> +    return operand_equal_p (DECL_INITIAL (TREE_OPERAND (x, 0)),
> +                           DECL_INITIAL (TREE_OPERAND (y, 0)), 0);
> +  else
> +    return operand_equal_p (x, y, 0);
> +}
> +
>  /* Return the result of a (possibly arithmetic) operation on the constant
>     value INPUT.  OPERAND is 2nd operand for binary operation.  RES_TYPE is
>     the type of the parameter to which the result is passed.  Return
> @@ -1307,6 +1327,14 @@ ipa_get_jf_arith_result (enum tree_code opcode, tree input, tree operand,
>    if (!is_gimple_ip_invariant (input))
>      return NULL_TREE;
>
> +  if (opcode == ASSERT_EXPR)
> +    {
> +      if (values_equal_for_ipcp_p (input, operand))
> +       return input;
> +      else
> +       return NULL_TREE;
> +    }
> +
>    if (!res_type)
>      {
>        if (TREE_CODE_CLASS (opcode) == tcc_comparison)
> @@ -1739,26 +1767,6 @@ ipcp_verify_propagated_values (void)
>      }
>  }
>
> -/* Return true iff X and Y should be considered equal values by IPA-CP.  */
> -
> -static bool
> -values_equal_for_ipcp_p (tree x, tree y)
> -{
> -  gcc_checking_assert (x != NULL_TREE && y != NULL_TREE);
> -
> -  if (x == y)
> -    return true;
> -
> -  if (TREE_CODE (x) ==  ADDR_EXPR
> -      && TREE_CODE (y) ==  ADDR_EXPR
> -      && TREE_CODE (TREE_OPERAND (x, 0)) == CONST_DECL
> -      && TREE_CODE (TREE_OPERAND (y, 0)) == CONST_DECL)
> -    return operand_equal_p (DECL_INITIAL (TREE_OPERAND (x, 0)),
> -                           DECL_INITIAL (TREE_OPERAND (y, 0)), 0);
> -  else
> -    return operand_equal_p (x, y, 0);
> -}
> -
>  /* Return true iff X and Y should be considered equal contexts by IPA-CP.  */
>
>  static bool
> diff --git a/gcc/ipa-prop.c b/gcc/ipa-prop.c
> index 71ac0e104d2..16483fb413a 100644
> --- a/gcc/ipa-prop.c
> +++ b/gcc/ipa-prop.c
> @@ -1704,75 +1704,123 @@ analyze_agg_content_value (struct ipa_func_body_info *fbi,
>
>        stmt = SSA_NAME_DEF_STMT (rhs1);
>        if (!is_gimple_assign (stmt))
> -       return;
> +       break;
>
>        rhs1 = gimple_assign_rhs1 (stmt);
>      }
>
> -  code = gimple_assign_rhs_code (stmt);
> -  switch (gimple_assign_rhs_class (stmt))
> +  if (gphi *phi = dyn_cast<gphi *> (stmt))
>      {
> -    case GIMPLE_SINGLE_RHS:
> -      if (is_gimple_ip_invariant (rhs1))
> +      /* Also special case like the following (a is a formal parameter):
> +
> +          _12 = *a_11(D).dim[0].stride;
> +          ...
> +          # iftmp.22_9 = PHI <_12(2), 1(3)>
> +          ...
> +          parm.6.dim[0].stride = iftmp.22_9;
> +          ...
> +          __x_MOD_foo (&parm.6, b_31(D));
> +
> +        The aggregate function describing parm.6.dim[0].stride is encoded as a
> +        PASS-THROUGH jump function with ASSERT_EXPR operation whith operand 1
> +        (the constant from the PHI node).  */
> +
> +      if (gimple_phi_num_args (phi) != 2)
> +       return;
> +      tree arg0 = gimple_phi_arg_def (phi, 0);
> +      tree arg1 = gimple_phi_arg_def (phi, 1);
> +      tree operand;
> +
> +      if (is_gimple_ip_invariant (arg1))
>         {
> -         agg_value->pass_through.operand = rhs1;
> -         return;
> +         operand = arg1;
> +         rhs1 = arg0;
>         }
> -      code = NOP_EXPR;
> -      break;
> -
> -    case GIMPLE_UNARY_RHS:
> -      /* NOTE: A GIMPLE_UNARY_RHS operation might not be tcc_unary
> -        (truth_not_expr is example), GIMPLE_BINARY_RHS does not imply
> -        tcc_binary, this subtleness is somewhat misleading.
> -
> -        Since tcc_unary is widely used in IPA-CP code to check an operation
> -        with one operand, here we only allow tc_unary operation to avoid
> -        possible problem.  Then we can use (opclass == tc_unary) or not to
> -        distinguish unary and binary.  */
> -      if (TREE_CODE_CLASS (code) != tcc_unary || CONVERT_EXPR_CODE_P (code))
> +      else if (is_gimple_ip_invariant (arg0))
> +       {
> +         operand = arg0;
> +         rhs1 = arg1;
> +       }
> +      else
>         return;
>
>        rhs1 = get_ssa_def_if_simple_copy (rhs1, &stmt);
> -      break;
> +      if (!is_gimple_assign (stmt))
> +       return;
>
> -    case GIMPLE_BINARY_RHS:
> -      {
> -       gimple *rhs1_stmt = stmt;
> -       gimple *rhs2_stmt = stmt;
> -       tree rhs2 = gimple_assign_rhs2 (stmt);
> +      code = ASSERT_EXPR;
> +      agg_value->pass_through.operand = operand;
> +    }
> +  else if (is_gimple_assign (stmt))
> +    {
> +      code = gimple_assign_rhs_code (stmt);
> +      switch (gimple_assign_rhs_class (stmt))
> +       {
> +       case GIMPLE_SINGLE_RHS:
> +         if (is_gimple_ip_invariant (rhs1))
> +           {
> +             agg_value->pass_through.operand = rhs1;
> +             return;
> +           }
> +         code = NOP_EXPR;
> +         break;
>
> -       rhs1 = get_ssa_def_if_simple_copy (rhs1, &rhs1_stmt);
> -       rhs2 = get_ssa_def_if_simple_copy (rhs2, &rhs2_stmt);
> +       case GIMPLE_UNARY_RHS:
> +         /* NOTE: A GIMPLE_UNARY_RHS operation might not be tcc_unary
> +            (truth_not_expr is example), GIMPLE_BINARY_RHS does not imply
> +            tcc_binary, this subtleness is somewhat misleading.
>
> -       if (is_gimple_ip_invariant (rhs2))
> +            Since tcc_unary is widely used in IPA-CP code to check an operation
> +            with one operand, here we only allow tc_unary operation to avoid
> +            possible problem.  Then we can use (opclass == tc_unary) or not to
> +            distinguish unary and binary.  */
> +         if (TREE_CODE_CLASS (code) != tcc_unary || CONVERT_EXPR_CODE_P (code))
> +           return;
> +
> +         rhs1 = get_ssa_def_if_simple_copy (rhs1, &stmt);
> +         break;
> +
> +       case GIMPLE_BINARY_RHS:
>           {
> -           agg_value->pass_through.operand = rhs2;
> -           stmt = rhs1_stmt;
> -         }
> -       else if (is_gimple_ip_invariant (rhs1))
> -         {
> -           if (TREE_CODE_CLASS (code) == tcc_comparison)
> -             code = swap_tree_comparison (code);
> -           else if (!commutative_tree_code (code))
> +           gimple *rhs1_stmt = stmt;
> +           gimple *rhs2_stmt = stmt;
> +           tree rhs2 = gimple_assign_rhs2 (stmt);
> +
> +           rhs1 = get_ssa_def_if_simple_copy (rhs1, &rhs1_stmt);
> +           rhs2 = get_ssa_def_if_simple_copy (rhs2, &rhs2_stmt);
> +
> +           if (is_gimple_ip_invariant (rhs2))
> +             {
> +               agg_value->pass_through.operand = rhs2;
> +               stmt = rhs1_stmt;
> +             }
> +           else if (is_gimple_ip_invariant (rhs1))
> +             {
> +               if (TREE_CODE_CLASS (code) == tcc_comparison)
> +                 code = swap_tree_comparison (code);
> +               else if (!commutative_tree_code (code))
> +                 return;
> +
> +               agg_value->pass_through.operand = rhs1;
> +               stmt = rhs2_stmt;
> +               rhs1 = rhs2;
> +             }
> +           else
>               return;
>
> -           agg_value->pass_through.operand = rhs1;
> -           stmt = rhs2_stmt;
> -           rhs1 = rhs2;
> +           if (TREE_CODE_CLASS (code) != tcc_comparison
> +               && !useless_type_conversion_p (TREE_TYPE (lhs),
> +                                              TREE_TYPE (rhs1)))
> +             return;
>           }
> -       else
> -         return;
> +         break;
>
> -       if (TREE_CODE_CLASS (code) != tcc_comparison
> -           && !useless_type_conversion_p (TREE_TYPE (lhs), TREE_TYPE (rhs1)))
> +       default:
>           return;
> -      }
> -      break;
> -
> -    default:
> -      return;
> -  }
> +       }
> +    }
> +  else
> +    return;
>
>    if (TREE_CODE (rhs1) != SSA_NAME)
>      index = load_from_unmodified_param_or_agg (fbi, fbi->info, stmt,
> diff --git a/gcc/ipa-prop.h b/gcc/ipa-prop.h
> index 168c4c26443..a96dac85962 100644
> --- a/gcc/ipa-prop.h
> +++ b/gcc/ipa-prop.h
> @@ -94,9 +94,14 @@ struct GTY(()) ipa_pass_through_data
>    /* Number of the caller's formal parameter being passed.  */
>    int formal_id;
>    /* Operation that is performed on the argument before it is passed on.
> -     NOP_EXPR means no operation.  Otherwise oper must be a simple binary
> -     arithmetic operation where the caller's parameter is the first operand and
> -     operand field from this structure is the second one.  */
> +     Special values which have other meaning than in normal contexts:
> +       - NOP_EXPR means no operation, not even type conversion.
> +       - ASSERT_EXPR means that only the value in operand is allowed to pass
> +         through (without any change), for all other values the result is
> +         unknown.
> +     Otherwise operation must be a simple binary or unary arithmetic operation
> +     where the caller's parameter is the first operand and (for binary
> +     operations) the operand field from this structure is the second one.  */
>    enum tree_code operation;
>    /* When the passed value is a pointer, it is set to true only when we are
>       certain that no write to the object it points to has occurred since the
> diff --git a/gcc/testsuite/gfortran.dg/ipcp-array-2.f90 b/gcc/testsuite/gfortran.dg/ipcp-array-2.f90
> new file mode 100644
> index 00000000000..9af8fffa7ea
> --- /dev/null
> +++ b/gcc/testsuite/gfortran.dg/ipcp-array-2.f90
> @@ -0,0 +1,45 @@
> +! { dg-do compile }
> +! { dg-options "-O3 -fno-inline -fwhole-program -fdump-ipa-cp-details -fdump-tree-lversion-details" }
> +
> +module x
> +  implicit none
> +contains
> +  subroutine foo(a, b)
> +    real :: a(:,:)
> +    real :: b
> +    integer :: i,j
> +    b = 0.
> +    do j=1,size(a,2)
> +       do i=1,size(a,1)
> +          b = b + a(i,j) * i * j
> +       end do
> +    end do
> +  end subroutine foo
> +
> +  subroutine bar(a, b)
> +    real :: a(:,:)
> +    real :: b
> +    call foo (a,b)
> +  end subroutine bar
> +
> +end module x
> +
> +program main
> +  use x
> +  implicit none
> +  integer :: n, m
> +  real, dimension(4,3) :: a
> +  real, dimension(3,4) :: c
> +  real :: b
> +  call random_number(a)
> +  call bar(a,b)
> +  print *,b
> +
> +  call random_number(c)
> +  call bar(c,b)
> +  print *,b
> +
> +end program main
> +
> +! { dg-final { scan-ipa-dump "op assert_expr 1" "cp" } }
> +! { dg-final { scan-tree-dump-not "versioned this loop for when certain strides are 1" "lversion" } }
> --
> 2.26.2
>

> On Fri, Jun 12, 2020 at 11:28 PM Martin Jambor <mjambor@suse.cz> wrote:
> >
> > Hi,
> >
> > when Fortran functions pass array descriptors they receive as a
> > parameter to another function, they actually rebuild it.  Thanks to
> > work done mainly by Feng, IPA-CP can already handle the cases when
> > they pass directly the values loaded from the original descriptor.
> > Unfortunately, perhaps the most important one, stride, is first
> > checked against zero and is replaced with one in that case:
> >
> >   _12 = *a_11(D).dim[0].stride;
> >   if (_12 != 0)
> >     goto <bb 4>; [50.00%]
> >   else
> >     goto <bb 3>; [50.00%]
> >
> >   <bb 3>
> >     // empty BB
> >   <bb 4>
> >   # iftmp.22_9 = PHI <_12(2), 1(3)>
> >    ...
> >    parm.6.dim[0].stride = iftmp.22_9;
> >    ...
> >    __x_MOD_foo (&parm.6, b_31(D));
> >
> > in the most important and hopefully common cases, the incoming value
> > is already 1 and we fail to propagate it.
> >
> > I would therefore like to propose the following way of encoding this
> > situation in pass-through jump functions using using ASSERTT_EXPR
> > operation code meaning that if the incoming value is the same as the
> > "operand" in the jump function, it is passed on, otherwise the result
> > is unknown.  This of course captures only the single (but most
> > important) case but is an improvement and does not need enlarging the
> > jump function structure and is simple to pattern match.  Encoding that
> > zero needs to be changed to one would need another field and matching
> > it would be slightly more complicated too.
> >
> > Bootstrapped and tested on x86_64-linux, LTO bootstrap is underway.  OK
> > if it passes?
> 
> Looks reasonable - I wonder if we somehow track enough info to
> infer the _12 != 0 check in IPA propagation?  So whether there's the
> possibility to not use "conditional 1" as I understand you do but
> "conditional *a_11(D).dim[0].stride"?  Because AFAICS you
> compare _12 against 1 in IPA propagation to enable the propagation,
> why not compare it against 0?  Or even allow all cases to be resolved
> if _12 is a constant?  That is, propagate a "_12 != 0 ? 12 : 1" jump
> function which you should be able to resolve in the exact same
> way via values_equal_for_ipa_cp_p?

I was wondering, since we can now represent more complex arithmetic
operations, if we can express param0 + (param0 != 0) using the jump
function w/o use of assert exprs?

In general assert exprs seems like good concept to represent conditional
jumps though.

Honza
> 
> Thanks,
> Richard.
> 
> > Thanks,
> >
> > Martin
> >
> >
> > 2020-06-12  Martin Jambor  <mjambor@suse.cz>
> >
> >         * ipa-prop.h (ipa_pass_through_data): Expand comment describing
> >         operation.
> >         * ipa-prop.c (analyze_agg_content_value): Detect new special case and
> >         encode it as ASSERT_EXPR.
> >         * ipa-cp.c (values_equal_for_ipcp_p): Move before
> >         ipa_get_jf_arith_result.
> >         (ipa_get_jf_arith_result): Special case ASSERT_EXPR.
> >
> >         testsuite/
> >         * gfortran.dg/ipcp-array-2.f90: New test.
> > ---
> >  gcc/ipa-cp.c                               |  48 ++++---
> >  gcc/ipa-prop.c                             | 148 ++++++++++++++-------
> >  gcc/ipa-prop.h                             |  11 +-
> >  gcc/testsuite/gfortran.dg/ipcp-array-2.f90 |  45 +++++++
> >  4 files changed, 179 insertions(+), 73 deletions(-)
> >  create mode 100644 gcc/testsuite/gfortran.dg/ipcp-array-2.f90
> >
> > diff --git a/gcc/ipa-cp.c b/gcc/ipa-cp.c
> > index b0c8f405260..4a2714c634f 100644
> > --- a/gcc/ipa-cp.c
> > +++ b/gcc/ipa-cp.c
> > @@ -1290,6 +1290,26 @@ initialize_node_lattices (struct cgraph_node *node)
> >        }
> >  }
> >
> > +/* Return true iff X and Y should be considered equal values by IPA-CP.  */
> > +
> > +static bool
> > +values_equal_for_ipcp_p (tree x, tree y)
> > +{
> > +  gcc_checking_assert (x != NULL_TREE && y != NULL_TREE);
> > +
> > +  if (x == y)
> > +    return true;
> > +
> > +  if (TREE_CODE (x) == ADDR_EXPR
> > +      && TREE_CODE (y) == ADDR_EXPR
> > +      && TREE_CODE (TREE_OPERAND (x, 0)) == CONST_DECL
> > +      && TREE_CODE (TREE_OPERAND (y, 0)) == CONST_DECL)
> > +    return operand_equal_p (DECL_INITIAL (TREE_OPERAND (x, 0)),
> > +                           DECL_INITIAL (TREE_OPERAND (y, 0)), 0);
> > +  else
> > +    return operand_equal_p (x, y, 0);
> > +}
> > +
> >  /* Return the result of a (possibly arithmetic) operation on the constant
> >     value INPUT.  OPERAND is 2nd operand for binary operation.  RES_TYPE is
> >     the type of the parameter to which the result is passed.  Return
> > @@ -1307,6 +1327,14 @@ ipa_get_jf_arith_result (enum tree_code opcode, tree input, tree operand,
> >    if (!is_gimple_ip_invariant (input))
> >      return NULL_TREE;
> >
> > +  if (opcode == ASSERT_EXPR)
> > +    {
> > +      if (values_equal_for_ipcp_p (input, operand))
> > +       return input;
> > +      else
> > +       return NULL_TREE;
> > +    }
> > +
> >    if (!res_type)
> >      {
> >        if (TREE_CODE_CLASS (opcode) == tcc_comparison)
> > @@ -1739,26 +1767,6 @@ ipcp_verify_propagated_values (void)
> >      }
> >  }
> >
> > -/* Return true iff X and Y should be considered equal values by IPA-CP.  */
> > -
> > -static bool
> > -values_equal_for_ipcp_p (tree x, tree y)
> > -{
> > -  gcc_checking_assert (x != NULL_TREE && y != NULL_TREE);
> > -
> > -  if (x == y)
> > -    return true;
> > -
> > -  if (TREE_CODE (x) ==  ADDR_EXPR
> > -      && TREE_CODE (y) ==  ADDR_EXPR
> > -      && TREE_CODE (TREE_OPERAND (x, 0)) == CONST_DECL
> > -      && TREE_CODE (TREE_OPERAND (y, 0)) == CONST_DECL)
> > -    return operand_equal_p (DECL_INITIAL (TREE_OPERAND (x, 0)),
> > -                           DECL_INITIAL (TREE_OPERAND (y, 0)), 0);
> > -  else
> > -    return operand_equal_p (x, y, 0);
> > -}
> > -
> >  /* Return true iff X and Y should be considered equal contexts by IPA-CP.  */
> >
> >  static bool
> > diff --git a/gcc/ipa-prop.c b/gcc/ipa-prop.c
> > index 71ac0e104d2..16483fb413a 100644
> > --- a/gcc/ipa-prop.c
> > +++ b/gcc/ipa-prop.c
> > @@ -1704,75 +1704,123 @@ analyze_agg_content_value (struct ipa_func_body_info *fbi,
> >
> >        stmt = SSA_NAME_DEF_STMT (rhs1);
> >        if (!is_gimple_assign (stmt))
> > -       return;
> > +       break;
> >
> >        rhs1 = gimple_assign_rhs1 (stmt);
> >      }
> >
> > -  code = gimple_assign_rhs_code (stmt);
> > -  switch (gimple_assign_rhs_class (stmt))
> > +  if (gphi *phi = dyn_cast<gphi *> (stmt))
> >      {
> > -    case GIMPLE_SINGLE_RHS:
> > -      if (is_gimple_ip_invariant (rhs1))
> > +      /* Also special case like the following (a is a formal parameter):
> > +
> > +          _12 = *a_11(D).dim[0].stride;
> > +          ...
> > +          # iftmp.22_9 = PHI <_12(2), 1(3)>
> > +          ...
> > +          parm.6.dim[0].stride = iftmp.22_9;
> > +          ...
> > +          __x_MOD_foo (&parm.6, b_31(D));
> > +
> > +        The aggregate function describing parm.6.dim[0].stride is encoded as a
> > +        PASS-THROUGH jump function with ASSERT_EXPR operation whith operand 1
> > +        (the constant from the PHI node).  */
> > +
> > +      if (gimple_phi_num_args (phi) != 2)
> > +       return;
> > +      tree arg0 = gimple_phi_arg_def (phi, 0);
> > +      tree arg1 = gimple_phi_arg_def (phi, 1);
> > +      tree operand;
> > +
> > +      if (is_gimple_ip_invariant (arg1))
> >         {
> > -         agg_value->pass_through.operand = rhs1;
> > -         return;
> > +         operand = arg1;
> > +         rhs1 = arg0;
> >         }
> > -      code = NOP_EXPR;
> > -      break;
> > -
> > -    case GIMPLE_UNARY_RHS:
> > -      /* NOTE: A GIMPLE_UNARY_RHS operation might not be tcc_unary
> > -        (truth_not_expr is example), GIMPLE_BINARY_RHS does not imply
> > -        tcc_binary, this subtleness is somewhat misleading.
> > -
> > -        Since tcc_unary is widely used in IPA-CP code to check an operation
> > -        with one operand, here we only allow tc_unary operation to avoid
> > -        possible problem.  Then we can use (opclass == tc_unary) or not to
> > -        distinguish unary and binary.  */
> > -      if (TREE_CODE_CLASS (code) != tcc_unary || CONVERT_EXPR_CODE_P (code))
> > +      else if (is_gimple_ip_invariant (arg0))
> > +       {
> > +         operand = arg0;
> > +         rhs1 = arg1;
> > +       }
> > +      else
> >         return;
> >
> >        rhs1 = get_ssa_def_if_simple_copy (rhs1, &stmt);
> > -      break;
> > +      if (!is_gimple_assign (stmt))
> > +       return;
> >
> > -    case GIMPLE_BINARY_RHS:
> > -      {
> > -       gimple *rhs1_stmt = stmt;
> > -       gimple *rhs2_stmt = stmt;
> > -       tree rhs2 = gimple_assign_rhs2 (stmt);
> > +      code = ASSERT_EXPR;
> > +      agg_value->pass_through.operand = operand;
> > +    }
> > +  else if (is_gimple_assign (stmt))
> > +    {
> > +      code = gimple_assign_rhs_code (stmt);
> > +      switch (gimple_assign_rhs_class (stmt))
> > +       {
> > +       case GIMPLE_SINGLE_RHS:
> > +         if (is_gimple_ip_invariant (rhs1))
> > +           {
> > +             agg_value->pass_through.operand = rhs1;
> > +             return;
> > +           }
> > +         code = NOP_EXPR;
> > +         break;
> >
> > -       rhs1 = get_ssa_def_if_simple_copy (rhs1, &rhs1_stmt);
> > -       rhs2 = get_ssa_def_if_simple_copy (rhs2, &rhs2_stmt);
> > +       case GIMPLE_UNARY_RHS:
> > +         /* NOTE: A GIMPLE_UNARY_RHS operation might not be tcc_unary
> > +            (truth_not_expr is example), GIMPLE_BINARY_RHS does not imply
> > +            tcc_binary, this subtleness is somewhat misleading.
> >
> > -       if (is_gimple_ip_invariant (rhs2))
> > +            Since tcc_unary is widely used in IPA-CP code to check an operation
> > +            with one operand, here we only allow tc_unary operation to avoid
> > +            possible problem.  Then we can use (opclass == tc_unary) or not to
> > +            distinguish unary and binary.  */
> > +         if (TREE_CODE_CLASS (code) != tcc_unary || CONVERT_EXPR_CODE_P (code))
> > +           return;
> > +
> > +         rhs1 = get_ssa_def_if_simple_copy (rhs1, &stmt);
> > +         break;
> > +
> > +       case GIMPLE_BINARY_RHS:
> >           {
> > -           agg_value->pass_through.operand = rhs2;
> > -           stmt = rhs1_stmt;
> > -         }
> > -       else if (is_gimple_ip_invariant (rhs1))
> > -         {
> > -           if (TREE_CODE_CLASS (code) == tcc_comparison)
> > -             code = swap_tree_comparison (code);
> > -           else if (!commutative_tree_code (code))
> > +           gimple *rhs1_stmt = stmt;
> > +           gimple *rhs2_stmt = stmt;
> > +           tree rhs2 = gimple_assign_rhs2 (stmt);
> > +
> > +           rhs1 = get_ssa_def_if_simple_copy (rhs1, &rhs1_stmt);
> > +           rhs2 = get_ssa_def_if_simple_copy (rhs2, &rhs2_stmt);
> > +
> > +           if (is_gimple_ip_invariant (rhs2))
> > +             {
> > +               agg_value->pass_through.operand = rhs2;
> > +               stmt = rhs1_stmt;
> > +             }
> > +           else if (is_gimple_ip_invariant (rhs1))
> > +             {
> > +               if (TREE_CODE_CLASS (code) == tcc_comparison)
> > +                 code = swap_tree_comparison (code);
> > +               else if (!commutative_tree_code (code))
> > +                 return;
> > +
> > +               agg_value->pass_through.operand = rhs1;
> > +               stmt = rhs2_stmt;
> > +               rhs1 = rhs2;
> > +             }
> > +           else
> >               return;
> >
> > -           agg_value->pass_through.operand = rhs1;
> > -           stmt = rhs2_stmt;
> > -           rhs1 = rhs2;
> > +           if (TREE_CODE_CLASS (code) != tcc_comparison
> > +               && !useless_type_conversion_p (TREE_TYPE (lhs),
> > +                                              TREE_TYPE (rhs1)))
> > +             return;
> >           }
> > -       else
> > -         return;
> > +         break;
> >
> > -       if (TREE_CODE_CLASS (code) != tcc_comparison
> > -           && !useless_type_conversion_p (TREE_TYPE (lhs), TREE_TYPE (rhs1)))
> > +       default:
> >           return;
> > -      }
> > -      break;
> > -
> > -    default:
> > -      return;
> > -  }
> > +       }
> > +    }
> > +  else
> > +    return;
> >
> >    if (TREE_CODE (rhs1) != SSA_NAME)
> >      index = load_from_unmodified_param_or_agg (fbi, fbi->info, stmt,
> > diff --git a/gcc/ipa-prop.h b/gcc/ipa-prop.h
> > index 168c4c26443..a96dac85962 100644
> > --- a/gcc/ipa-prop.h
> > +++ b/gcc/ipa-prop.h
> > @@ -94,9 +94,14 @@ struct GTY(()) ipa_pass_through_data
> >    /* Number of the caller's formal parameter being passed.  */
> >    int formal_id;
> >    /* Operation that is performed on the argument before it is passed on.
> > -     NOP_EXPR means no operation.  Otherwise oper must be a simple binary
> > -     arithmetic operation where the caller's parameter is the first operand and
> > -     operand field from this structure is the second one.  */
> > +     Special values which have other meaning than in normal contexts:
> > +       - NOP_EXPR means no operation, not even type conversion.
> > +       - ASSERT_EXPR means that only the value in operand is allowed to pass
> > +         through (without any change), for all other values the result is
> > +         unknown.
> > +     Otherwise operation must be a simple binary or unary arithmetic operation
> > +     where the caller's parameter is the first operand and (for binary
> > +     operations) the operand field from this structure is the second one.  */
> >    enum tree_code operation;
> >    /* When the passed value is a pointer, it is set to true only when we are
> >       certain that no write to the object it points to has occurred since the
> > diff --git a/gcc/testsuite/gfortran.dg/ipcp-array-2.f90 b/gcc/testsuite/gfortran.dg/ipcp-array-2.f90
> > new file mode 100644
> > index 00000000000..9af8fffa7ea
> > --- /dev/null
> > +++ b/gcc/testsuite/gfortran.dg/ipcp-array-2.f90
> > @@ -0,0 +1,45 @@
> > +! { dg-do compile }
> > +! { dg-options "-O3 -fno-inline -fwhole-program -fdump-ipa-cp-details -fdump-tree-lversion-details" }
> > +
> > +module x
> > +  implicit none
> > +contains
> > +  subroutine foo(a, b)
> > +    real :: a(:,:)
> > +    real :: b
> > +    integer :: i,j
> > +    b = 0.
> > +    do j=1,size(a,2)
> > +       do i=1,size(a,1)
> > +          b = b + a(i,j) * i * j
> > +       end do
> > +    end do
> > +  end subroutine foo
> > +
> > +  subroutine bar(a, b)
> > +    real :: a(:,:)
> > +    real :: b
> > +    call foo (a,b)
> > +  end subroutine bar
> > +
> > +end module x
> > +
> > +program main
> > +  use x
> > +  implicit none
> > +  integer :: n, m
> > +  real, dimension(4,3) :: a
> > +  real, dimension(3,4) :: c
> > +  real :: b
> > +  call random_number(a)
> > +  call bar(a,b)
> > +  print *,b
> > +
> > +  call random_number(c)
> > +  call bar(c,b)
> > +  print *,b
> > +
> > +end program main
> > +
> > +! { dg-final { scan-ipa-dump "op assert_expr 1" "cp" } }
> > +! { dg-final { scan-tree-dump-not "versioned this loop for when certain strides are 1" "lversion" } }
> > --
> > 2.26.2
> >

Hi,

On Mon, Jun 15 2020, Jan Hubicka wrote:
>> On Fri, Jun 12, 2020 at 11:28 PM Martin Jambor <mjambor@suse.cz> wrote:
>> >
>> > Hi,
>> >
>> > when Fortran functions pass array descriptors they receive as a
>> > parameter to another function, they actually rebuild it.  Thanks to
>> > work done mainly by Feng, IPA-CP can already handle the cases when
>> > they pass directly the values loaded from the original descriptor.
>> > Unfortunately, perhaps the most important one, stride, is first
>> > checked against zero and is replaced with one in that case:
>> >
>> >   _12 = *a_11(D).dim[0].stride;
>> >   if (_12 != 0)
>> >     goto <bb 4>; [50.00%]
>> >   else
>> >     goto <bb 3>; [50.00%]
>> >
>> >   <bb 3>
>> >     // empty BB
>> >   <bb 4>
>> >   # iftmp.22_9 = PHI <_12(2), 1(3)>
>> >    ...
>> >    parm.6.dim[0].stride = iftmp.22_9;
>> >    ...
>> >    __x_MOD_foo (&parm.6, b_31(D));
>> >
>> > in the most important and hopefully common cases, the incoming value
>> > is already 1 and we fail to propagate it.
>> >
>> > I would therefore like to propose the following way of encoding this
>> > situation in pass-through jump functions using using ASSERTT_EXPR
>> > operation code meaning that if the incoming value is the same as the
>> > "operand" in the jump function, it is passed on, otherwise the result
>> > is unknown.  This of course captures only the single (but most
>> > important) case but is an improvement and does not need enlarging the
>> > jump function structure and is simple to pattern match.  Encoding that
>> > zero needs to be changed to one would need another field and matching
>> > it would be slightly more complicated too.
>> >
>> > Bootstrapped and tested on x86_64-linux, LTO bootstrap is underway.  OK
>> > if it passes?
>> 
>> Looks reasonable - I wonder if we somehow track enough info to
>> infer the _12 != 0 check in IPA propagation?  So whether there's the
>> possibility to not use "conditional 1" as I understand you do but
>> "conditional *a_11(D).dim[0].stride"?  Because AFAICS you
>> compare _12 against 1 in IPA propagation to enable the propagation,
>> why not compare it against 0?  Or even allow all cases to be resolved
>> if _12 is a constant?  That is, propagate a "_12 != 0 ? 12 : 1" jump
>> function which you should be able to resolve in the exact same
>> way via values_equal_for_ipa_cp_p?

It can of course be pattern matched.  Then I can invent another special
meaning for another _EXPR operation or perhaps start encoding these
special operations a bit more sanely.

>
> I was wondering, since we can now represent more complex arithmetic
> operations, if we can express param0 + (param0 != 0) using the jump
> function w/o use of assert exprs?

...I don't quite understand what you think has changed recently, we
still can only represent one arithmetic operation in pass-through jump
functions.  They still have one tree_code for the operation and one tree
for the second operand of the operation, but into that one tree I can
put something like

  (cond-expr (error_node != 0 ) error-node 1)

or anything arbitrarily complex, and when evaluating it, make a copy,
replace all error_nodes with the constant and attempt to fold it.  But
probably you meant something else?

>
> In general assert exprs seems like good concept to represent conditional
> jumps though.

OK then, I'll try to extend the matcher to also take the condition into
account (for simple situation like these) and use the assert expr only
when it fails.

Thanks,

Martin

>> >
>> >
>> > 2020-06-12  Martin Jambor  <mjambor@suse.cz>
>> >
>> >         * ipa-prop.h (ipa_pass_through_data): Expand comment describing
>> >         operation.
>> >         * ipa-prop.c (analyze_agg_content_value): Detect new special case and
>> >         encode it as ASSERT_EXPR.
>> >         * ipa-cp.c (values_equal_for_ipcp_p): Move before
>> >         ipa_get_jf_arith_result.
>> >         (ipa_get_jf_arith_result): Special case ASSERT_EXPR.
>> >
>> >         testsuite/
>> >         * gfortran.dg/ipcp-array-2.f90: New test.

On 6/12/20 3:25 PM, Martin Jambor wrote:
> Hi,
>
> when Fortran functions pass array descriptors they receive as a
> parameter to another function, they actually rebuild it.  Thanks to
> work done mainly by Feng, IPA-CP can already handle the cases when
> they pass directly the values loaded from the original descriptor.
> Unfortunately, perhaps the most important one, stride, is first
> checked against zero and is replaced with one in that case:
>
>   _12 = *a_11(D).dim[0].stride;
>   if (_12 != 0)
>     goto <bb 4>; [50.00%]
>   else
>     goto <bb 3>; [50.00%]
>
>   <bb 3>
>     // empty BB
>   <bb 4>
>   # iftmp.22_9 = PHI <_12(2), 1(3)>
>    ...
>    parm.6.dim[0].stride = iftmp.22_9;
>    ...
>    __x_MOD_foo (&parm.6, b_31(D));
>
> in the most important and hopefully common cases, the incoming value
> is already 1 and we fail to propagate it.
>
> I would therefore like to propose the following way of encoding this
> situation in pass-through jump functions using using ASSERTT_EXPR
> operation code meaning that if the incoming value is the same as the
> "operand" in the jump function, it is passed on, otherwise the result
> is unknown.  This of course captures only the single (but most
> important) case but is an improvement and does not need enlarging the
> jump function structure and is simple to pattern match.  Encoding that
> zero needs to be changed to one would need another field and matching
> it would be slightly more complicated too.
>
> Bootstrapped and tested on x86_64-linux, LTO bootstrap is underway.  OK
> if it passes?
>
> Thanks,
>
> Martin
>
>
> 2020-06-12  Martin Jambor  <mjambor@suse.cz>
>
> 	* ipa-prop.h (ipa_pass_through_data): Expand comment describing
> 	operation.
> 	* ipa-prop.c (analyze_agg_content_value): Detect new special case and
> 	encode it as ASSERT_EXPR.
> 	* ipa-cp.c (values_equal_for_ipcp_p): Move before
> 	ipa_get_jf_arith_result.
> 	(ipa_get_jf_arith_result): Special case ASSERT_EXPR.
>
> 	testsuite/
> 	* gfortran.dg/ipcp-array-2.f90: New test.
I don't see any feedback on this (old) patch.

It's not obvious from the patch, but I get the impression that the
ASSERT_EXPR isn't actually added to the IL, but instead just gets
stuffed into the agg_value structure.  Can you confirm one way or the
other.  If it ends up in the IL then we need to make sure it doesn't
escape the pass.

Assuming we don't ultimately extract the info from the agg_value
structure and add it to the IL, I don't have any significant concerns
about this patch.  Do you want to re-test it and include it in gcc-11?

jeff

Hi Jeff,

On Fri, Nov 20 2020, Jeff Law wrote:
> On 6/12/20 3:25 PM, Martin Jambor wrote:
>>
[...]
>>
>> 2020-06-12  Martin Jambor  <mjambor@suse.cz>
>>
>> 	* ipa-prop.h (ipa_pass_through_data): Expand comment describing
>> 	operation.
>> 	* ipa-prop.c (analyze_agg_content_value): Detect new special case and
>> 	encode it as ASSERT_EXPR.
>> 	* ipa-cp.c (values_equal_for_ipcp_p): Move before
>> 	ipa_get_jf_arith_result.
>> 	(ipa_get_jf_arith_result): Special case ASSERT_EXPR.
>>
>> 	testsuite/
>> 	* gfortran.dg/ipcp-array-2.f90: New test.
> I don't see any feedback on this (old) patch.
>
> It's not obvious from the patch, but I get the impression that the
> ASSERT_EXPR isn't actually added to the IL, but instead just gets
> stuffed into the agg_value structure.  Can you confirm one way or the
> other.  If it ends up in the IL then we need to make sure it doesn't
> escape the pass.
>
> Assuming we don't ultimately extract the info from the agg_value
> structure and add it to the IL, I don't have any significant concerns
> about this patch.  Do you want to re-test it and include it in gcc-11?
>

thank you very much for reminding me, I would have probably forgotten
about it.  I was experimenting a little with emulating this by adding
chains of operations to jump functions like ipa predicates have, but I
do not have anything ready for GCC 11 so at least for now I have
re-bootstrapped and re-tested the patch from June and committed it as
f38a33a2745.

Thanks again,

Martin


For reference, the committed patch is the following:

when Fortran functions pass array descriptors they receive as a
parameter to another function, they actually rebuild it.  Thanks to
work done mainly by Feng, IPA-CP can already handle the cases when
they pass directly the values loaded from the original descriptor.
Unfortunately, perhaps the most important one, stride, is first
checked against zero and is replaced with one in that case:

  _12 = *a_11(D).dim[0].stride;
  if (_12 != 0)
    goto <bb 4>; [50.00%]
  else
    goto <bb 3>; [50.00%]

  <bb 3>
    // empty BB
  <bb 4>
  # iftmp.22_9 = PHI <_12(2), 1(3)>
   ...
   parm.6.dim[0].stride = iftmp.22_9;
   ...
   __x_MOD_foo (&parm.6, b_31(D));

in the most important and hopefully common cases, the incoming value
is already 1 and we fail to propagate it.

I would therefore like to propose the following way of encoding this
situation in pass-through jump functions using using ASSERTT_EXPR
operation code meaning that if the incoming value is the same as the
"operand" in the jump function, it is passed on, otherwise the result
is unknown.  This of course captures only the single (but most
important) case but is an improvement and does not need enlarging the
jump function structure and is simple to pattern match.  Encoding that
zero needs to be changed to one would need another field and matching
it would be slightly more complicated too.

2020-06-12  Martin Jambor  <mjambor@suse.cz>

	* ipa-prop.h (ipa_pass_through_data): Expand comment describing
	operation.
	* ipa-prop.c (analyze_agg_content_value): Detect new special case and
	encode it as ASSERT_EXPR.
	* ipa-cp.c (values_equal_for_ipcp_p): Move before
	ipa_get_jf_arith_result.
	(ipa_get_jf_arith_result): Special case ASSERT_EXPR.

	testsuite/
	* gfortran.dg/ipcp-array-2.f90: New test.
---
 gcc/ipa-cp.c                               |  48 ++++---
 gcc/ipa-prop.c                             | 148 ++++++++++++++-------
 gcc/ipa-prop.h                             |  11 +-
 gcc/testsuite/gfortran.dg/ipcp-array-2.f90 |  45 +++++++
 4 files changed, 179 insertions(+), 73 deletions(-)
 create mode 100644 gcc/testsuite/gfortran.dg/ipcp-array-2.f90

diff --git a/gcc/ipa-cp.c b/gcc/ipa-cp.c
index c3ee71e16e1..a06b4d151dd 100644
--- a/gcc/ipa-cp.c
+++ b/gcc/ipa-cp.c
@@ -1304,6 +1304,26 @@ initialize_node_lattices (struct cgraph_node *node)
       }
 }
 
+/* Return true iff X and Y should be considered equal values by IPA-CP.  */
+
+static bool
+values_equal_for_ipcp_p (tree x, tree y)
+{
+  gcc_checking_assert (x != NULL_TREE && y != NULL_TREE);
+
+  if (x == y)
+    return true;
+
+  if (TREE_CODE (x) == ADDR_EXPR
+      && TREE_CODE (y) == ADDR_EXPR
+      && TREE_CODE (TREE_OPERAND (x, 0)) == CONST_DECL
+      && TREE_CODE (TREE_OPERAND (y, 0)) == CONST_DECL)
+    return operand_equal_p (DECL_INITIAL (TREE_OPERAND (x, 0)),
+			    DECL_INITIAL (TREE_OPERAND (y, 0)), 0);
+  else
+    return operand_equal_p (x, y, 0);
+}
+
 /* Return the result of a (possibly arithmetic) operation on the constant
    value INPUT.  OPERAND is 2nd operand for binary operation.  RES_TYPE is
    the type of the parameter to which the result is passed.  Return
@@ -1321,6 +1341,14 @@ ipa_get_jf_arith_result (enum tree_code opcode, tree input, tree operand,
   if (!is_gimple_ip_invariant (input))
     return NULL_TREE;
 
+  if (opcode == ASSERT_EXPR)
+    {
+      if (values_equal_for_ipcp_p (input, operand))
+	return input;
+      else
+	return NULL_TREE;
+    }
+
   if (!res_type)
     {
       if (TREE_CODE_CLASS (opcode) == tcc_comparison)
@@ -1753,26 +1781,6 @@ ipcp_verify_propagated_values (void)
     }
 }
 
-/* Return true iff X and Y should be considered equal values by IPA-CP.  */
-
-static bool
-values_equal_for_ipcp_p (tree x, tree y)
-{
-  gcc_checking_assert (x != NULL_TREE && y != NULL_TREE);
-
-  if (x == y)
-    return true;
-
-  if (TREE_CODE (x) ==  ADDR_EXPR
-      && TREE_CODE (y) ==  ADDR_EXPR
-      && TREE_CODE (TREE_OPERAND (x, 0)) == CONST_DECL
-      && TREE_CODE (TREE_OPERAND (y, 0)) == CONST_DECL)
-    return operand_equal_p (DECL_INITIAL (TREE_OPERAND (x, 0)),
-			    DECL_INITIAL (TREE_OPERAND (y, 0)), 0);
-  else
-    return operand_equal_p (x, y, 0);
-}
-
 /* Return true iff X and Y should be considered equal contexts by IPA-CP.  */
 
 static bool
diff --git a/gcc/ipa-prop.c b/gcc/ipa-prop.c
index 7a5fa59ecec..d077598cb4b 100644
--- a/gcc/ipa-prop.c
+++ b/gcc/ipa-prop.c
@@ -1775,75 +1775,123 @@ analyze_agg_content_value (struct ipa_func_body_info *fbi,
 
       stmt = SSA_NAME_DEF_STMT (rhs1);
       if (!is_gimple_assign (stmt))
-	return;
+	break;
 
       rhs1 = gimple_assign_rhs1 (stmt);
     }
 
-  code = gimple_assign_rhs_code (stmt);
-  switch (gimple_assign_rhs_class (stmt))
+  if (gphi *phi = dyn_cast<gphi *> (stmt))
     {
-    case GIMPLE_SINGLE_RHS:
-      if (is_gimple_ip_invariant (rhs1))
-	{
-	  agg_value->pass_through.operand = rhs1;
-	  return;
-	}
-      code = NOP_EXPR;
-      break;
+      /* Also special case like the following (a is a formal parameter):
+
+	   _12 = *a_11(D).dim[0].stride;
+	   ...
+	   # iftmp.22_9 = PHI <_12(2), 1(3)>
+	   ...
+	   parm.6.dim[0].stride = iftmp.22_9;
+	   ...
+	   __x_MOD_foo (&parm.6, b_31(D));
 
-    case GIMPLE_UNARY_RHS:
-      /* NOTE: A GIMPLE_UNARY_RHS operation might not be tcc_unary
-	 (truth_not_expr is example), GIMPLE_BINARY_RHS does not imply
-	 tcc_binary, this subtleness is somewhat misleading.
+	 The aggregate function describing parm.6.dim[0].stride is encoded as a
+	 PASS-THROUGH jump function with ASSERT_EXPR operation whith operand 1
+	 (the constant from the PHI node).  */
 
-	 Since tcc_unary is widely used in IPA-CP code to check an operation
-	 with one operand, here we only allow tc_unary operation to avoid
-	 possible problem.  Then we can use (opclass == tc_unary) or not to
-	 distinguish unary and binary.  */
-      if (TREE_CODE_CLASS (code) != tcc_unary || CONVERT_EXPR_CODE_P (code))
+      if (gimple_phi_num_args (phi) != 2)
+	return;
+      tree arg0 = gimple_phi_arg_def (phi, 0);
+      tree arg1 = gimple_phi_arg_def (phi, 1);
+      tree operand;
+
+      if (is_gimple_ip_invariant (arg1))
+	{
+	  operand = arg1;
+	  rhs1 = arg0;
+	}
+      else if (is_gimple_ip_invariant (arg0))
+	{
+	  operand = arg0;
+	  rhs1 = arg1;
+	}
+      else
 	return;
 
       rhs1 = get_ssa_def_if_simple_copy (rhs1, &stmt);
-      break;
+      if (!is_gimple_assign (stmt))
+	return;
 
-    case GIMPLE_BINARY_RHS:
-      {
-	gimple *rhs1_stmt = stmt;
-	gimple *rhs2_stmt = stmt;
-	tree rhs2 = gimple_assign_rhs2 (stmt);
+      code = ASSERT_EXPR;
+      agg_value->pass_through.operand = operand;
+    }
+  else if (is_gimple_assign (stmt))
+    {
+      code = gimple_assign_rhs_code (stmt);
+      switch (gimple_assign_rhs_class (stmt))
+	{
+	case GIMPLE_SINGLE_RHS:
+	  if (is_gimple_ip_invariant (rhs1))
+	    {
+	      agg_value->pass_through.operand = rhs1;
+	      return;
+	    }
+	  code = NOP_EXPR;
+	  break;
 
-	rhs1 = get_ssa_def_if_simple_copy (rhs1, &rhs1_stmt);
-	rhs2 = get_ssa_def_if_simple_copy (rhs2, &rhs2_stmt);
+	case GIMPLE_UNARY_RHS:
+	  /* NOTE: A GIMPLE_UNARY_RHS operation might not be tcc_unary
+	     (truth_not_expr is example), GIMPLE_BINARY_RHS does not imply
+	     tcc_binary, this subtleness is somewhat misleading.
+
+	     Since tcc_unary is widely used in IPA-CP code to check an operation
+	     with one operand, here we only allow tc_unary operation to avoid
+	     possible problem.  Then we can use (opclass == tc_unary) or not to
+	     distinguish unary and binary.  */
+	  if (TREE_CODE_CLASS (code) != tcc_unary || CONVERT_EXPR_CODE_P (code))
+	    return;
 
-	if (is_gimple_ip_invariant (rhs2))
-	  {
-	    agg_value->pass_through.operand = rhs2;
-	    stmt = rhs1_stmt;
-	  }
-	else if (is_gimple_ip_invariant (rhs1))
+	  rhs1 = get_ssa_def_if_simple_copy (rhs1, &stmt);
+	  break;
+
+	case GIMPLE_BINARY_RHS:
 	  {
-	    if (TREE_CODE_CLASS (code) == tcc_comparison)
-	      code = swap_tree_comparison (code);
-	    else if (!commutative_tree_code (code))
+	    gimple *rhs1_stmt = stmt;
+	    gimple *rhs2_stmt = stmt;
+	    tree rhs2 = gimple_assign_rhs2 (stmt);
+
+	    rhs1 = get_ssa_def_if_simple_copy (rhs1, &rhs1_stmt);
+	    rhs2 = get_ssa_def_if_simple_copy (rhs2, &rhs2_stmt);
+
+	    if (is_gimple_ip_invariant (rhs2))
+	      {
+		agg_value->pass_through.operand = rhs2;
+		stmt = rhs1_stmt;
+	      }
+	    else if (is_gimple_ip_invariant (rhs1))
+	      {
+		if (TREE_CODE_CLASS (code) == tcc_comparison)
+		  code = swap_tree_comparison (code);
+		else if (!commutative_tree_code (code))
+		  return;
+
+		agg_value->pass_through.operand = rhs1;
+		stmt = rhs2_stmt;
+		rhs1 = rhs2;
+	      }
+	    else
 	      return;
 
-	    agg_value->pass_through.operand = rhs1;
-	    stmt = rhs2_stmt;
-	    rhs1 = rhs2;
+	    if (TREE_CODE_CLASS (code) != tcc_comparison
+		&& !useless_type_conversion_p (TREE_TYPE (lhs),
+					       TREE_TYPE (rhs1)))
+	      return;
 	  }
-	else
-	  return;
+	  break;
 
-	if (TREE_CODE_CLASS (code) != tcc_comparison
-	    && !useless_type_conversion_p (TREE_TYPE (lhs), TREE_TYPE (rhs1)))
+	default:
 	  return;
-      }
-      break;
-
-    default:
-      return;
-  }
+	}
+    }
+  else
+    return;
 
   if (TREE_CODE (rhs1) != SSA_NAME)
     index = load_from_unmodified_param_or_agg (fbi, fbi->info, stmt,
diff --git a/gcc/ipa-prop.h b/gcc/ipa-prop.h
index 77e92b04bba..59c4261d9b9 100644
--- a/gcc/ipa-prop.h
+++ b/gcc/ipa-prop.h
@@ -94,9 +94,14 @@ struct GTY(()) ipa_pass_through_data
   /* Number of the caller's formal parameter being passed.  */
   int formal_id;
   /* Operation that is performed on the argument before it is passed on.
-     NOP_EXPR means no operation.  Otherwise oper must be a simple binary
-     arithmetic operation where the caller's parameter is the first operand and
-     operand field from this structure is the second one.  */
+     Special values which have other meaning than in normal contexts:
+       - NOP_EXPR means no operation, not even type conversion.
+       - ASSERT_EXPR means that only the value in operand is allowed to pass
+         through (without any change), for all other values the result is
+         unknown.
+     Otherwise operation must be a simple binary or unary arithmetic operation
+     where the caller's parameter is the first operand and (for binary
+     operations) the operand field from this structure is the second one.  */
   enum tree_code operation;
   /* When the passed value is a pointer, it is set to true only when we are
      certain that no write to the object it points to has occurred since the
diff --git a/gcc/testsuite/gfortran.dg/ipcp-array-2.f90 b/gcc/testsuite/gfortran.dg/ipcp-array-2.f90
new file mode 100644
index 00000000000..9af8fffa7ea
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/ipcp-array-2.f90
@@ -0,0 +1,45 @@
+! { dg-do compile }
+! { dg-options "-O3 -fno-inline -fwhole-program -fdump-ipa-cp-details -fdump-tree-lversion-details" }
+
+module x
+  implicit none
+contains
+  subroutine foo(a, b)
+    real :: a(:,:)
+    real :: b
+    integer :: i,j
+    b = 0.
+    do j=1,size(a,2)
+       do i=1,size(a,1)
+          b = b + a(i,j) * i * j
+       end do
+    end do
+  end subroutine foo
+
+  subroutine bar(a, b)
+    real :: a(:,:)
+    real :: b
+    call foo (a,b)
+  end subroutine bar
+
+end module x
+
+program main
+  use x
+  implicit none
+  integer :: n, m
+  real, dimension(4,3) :: a
+  real, dimension(3,4) :: c     
+  real :: b
+  call random_number(a)
+  call bar(a,b)
+  print *,b
+  
+  call random_number(c)
+  call bar(c,b)
+  print *,b
+  
+end program main
+
+! { dg-final { scan-ipa-dump "op assert_expr 1" "cp" } }
+! { dg-final { scan-tree-dump-not "versioned this loop for when certain strides are 1" "lversion" } }