re PR fortran/45159 (Unnecessary temporaries)
2013-03-28 Thomas Koenig <tkoenig@gcc.gnu.org> PR fortran/45159 * gfortran.h (gfc_dep_difference): Add prototype. * dependency.c (discard_nops): New function. (gfc_dep_difference): New function. (check_section_vs_section): Use gfc_dep_difference to calculate the difference of starting indices. * trans-expr.c (gfc_conv_substring): Use gfc_dep_difference to calculate the length of substrings where possible. 2013-03-28 Thomas Koenig <tkoenig@gcc.gnu.org> PR fortran/45159 * gfortran.dg/string_length_2.f90: New test. * gfortran.dg/dependency_41.f90: New test. From-SVN: r197217
This commit is contained in:
Thomas Koenig
parent
4099436d98
commit
eab19a1a95
|
|
@ -1,3 +1,15 @@
|
|||
2013-03-28 Thomas Koenig <tkoenig@gcc.gnu.org>
|
||||
|
||||
PR fortran/45159
|
||||
* gfortran.h (gfc_dep_difference): Add prototype.
|
||||
* dependency.c (discard_nops): New function.
|
||||
(gfc_dep_difference): New function.
|
||||
(check_section_vs_section): Use gfc_dep_difference
|
||||
to calculate the difference of starting indices.
|
||||
* trans-expr.c (gfc_conv_substring): Use
|
||||
gfc_dep_difference to calculate the length of
|
||||
substrings where possible.
|
||||
|
||||
2013-03-28 Thomas Koenig <tkoenig@gcc.gnu.org>
|
||||
|
||||
PR fortran/55806
|
||||
|
|
|
|||
|
|
@ -501,6 +501,272 @@ gfc_dep_compare_expr (gfc_expr *e1, gfc_expr *e2)
|
|||
}
|
||||
|
||||
|
||||
/* Helper function to look through parens and unary plus. */
|
||||
|
||||
static gfc_expr*
|
||||
discard_nops (gfc_expr *e)
|
||||
{
|
||||
|
||||
while (e && e->expr_type == EXPR_OP
|
||||
&& (e->value.op.op == INTRINSIC_UPLUS
|
||||
|| e->value.op.op == INTRINSIC_PARENTHESES))
|
||||
e = e->value.op.op1;
|
||||
|
||||
return e;
|
||||
}
|
||||
|
||||
|
||||
/* Return the difference between two expressions. Integer expressions of
|
||||
the form
|
||||
|
||||
X + constant, X - constant and constant + X
|
||||
|
||||
are handled. Return true on success, false on failure. result is assumed
|
||||
to be uninitialized on entry, and will be initialized on success.
|
||||
*/
|
||||
|
||||
bool
|
||||
gfc_dep_difference (gfc_expr *e1, gfc_expr *e2, mpz_t *result)
|
||||
{
|
||||
gfc_expr *e1_op1, *e1_op2, *e2_op1, *e2_op2;
|
||||
|
||||
if (e1 == NULL || e2 == NULL)
|
||||
return false;
|
||||
|
||||
if (e1->ts.type != BT_INTEGER || e2->ts.type != BT_INTEGER)
|
||||
return false;
|
||||
|
||||
e1 = discard_nops (e1);
|
||||
e2 = discard_nops (e2);
|
||||
|
||||
/* Inizialize tentatively, clear if we don't return anything. */
|
||||
mpz_init (*result);
|
||||
|
||||
/* Case 1: c1 - c2 = c1 - c2, trivially. */
|
||||
|
||||
if (e1->expr_type == EXPR_CONSTANT && e2->expr_type == EXPR_CONSTANT)
|
||||
{
|
||||
mpz_sub (*result, e1->value.integer, e2->value.integer);
|
||||
return true;
|
||||
}
|
||||
|
||||
if (e1->expr_type == EXPR_OP && e1->value.op.op == INTRINSIC_PLUS)
|
||||
{
|
||||
e1_op1 = discard_nops (e1->value.op.op1);
|
||||
e1_op2 = discard_nops (e1->value.op.op2);
|
||||
|
||||
/* Case 2: (X + c1) - X = c1. */
|
||||
if (e1_op2->expr_type == EXPR_CONSTANT
|
||||
&& gfc_dep_compare_expr (e1_op1, e2) == 0)
|
||||
{
|
||||
mpz_set (*result, e1_op2->value.integer);
|
||||
return true;
|
||||
}
|
||||
|
||||
/* Case 3: (c1 + X) - X = c1. */
|
||||
if (e1_op1->expr_type == EXPR_CONSTANT
|
||||
&& gfc_dep_compare_expr (e1_op2, e2) == 0)
|
||||
{
|
||||
mpz_set (*result, e1_op1->value.integer);
|
||||
return true;
|
||||
}
|
||||
|
||||
if (e2->expr_type == EXPR_OP && e2->value.op.op == INTRINSIC_PLUS)
|
||||
{
|
||||
e2_op1 = discard_nops (e2->value.op.op1);
|
||||
e2_op2 = discard_nops (e2->value.op.op2);
|
||||
|
||||
if (e1_op2->expr_type == EXPR_CONSTANT)
|
||||
{
|
||||
/* Case 4: X + c1 - (X + c2) = c1 - c2. */
|
||||
if (e2_op2->expr_type == EXPR_CONSTANT
|
||||
&& gfc_dep_compare_expr (e1_op1, e2_op1) == 0)
|
||||
{
|
||||
mpz_sub (*result, e1_op2->value.integer,
|
||||
e2_op2->value.integer);
|
||||
return true;
|
||||
}
|
||||
/* Case 5: X + c1 - (c2 + X) = c1 - c2. */
|
||||
if (e2_op1->expr_type == EXPR_CONSTANT
|
||||
&& gfc_dep_compare_expr (e1_op1, e2_op2) == 0)
|
||||
{
|
||||
mpz_sub (*result, e1_op2->value.integer,
|
||||
e2_op1->value.integer);
|
||||
return true;
|
||||
}
|
||||
}
|
||||
else if (e1_op1->expr_type == EXPR_CONSTANT)
|
||||
{
|
||||
/* Case 6: c1 + X - (X + c2) = c1 - c2. */
|
||||
if (e2_op2->expr_type == EXPR_CONSTANT
|
||||
&& gfc_dep_compare_expr (e1_op2, e2_op1) == 0)
|
||||
{
|
||||
mpz_sub (*result, e1_op1->value.integer,
|
||||
e2_op2->value.integer);
|
||||
return true;
|
||||
}
|
||||
/* Case 7: c1 + X - (c2 + X) = c1 - c2. */
|
||||
if (e2_op1->expr_type == EXPR_CONSTANT
|
||||
&& gfc_dep_compare_expr (e1_op2, e2_op2) == 0)
|
||||
{
|
||||
mpz_sub (*result, e1_op1->value.integer,
|
||||
e2_op1->value.integer);
|
||||
return true;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
if (e2->expr_type == EXPR_OP && e2->value.op.op == INTRINSIC_MINUS)
|
||||
{
|
||||
e2_op1 = discard_nops (e2->value.op.op1);
|
||||
e2_op2 = discard_nops (e2->value.op.op2);
|
||||
|
||||
if (e1_op2->expr_type == EXPR_CONSTANT)
|
||||
{
|
||||
/* Case 8: X + c1 - (X - c2) = c1 + c2. */
|
||||
if (e2_op2->expr_type == EXPR_CONSTANT
|
||||
&& gfc_dep_compare_expr (e1_op1, e2_op1) == 0)
|
||||
{
|
||||
mpz_add (*result, e1_op2->value.integer,
|
||||
e2_op2->value.integer);
|
||||
return true;
|
||||
}
|
||||
}
|
||||
if (e1_op1->expr_type == EXPR_CONSTANT)
|
||||
{
|
||||
/* Case 9: c1 + X - (X - c2) = c1 + c2. */
|
||||
if (e2_op2->expr_type == EXPR_CONSTANT
|
||||
&& gfc_dep_compare_expr (e1_op2, e2_op1) == 0)
|
||||
{
|
||||
mpz_add (*result, e1_op1->value.integer,
|
||||
e2_op2->value.integer);
|
||||
return true;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
if (e1->expr_type == EXPR_OP && e1->value.op.op == INTRINSIC_MINUS)
|
||||
{
|
||||
e1_op1 = discard_nops (e1->value.op.op1);
|
||||
e1_op2 = discard_nops (e1->value.op.op2);
|
||||
|
||||
if (e1_op2->expr_type == EXPR_CONSTANT)
|
||||
{
|
||||
/* Case 10: (X - c1) - X = -c1 */
|
||||
|
||||
if (gfc_dep_compare_expr (e1_op1, e2) == 0)
|
||||
{
|
||||
mpz_neg (*result, e1_op2->value.integer);
|
||||
return true;
|
||||
}
|
||||
|
||||
if (e2->expr_type == EXPR_OP && e2->value.op.op == INTRINSIC_PLUS)
|
||||
{
|
||||
e2_op1 = discard_nops (e2->value.op.op1);
|
||||
e2_op2 = discard_nops (e2->value.op.op2);
|
||||
|
||||
/* Case 11: (X - c1) - (X + c2) = -( c1 + c2). */
|
||||
if (e2_op2->expr_type == EXPR_CONSTANT
|
||||
&& gfc_dep_compare_expr (e1_op1, e2_op1) == 0)
|
||||
{
|
||||
mpz_add (*result, e1_op2->value.integer,
|
||||
e2_op2->value.integer);
|
||||
mpz_neg (*result, *result);
|
||||
return true;
|
||||
}
|
||||
|
||||
/* Case 12: X - c1 - (c2 + X) = - (c1 + c2). */
|
||||
if (e2_op1->expr_type == EXPR_CONSTANT
|
||||
&& gfc_dep_compare_expr (e1_op1, e2_op2) == 0)
|
||||
{
|
||||
mpz_add (*result, e1_op2->value.integer,
|
||||
e2_op1->value.integer);
|
||||
mpz_neg (*result, *result);
|
||||
return true;
|
||||
}
|
||||
}
|
||||
|
||||
if (e2->expr_type == EXPR_OP && e2->value.op.op == INTRINSIC_MINUS)
|
||||
{
|
||||
e2_op1 = discard_nops (e2->value.op.op1);
|
||||
e2_op2 = discard_nops (e2->value.op.op2);
|
||||
|
||||
/* Case 13: (X - c1) - (X - c2) = c2 - c1. */
|
||||
if (e2_op2->expr_type == EXPR_CONSTANT
|
||||
&& gfc_dep_compare_expr (e1_op1, e2_op1) == 0)
|
||||
{
|
||||
mpz_sub (*result, e2_op2->value.integer,
|
||||
e1_op2->value.integer);
|
||||
return true;
|
||||
}
|
||||
}
|
||||
}
|
||||
if (e1_op1->expr_type == EXPR_CONSTANT)
|
||||
{
|
||||
if (e2->expr_type == EXPR_OP && e2->value.op.op == INTRINSIC_MINUS)
|
||||
{
|
||||
e2_op1 = discard_nops (e2->value.op.op1);
|
||||
e2_op2 = discard_nops (e2->value.op.op2);
|
||||
|
||||
/* Case 14: (c1 - X) - (c2 - X) == c1 - c2. */
|
||||
if (gfc_dep_compare_expr (e1_op2, e2_op2) == 0)
|
||||
{
|
||||
mpz_sub (*result, e1_op1->value.integer,
|
||||
e2_op1->value.integer);
|
||||
return true;
|
||||
}
|
||||
}
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
if (e2->expr_type == EXPR_OP && e2->value.op.op == INTRINSIC_PLUS)
|
||||
{
|
||||
e2_op1 = discard_nops (e2->value.op.op1);
|
||||
e2_op2 = discard_nops (e2->value.op.op2);
|
||||
|
||||
/* Case 15: X - (X + c2) = -c2. */
|
||||
if (e2_op2->expr_type == EXPR_CONSTANT
|
||||
&& gfc_dep_compare_expr (e1, e2_op1) == 0)
|
||||
{
|
||||
mpz_neg (*result, e2_op2->value.integer);
|
||||
return true;
|
||||
}
|
||||
/* Case 16: X - (c2 + X) = -c2. */
|
||||
if (e2_op1->expr_type == EXPR_CONSTANT
|
||||
&& gfc_dep_compare_expr (e1, e2_op2) == 0)
|
||||
{
|
||||
mpz_neg (*result, e2_op1->value.integer);
|
||||
return true;
|
||||
}
|
||||
}
|
||||
|
||||
if (e2->expr_type == EXPR_OP && e2->value.op.op == INTRINSIC_MINUS)
|
||||
{
|
||||
e2_op1 = discard_nops (e2->value.op.op1);
|
||||
e2_op2 = discard_nops (e2->value.op.op2);
|
||||
|
||||
/* Case 17: X - (X - c2) = c2. */
|
||||
if (e2_op2->expr_type == EXPR_CONSTANT
|
||||
&& gfc_dep_compare_expr (e1, e2_op1) == 0)
|
||||
{
|
||||
mpz_set (*result, e2_op2->value.integer);
|
||||
return true;
|
||||
}
|
||||
}
|
||||
|
||||
if (gfc_dep_compare_expr(e1, e2) == 0)
|
||||
{
|
||||
/* Case 18: X - X = 0. */
|
||||
mpz_set_si (*result, 0);
|
||||
return true;
|
||||
}
|
||||
|
||||
mpz_clear (*result);
|
||||
return false;
|
||||
}
|
||||
|
||||
/* Returns 1 if the two ranges are the same and 0 if they are not (or if the
|
||||
results are indeterminate). 'n' is the dimension to compare. */
|
||||
|
||||
|
|
@ -1140,6 +1406,7 @@ check_section_vs_section (gfc_array_ref *l_ar, gfc_array_ref *r_ar, int n)
|
|||
int r_dir;
|
||||
int stride_comparison;
|
||||
int start_comparison;
|
||||
mpz_t tmp;
|
||||
|
||||
/* If they are the same range, return without more ado. */
|
||||
if (is_same_range (l_ar, r_ar, n))
|
||||
|
|
@ -1275,24 +1542,20 @@ check_section_vs_section (gfc_array_ref *l_ar, gfc_array_ref *r_ar, int n)
|
|||
(l_start - r_start) / gcd(l_stride, r_stride) is
|
||||
nonzero.
|
||||
TODO:
|
||||
- Handle cases where x is an expression.
|
||||
- Cases like a(1:4:2) = a(2:3) are still not handled.
|
||||
*/
|
||||
|
||||
#define IS_CONSTANT_INTEGER(a) ((a) && ((a)->expr_type == EXPR_CONSTANT) \
|
||||
&& (a)->ts.type == BT_INTEGER)
|
||||
|
||||
if (IS_CONSTANT_INTEGER(l_start) && IS_CONSTANT_INTEGER(r_start)
|
||||
&& IS_CONSTANT_INTEGER(l_stride) && IS_CONSTANT_INTEGER(r_stride))
|
||||
if (IS_CONSTANT_INTEGER(l_stride) && IS_CONSTANT_INTEGER(r_stride)
|
||||
&& gfc_dep_difference (l_start, r_start, &tmp))
|
||||
{
|
||||
mpz_t gcd, tmp;
|
||||
mpz_t gcd;
|
||||
int result;
|
||||
|
||||
mpz_init (gcd);
|
||||
mpz_init (tmp);
|
||||
|
||||
mpz_gcd (gcd, l_stride->value.integer, r_stride->value.integer);
|
||||
mpz_sub (tmp, l_start->value.integer, r_start->value.integer);
|
||||
|
||||
mpz_fdiv_r (tmp, tmp, gcd);
|
||||
result = mpz_cmp_si (tmp, 0L);
|
||||
|
|
|
|||
|
|
@ -2969,6 +2969,7 @@ gfc_namespace* gfc_build_block_ns (gfc_namespace *);
|
|||
/* dependency.c */
|
||||
int gfc_dep_compare_functions (gfc_expr *, gfc_expr *, bool);
|
||||
int gfc_dep_compare_expr (gfc_expr *, gfc_expr *);
|
||||
bool gfc_dep_difference (gfc_expr *, gfc_expr *, mpz_t *);
|
||||
|
||||
/* check.c */
|
||||
gfc_try gfc_check_same_strlen (const gfc_expr*, const gfc_expr*, const char*);
|
||||
|
|
|
|||
|
|
@ -1437,6 +1437,7 @@ gfc_conv_substring (gfc_se * se, gfc_ref * ref, int kind,
|
|||
gfc_se start;
|
||||
gfc_se end;
|
||||
char *msg;
|
||||
mpz_t length;
|
||||
|
||||
type = gfc_get_character_type (kind, ref->u.ss.length);
|
||||
type = build_pointer_type (type);
|
||||
|
|
@ -1520,10 +1521,19 @@ gfc_conv_substring (gfc_se * se, gfc_ref * ref, int kind,
|
|||
free (msg);
|
||||
}
|
||||
|
||||
/* If the start and end expressions are equal, the length is one. */
|
||||
/* Try to calculate the length from the start and end expressions. */
|
||||
if (ref->u.ss.end
|
||||
&& gfc_dep_compare_expr (ref->u.ss.start, ref->u.ss.end) == 0)
|
||||
tmp = build_int_cst (gfc_charlen_type_node, 1);
|
||||
&& gfc_dep_difference (ref->u.ss.end, ref->u.ss.start, &length))
|
||||
{
|
||||
int i_len;
|
||||
|
||||
i_len = mpz_get_si (length) + 1;
|
||||
if (i_len < 0)
|
||||
i_len = 0;
|
||||
|
||||
tmp = build_int_cst (gfc_charlen_type_node, i_len);
|
||||
mpz_clear (length); /* Was initialized by gfc_dep_difference. */
|
||||
}
|
||||
else
|
||||
{
|
||||
tmp = fold_build2_loc (input_location, MINUS_EXPR, gfc_charlen_type_node,
|
||||
|
|
|
|||
|
|
@ -1,3 +1,9 @@
|
|||
2013-03-28 Thomas Koenig <tkoenig@gcc.gnu.org>
|
||||
|
||||
PR fortran/45159
|
||||
* gfortran.dg/string_length_2.f90: New test.
|
||||
* gfortran.dg/dependency_41.f90: New test.
|
||||
|
||||
2013-03-28 Thomas Koenig <tkoenig@gcc.gnu.org>
|
||||
|
||||
PR fortran/55806
|
||||
|
|
|
|||
|
|
@ -0,0 +1,19 @@
|
|||
! { dg-do run }
|
||||
! { dg-options "-Warray-temporaries" }
|
||||
! No temporary should be generated in this case.
|
||||
program main
|
||||
implicit none
|
||||
integer :: i,n
|
||||
integer :: a(10)
|
||||
integer :: b(10)
|
||||
do i=1,10
|
||||
a(i) = i
|
||||
b(i) = i
|
||||
end do
|
||||
n = 1
|
||||
! Same result when assigning to a or b
|
||||
b(n+1:10:4) = a(n+2:8:2)
|
||||
a(n+1:10:4) = a(n+2:8:2)
|
||||
if (any (a/=b)) call abort
|
||||
end program main
|
||||
|
||||
|
|
@ -0,0 +1,32 @@
|
|||
! { dg-run }
|
||||
! { dg-options "-fdump-tree-original" }
|
||||
! Test that all string length calculations are
|
||||
! optimized away.
|
||||
program main
|
||||
character (len=999) :: c
|
||||
character (len=5) :: unit
|
||||
unit = ' '
|
||||
read (unit=unit,fmt='(I5)') i ! Hide from optimizers
|
||||
j = 7
|
||||
c = '123456789'
|
||||
if (len(c( 3 : 5 )) /= 3) call abort ! Case 1
|
||||
if (len(c( i*(i+1) : (i+1)*i + 2 )) /= 3) call abort ! Case 2
|
||||
if (len(c( i*(i+1) : 2 + (i+1)*i )) /= 3) call abort ! Case 3
|
||||
if (len(c( i*(i+1) + 2 : (i+1)*i + 3 )) /= 2) call abort ! Case 4
|
||||
if (len(c( 2 + i*(i+1) : (i+1)*i + 3 )) /= 2) call abort ! Case 5
|
||||
if (len(c( i*(i+1) + 2 : 3 + (i+1)*i )) /= 2) call abort ! Case 6
|
||||
if (len(c( 2 + i*(i+1) : 3 + (i+1)*i )) /= 2) call abort ! Case 7
|
||||
if (len(c( i*(i+1) - 1 : (i+1)*i + 1 )) /= 3) call abort ! Case 8
|
||||
if (len(c( i*(i+1) - 1 : 1 + (i+1)*i )) /= 3) call abort ! Case 9
|
||||
if (len(c( i*(i+1) : (i+1)*i -(-1))) /= 2) call abort ! Case 10
|
||||
if (len(c( i*(i+1) +(-2): (i+1)*i - 1 )) /= 2) call abort ! Case 11
|
||||
if (len(c( i*(i+1) + 2 : (i+1)*i -(-4))) /= 3) call abort ! Case 12
|
||||
if (len(c( i*(i+1) - 3 : (i+1)*i - 1 )) /= 3) call abort ! Case 13
|
||||
if (len(c(13 - i*(i+1) :15 - (i+1)*i )) /= 3) call abort ! Case 14
|
||||
if (len(c( i*(i+1) +(-1): (i+1)*i )) /= 2) call abort ! Case 15
|
||||
if (len(c(-1 + i*(i+1) : (i+1)*i )) /= 2) call abort ! Case 16
|
||||
if (len(c( i*(i+1) - 2 : (i+1)*i )) /= 3) call abort ! Case 17
|
||||
if (len(c( (i-2)*(i-3) : (i-3)*(i-2) )) /= 1) call abort ! Case 18
|
||||
end program main
|
||||
! { dg-final { scan-tree-dump-times "_abort" 0 "original" } }
|
||||
! { dg-final { cleanup-tree-dump "original" } }
|
||||
Loading…
Reference in New Issue