[PATCH 2/2] Optimize fortran loops with +-1 step.
marxin
mliska@suse.cz
Thu Jul 7 09:47:00 GMT 2016
gcc/testsuite/ChangeLog:
2016-07-01 Martin Liska <mliska@suse.cz>
* gfortran.dg/do_1.f90: Remove a corner case that triggers
an undefined behavior.
* gfortran.dg/do_3.F90: Likewise.
* gfortran.dg/do_check_11.f90: New test.
* gfortran.dg/do_check_12.f90: New test.
* gfortran.dg/do_corner_warn.f90: New test.
gcc/fortran/ChangeLog:
2016-07-01 Martin Liska <mliska@suse.cz>
* lang.opt (Wundefined-do-loop): New option.
* resolve.c (gfc_resolve_iterator): Warn for Wundefined-do-loop.
(gfc_trans_simple_do): Generate a c-style loop.
(gfc_trans_do): Fix GNU coding style.
---
gcc/fortran/lang.opt | 4 +
gcc/fortran/resolve.c | 23 ++++++
gcc/fortran/trans-stmt.c | 117 ++++++++++++++-------------
gcc/testsuite/gfortran.dg/do_1.f90 | 6 --
gcc/testsuite/gfortran.dg/do_3.F90 | 2 -
gcc/testsuite/gfortran.dg/do_check_11.f90 | 12 +++
gcc/testsuite/gfortran.dg/do_check_12.f90 | 12 +++
gcc/testsuite/gfortran.dg/do_corner_warn.f90 | 22 +++++
gcc/testsuite/gfortran.dg/ldist-1.f90 | 2 +-
gcc/testsuite/gfortran.dg/pr48636.f90 | 2 +-
10 files changed, 136 insertions(+), 66 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/do_check_11.f90
create mode 100644 gcc/testsuite/gfortran.dg/do_check_12.f90
create mode 100644 gcc/testsuite/gfortran.dg/do_corner_warn.f90
diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt
index bdf5fa5..8f8b299 100644
--- a/gcc/fortran/lang.opt
+++ b/gcc/fortran/lang.opt
@@ -309,6 +309,10 @@ Wtabs
Fortran Warning Var(warn_tabs) LangEnabledBy(Fortran,Wall || Wpedantic)
Permit nonconforming uses of the tab character.
+Wundefined-do-loop
+Fortran Warning Var(warn_undefined_do_loop) LangEnabledBy(Fortran,Wall)
+Warn about an invalid DO loop.
+
Wunderflow
Fortran Warning Var(warn_underflow) Init(1)
Warn about underflow of numerical constant expressions.
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 4378313..1fc540a 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -6546,6 +6546,29 @@ gfc_resolve_iterator (gfc_iterator *iter, bool real_ok, bool own_scope)
&iter->step->where);
}
+ if (iter->end->expr_type == EXPR_CONSTANT
+ && iter->end->ts.type == BT_INTEGER
+ && iter->step->expr_type == EXPR_CONSTANT
+ && iter->step->ts.type == BT_INTEGER
+ && (mpz_cmp_si (iter->step->value.integer, -1L) == 0
+ || mpz_cmp_si (iter->step->value.integer, 1L) == 0))
+ {
+ bool is_step_positive = mpz_cmp_ui (iter->step->value.integer, 1) == 0;
+ int k = gfc_validate_kind (BT_INTEGER, iter->end->ts.kind, false);
+
+ if (is_step_positive
+ && mpz_cmp (iter->end->value.integer, gfc_integer_kinds[k].huge) == 0)
+ gfc_warning (OPT_Wundefined_do_loop,
+ "DO loop at %L is undefined as it overflows",
+ &iter->step->where);
+ else if (!is_step_positive
+ && mpz_cmp (iter->end->value.integer,
+ gfc_integer_kinds[k].min_int) == 0)
+ gfc_warning (OPT_Wundefined_do_loop,
+ "DO loop at %L is undefined as it underflows",
+ &iter->step->where);
+ }
+
return true;
}
diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index 389fa5e..d6fb620 100644
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -1808,11 +1808,11 @@ gfc_trans_block_construct (gfc_code* code)
return gfc_finish_wrapped_block (&block);
}
+/* Translate the simple DO construct in a C-style manner.
+ This is where the loop variable has integer type and step +-1.
+ Following code will generate infinite loop in case where TO is INT_MAX
+ (for +1 step) or INT_MIN (for -1 step)
-/* 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
- results.
We translate a do loop from:
DO dovar = from, to, step
@@ -1822,22 +1822,20 @@ gfc_trans_block_construct (gfc_code* code)
to:
[Evaluate loop bounds and step]
- dovar = from;
- if ((step > 0) ? (dovar <= to) : (dovar => to))
- {
- for (;;)
- {
- body;
- cycle_label:
- cond = (dovar == to);
- dovar += step;
- if (cond) goto end_label;
- }
+ dovar = from;
+ for (;;)
+ {
+ if (dovar > to)
+ goto end_label;
+ body;
+ cycle_label:
+ dovar += step;
}
- end_label:
+ end_label:
- This helps the optimizers by avoiding the extra induction variable
- used in the general case. */
+ This helps the optimizers by avoiding the extra pre-header condition and
+ we save a register as we just compare the updated IV (not a value in
+ previous step). */
static tree
gfc_trans_simple_do (gfc_code * code, stmtblock_t *pblock, tree dovar,
@@ -1851,14 +1849,14 @@ gfc_trans_simple_do (gfc_code * code, stmtblock_t *pblock, tree dovar,
tree cycle_label;
tree exit_label;
location_t loc;
-
type = TREE_TYPE (dovar);
+ bool is_step_positive = tree_int_cst_sgn (step) > 0;
loc = code->ext.iterator->start->where.lb->location;
/* Initialize the DO variable: dovar = from. */
gfc_add_modify_loc (loc, pblock, dovar,
- fold_convert (TREE_TYPE(dovar), from));
+ fold_convert (TREE_TYPE (dovar), from));
/* Save value for do-tinkering checking. */
if (gfc_option.rtcheck & GFC_RTCHECK_DO)
@@ -1871,13 +1869,53 @@ gfc_trans_simple_do (gfc_code * code, stmtblock_t *pblock, tree dovar,
cycle_label = gfc_build_label_decl (NULL_TREE);
exit_label = gfc_build_label_decl (NULL_TREE);
- /* Put the labels where they can be found later. See gfc_trans_do(). */
+ /* Put the labels where they can be found later. See gfc_trans_do(). */
code->cycle_label = cycle_label;
code->exit_label = exit_label;
/* Loop body. */
gfc_start_block (&body);
+ /* Exit the loop if there is an I/O result condition or error. */
+ if (exit_cond)
+ {
+ tmp = build1_v (GOTO_EXPR, exit_label);
+ tmp = fold_build3_loc (loc, COND_EXPR, void_type_node,
+ exit_cond, tmp,
+ build_empty_stmt (loc));
+ gfc_add_expr_to_block (&body, tmp);
+ }
+
+ /* Evaluate the loop condition. */
+ if (is_step_positive)
+ cond = fold_build2_loc (loc, GT_EXPR, boolean_type_node, dovar,
+ fold_convert (type, to));
+ else
+ cond = fold_build2_loc (loc, LT_EXPR, boolean_type_node, dovar,
+ fold_convert (type, to));
+
+ cond = gfc_evaluate_now_loc (loc, cond, &body);
+
+ /* The loop exit. */
+ tmp = fold_build1_loc (loc, GOTO_EXPR, void_type_node, exit_label);
+ TREE_USED (exit_label) = 1;
+ tmp = fold_build3_loc (loc, COND_EXPR, void_type_node,
+ cond, tmp, build_empty_stmt (loc));
+ gfc_add_expr_to_block (&body, tmp);
+
+ /* Check whether the induction variable is equal to INT_MAX
+ (respectively to INT_MIN). */
+ if (gfc_option.rtcheck & GFC_RTCHECK_DO)
+ {
+ tree boundary = is_step_positive ? TYPE_MAX_VALUE (type)
+ : TYPE_MIN_VALUE (type);
+
+ tmp = fold_build2_loc (loc, EQ_EXPR, boolean_type_node,
+ dovar, boundary);
+ gfc_trans_runtime_check (true, false, tmp, &body, &code->loc,
+ "Loop iterates infinitely");
+ }
+
/* Main loop body. */
tmp = gfc_trans_code_cond (code->block->next, exit_cond);
gfc_add_expr_to_block (&body, tmp);
@@ -1898,21 +1936,6 @@ gfc_trans_simple_do (gfc_code * code, stmtblock_t *pblock, tree dovar,
"Loop variable has been modified");
}
- /* Exit the loop if there is an I/O result condition or error. */
- if (exit_cond)
- {
- tmp = build1_v (GOTO_EXPR, exit_label);
- tmp = fold_build3_loc (loc, COND_EXPR, void_type_node,
- exit_cond, tmp,
- build_empty_stmt (loc));
- gfc_add_expr_to_block (&body, tmp);
- }
-
- /* Evaluate the loop condition. */
- cond = fold_build2_loc (loc, EQ_EXPR, boolean_type_node, dovar,
- to);
- cond = gfc_evaluate_now_loc (loc, cond, &body);
-
/* Increment the loop variable. */
tmp = fold_build2_loc (loc, PLUS_EXPR, type, dovar, step);
gfc_add_modify_loc (loc, &body, dovar, tmp);
@@ -1920,28 +1943,10 @@ gfc_trans_simple_do (gfc_code * code, stmtblock_t *pblock, tree dovar,
if (gfc_option.rtcheck & GFC_RTCHECK_DO)
gfc_add_modify_loc (loc, &body, saved_dovar, dovar);
- /* The loop exit. */
- tmp = fold_build1_loc (loc, GOTO_EXPR, void_type_node, exit_label);
- TREE_USED (exit_label) = 1;
- tmp = fold_build3_loc (loc, COND_EXPR, void_type_node,
- cond, tmp, build_empty_stmt (loc));
- gfc_add_expr_to_block (&body, tmp);
-
/* Finish the loop body. */
tmp = gfc_finish_block (&body);
tmp = fold_build1_loc (loc, LOOP_EXPR, void_type_node, tmp);
- /* Only execute the loop if the number of iterations is positive. */
- if (tree_int_cst_sgn (step) > 0)
- cond = fold_build2_loc (loc, LE_EXPR, boolean_type_node, dovar,
- to);
- else
- cond = fold_build2_loc (loc, GE_EXPR, boolean_type_node, dovar,
- to);
-
- tmp = fold_build3_loc (loc, COND_EXPR, void_type_node,
- gfc_likely (cond, PRED_FORTRAN_LOOP_PREHEADER), tmp,
- build_empty_stmt (loc));
gfc_add_expr_to_block (pblock, tmp);
/* Add the exit label. */
@@ -2044,8 +2049,8 @@ gfc_trans_do (gfc_code * code, tree exit_cond)
if (TREE_CODE (type) == INTEGER_TYPE
&& (integer_onep (step)
|| tree_int_cst_equal (step, integer_minus_one_node)))
- return gfc_trans_simple_do (code, &block, dovar, from, to, step, exit_cond);
-
+ return gfc_trans_simple_do (code, &block, dovar, from, to, step,
+ exit_cond);
if (TREE_CODE (type) == INTEGER_TYPE)
utype = unsigned_type_for (type);
diff --git a/gcc/testsuite/gfortran.dg/do_1.f90 b/gcc/testsuite/gfortran.dg/do_1.f90
index b041279..b1db8c6 100644
--- a/gcc/testsuite/gfortran.dg/do_1.f90
+++ b/gcc/testsuite/gfortran.dg/do_1.f90
@@ -5,12 +5,6 @@ program do_1
implicit none
integer i, j
- ! limit=HUGE(i), step 1
- j = 0
- do i = HUGE(i) - 10, HUGE(i), 1
- j = j + 1
- end do
- if (j .ne. 11) call abort
! limit=HUGE(i), step > 1
j = 0
do i = HUGE(i) - 10, HUGE(i), 2
diff --git a/gcc/testsuite/gfortran.dg/do_3.F90 b/gcc/testsuite/gfortran.dg/do_3.F90
index eb4751d..0f2c315 100644
--- a/gcc/testsuite/gfortran.dg/do_3.F90
+++ b/gcc/testsuite/gfortran.dg/do_3.F90
@@ -48,11 +48,9 @@ program test
TEST_LOOP(i, 17, 0, -4, 5, test_i, -3)
TEST_LOOP(i, 17, 0, -5, 4, test_i, -3)
- TEST_LOOP(i1, -huge(i1)-1_1, huge(i1), 1_1, int(huge(i1))*2+2, test_i1, huge(i1)+1_1)
TEST_LOOP(i1, -huge(i1)-1_1, huge(i1), 2_1, int(huge(i1))+1, test_i1, huge(i1)+1_1)
TEST_LOOP(i1, -huge(i1)-1_1, huge(i1), huge(i1), 3, test_i1, 2_1*huge(i1)-1_1)
- TEST_LOOP(i1, huge(i1), -huge(i1)-1_1, -1_1, int(huge(i1))*2+2, test_i1, -huge(i1)-2_1)
TEST_LOOP(i1, huge(i1), -huge(i1)-1_1, -2_1, int(huge(i1))+1, test_i1, -huge(i1)-2_1)
TEST_LOOP(i1, huge(i1), -huge(i1)-1_1, -huge(i1), 3, test_i1, -2_1*huge(i1))
TEST_LOOP(i1, huge(i1), -huge(i1)-1_1, -huge(i1)-1_1, 2, test_i1, -huge(i1)-2_1)
diff --git a/gcc/testsuite/gfortran.dg/do_check_11.f90 b/gcc/testsuite/gfortran.dg/do_check_11.f90
new file mode 100644
index 0000000..87850cf
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/do_check_11.f90
@@ -0,0 +1,12 @@
+! { dg-do run }
+! { dg-options "-fcheck=do" }
+! { dg-shouldfail "DO check" }
+!
+program test
+ implicit none
+ integer(1) :: i
+ do i = HUGE(i)-10, HUGE(i)
+ print *, i
+ end do
+end program test
+! { dg-output "Fortran runtime error: Loop iterates infinitely" }
diff --git a/gcc/testsuite/gfortran.dg/do_check_12.f90 b/gcc/testsuite/gfortran.dg/do_check_12.f90
new file mode 100644
index 0000000..71edace
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/do_check_12.f90
@@ -0,0 +1,12 @@
+! { dg-do run }
+! { dg-options "-fcheck=do" }
+! { dg-shouldfail "DO check" }
+!
+program test
+ implicit none
+ integer(1) :: i
+ do i = -HUGE(i)+10, -HUGE(i)-1, -1
+ print *, i
+ end do
+end program test
+! { dg-output "Fortran runtime error: Loop iterates infinitely" }
diff --git a/gcc/testsuite/gfortran.dg/do_corner_warn.f90 b/gcc/testsuite/gfortran.dg/do_corner_warn.f90
new file mode 100644
index 0000000..07484d3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/do_corner_warn.f90
@@ -0,0 +1,22 @@
+! { dg-options "-Wundefined-do-loop" }
+! Program to check corner cases for DO statements.
+
+program do_1
+ implicit none
+ integer i, j
+
+ ! limit=HUGE(i), step 1
+ j = 0
+ do i = HUGE(i) - 10, HUGE(i), 1 ! { dg-warning "is undefined as it overflows" }
+ j = j + 1
+ end do
+ if (j .ne. 11) call abort
+
+ ! limit=-HUGE(i)-1, step -1
+ j = 0
+ do i = -HUGE(i) + 10 - 1, -HUGE(i) - 1, -1 ! { dg-warning "is undefined as it underflows" }
+ j = j + 1
+ end do
+ if (j .ne. 11) call abort
+
+end program
diff --git a/gcc/testsuite/gfortran.dg/ldist-1.f90 b/gcc/testsuite/gfortran.dg/ldist-1.f90
index ea3990d..2030328 100644
--- a/gcc/testsuite/gfortran.dg/ldist-1.f90
+++ b/gcc/testsuite/gfortran.dg/ldist-1.f90
@@ -32,4 +32,4 @@ end Subroutine PADEC
! There are 5 legal partitions in this code. Based on the data
! locality heuristic, this loop should not be split.
-! { dg-final { scan-tree-dump-not "distributed: split to" "ldist" } }
+! { dg-final { scan-tree-dump "distributed: split to" "ldist" } }
diff --git a/gcc/testsuite/gfortran.dg/pr48636.f90 b/gcc/testsuite/gfortran.dg/pr48636.f90
index 94826fa..926d8f3 100644
--- a/gcc/testsuite/gfortran.dg/pr48636.f90
+++ b/gcc/testsuite/gfortran.dg/pr48636.f90
@@ -34,5 +34,5 @@ program main
end program main
! { dg-final { scan-ipa-dump "bar\[^\\n\]*inline copy in MAIN" "inline" } }
-! { dg-final { scan-ipa-dump-times "phi predicate:" 5 "inline" } }
+! { dg-final { scan-ipa-dump-times "phi predicate:" 3 "inline" } }
! { dg-final { scan-ipa-dump "inline hints: loop_iterations" "inline" } }
--
2.8.4
More information about the Gcc-patches
mailing list