[PATCH, RFC] Introduce -ffast-do-loop flag.

[Martin LiÅka <mliska at suse dot cz>]

Hello.

This is patch attempt to target the discussion about sub-optimal generation
of DO loops with abs(step) == 1.

Originally generated code:

    D.3428 = (*array)[0];
    D.3429 = (*array)[1];
    i = D.3428;
    if (i <= D.3429)
      {
        while (1)
          {
            {
              logical(kind=4) D.3432;

              (*block)[(integer(kind=8)) i + -1] = (*block)[(integer(kind=8)) i + -1] + 10;
              L.1:;
              D.3432 = i == D.3429;
              i = i + 1;
              if (D.3432) goto L.2;
            }
          }
      }
    L.2:;

Suggested:

    D.3428 = (*array)[0];
    D.3429 = (*array)[1];
    i = D.3428;
    while (1)
      {
        {
          logical(kind=4) D.3432;

          D.3432 = i > D.3429;
          if (D.3432) goto L.2;
          (*block)[(integer(kind=8)) i + -1] = (*block)[(integer(kind=8)) i + -1] + 10;
          L.1:;
          i = i + 1;
        }
      }
    L.2:;

I would like to enable the behavior be default, patch does that starting from -O2.

Apart from that, I've also added a new warning (candidate name: Wundefined-do-loop), which warns about cases that
would lead to an infinite loop (because i > HUGE(i) == false):

Warning: DO loop at (1) is infinite as it iterates to MIN_INT [-Wundefined-do-loop]
/tmp/loop2.f90:15:19:

   do i = 0, huge(i)
                   1

Patch hasn't been properly tested, I've just tried to run all do_*.[fF]90 tests.

Thoughts?
Martin

>From 061caf9ab5ba1084fdf980ccd99dd70f42712da3 Mon Sep 17 00:00:00 2001
From: marxin <mliska@suse.cz>
Date: Tue, 28 Jun 2016 15:11:13 +0200
Subject: [PATCH] Introduce -ffast-do-loop flag.

gcc/fortran/ChangeLog:

2016-06-30  Martin Liska  <mliska@suse.cz>

	* lang.opt (Wundefined-do-loop): New option.
	(ffast-do-loop): Likewise.
	* resolve.c (gfc_resolve_iterator): Warn for Wundefined-do-loop.
	* trans-stmt.c (gfc_trans_simple_do_fast): New function.
	(gfc_trans_simple_do): Fix coding style.
	(gfc_trans_do): Call either gfc_trans_simple_do or
	gfc_trans_simple_do_fast.

gcc/testsuite/ChangeLog:

2016-06-30  Martin Liska  <mliska@suse.cz>

	* gfortran.dg/do_1.f90: Remove corner cases.
	* gfortran.dg/do_3.F90: Likewise.
	* gfortran.dg/do_corner.f90: New test.
	* gfortran.dg/do_corner_warn.f90: New test.

gcc/ChangeLog:

2016-06-30  Martin Liska  <mliska@suse.cz>

	* opts.c: Add OPT_ffast_do_loop to O2+.
---
 gcc/fortran/lang.opt                         |   8 ++
 gcc/fortran/resolve.c                        |  24 +++++
 gcc/fortran/trans-stmt.c                     | 148 ++++++++++++++++++++++++++-
 gcc/opts.c                                   |   1 +
 gcc/testsuite/gfortran.dg/do_1.f90           |   6 --
 gcc/testsuite/gfortran.dg/do_3.F90           |   2 -
 gcc/testsuite/gfortran.dg/do_corner.f90      |  24 +++++
 gcc/testsuite/gfortran.dg/do_corner_warn.f90 |  22 ++++
 8 files changed, 224 insertions(+), 11 deletions(-)
 create mode 100644 gcc/testsuite/gfortran.dg/do_corner.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..57cdd15 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 loops.
+
 Wunderflow
 Fortran Warning Var(warn_underflow) Init(1)
 Warn about underflow of numerical constant expressions.
@@ -464,6 +468,10 @@ ff2c
 Fortran Var(flag_f2c)
 Use f2c calling convention.
 
+ffast-do-loop
+Fortran Var(flag_fast_do_loop)
+Use C style code generation of loops.
+
 ffixed-form
 Fortran RejectNegative
 Assume that the source file is fixed form.
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 4378313..85b2218 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -6546,6 +6546,30 @@ gfc_resolve_iterator (gfc_iterator *iter, bool real_ok, bool own_scope)
 		     &iter->step->where);
     }
 
+  if (flag_fast_do_loop
+      && 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 infinite as it iterates to MAX_INT",
+		     &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 infinite as it iterates to MIN_INT",
+		     &iter->step->where);
+    }
+
   return true;
 }
 
diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index 84bf749..b069af3 100644
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -1808,6 +1808,142 @@ 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)
+
+   We translate a do loop from:
+
+   DO dovar = from, to, step
+      body
+   END DO
+
+   to:
+
+   [Evaluate loop bounds and step]
+    dovar = from;
+    for (;;)
+      {
+	if (dovar > to)
+	  goto end_label;
+	body;
+	cycle_label:
+	dovar += step;
+      }
+    end_label:
+
+   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_fast (gfc_code * code, stmtblock_t *pblock, tree dovar,
+			  tree from, tree to, tree step, tree exit_cond)
+{
+  stmtblock_t body;
+  tree type;
+  tree cond;
+  tree tmp;
+  tree saved_dovar = NULL;
+  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));
+
+  /* Save value for do-tinkering checking.  */
+  if (gfc_option.rtcheck & GFC_RTCHECK_DO)
+    {
+      saved_dovar = gfc_create_var (type, ".saved_dovar");
+      gfc_add_modify_loc (loc, pblock, saved_dovar, dovar);
+    }
+
+  /* Cycle and exit statements are implemented with gotos.  */
+  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().  */
+  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);
+
+  /* Main loop body.  */
+  tmp = gfc_trans_code_cond (code->block->next, exit_cond);
+  gfc_add_expr_to_block (&body, tmp);
+
+  /* Label for cycle statements (if needed).  */
+  if (TREE_USED (cycle_label))
+    {
+      tmp = build1_v (LABEL_EXPR, cycle_label);
+      gfc_add_expr_to_block (&body, tmp);
+    }
+
+  /* Check whether someone has modified the loop variable.  */
+  if (gfc_option.rtcheck & GFC_RTCHECK_DO)
+    {
+      tmp = fold_build2_loc (loc, NE_EXPR, boolean_type_node,
+			     dovar, saved_dovar);
+      gfc_trans_runtime_check (true, false, tmp, &body, &code->loc,
+			       "Loop variable has been modified");
+    }
+
+  /* Increment the loop variable.  */
+  tmp = fold_build2_loc (loc, PLUS_EXPR, type, dovar, step);
+  gfc_add_modify_loc (loc, &body, dovar, tmp);
+
+  if (gfc_option.rtcheck & GFC_RTCHECK_DO)
+    gfc_add_modify_loc (loc, &body, saved_dovar, dovar);
+
+  /* Finish the loop body.  */
+  tmp = gfc_finish_block (&body);
+  tmp = fold_build1_loc (loc, LOOP_EXPR, void_type_node, tmp);
+
+  gfc_add_expr_to_block (pblock, tmp);
+
+  /* Add the exit label.  */
+  tmp = build1_v (LABEL_EXPR, exit_label);
+  gfc_add_expr_to_block (pblock, tmp);
+
+  return gfc_finish_block (pblock);
+}
+
+
 
 /* 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
@@ -1851,14 +1987,13 @@ 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);
 
   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)
@@ -2044,7 +2179,14 @@ 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);
+    {
+      if (flag_fast_do_loop)
+	return gfc_trans_simple_do_fast (code, &block, dovar, from, to, step,
+					 exit_cond);
+      else
+	return gfc_trans_simple_do (code, &block, dovar, from, to, step,
+				    exit_cond);
+    }
 
 
   if (TREE_CODE (type) == INTEGER_TYPE)
diff --git a/gcc/opts.c b/gcc/opts.c
index 7406210..ef77421 100644
--- a/gcc/opts.c
+++ b/gcc/opts.c
@@ -519,6 +519,7 @@ static const struct default_options default_options_table[] =
     { OPT_LEVELS_2_PLUS, OPT_fisolate_erroneous_paths_dereference, NULL, 1 },
     { OPT_LEVELS_2_PLUS, OPT_fipa_ra, NULL, 1 },
     { OPT_LEVELS_2_PLUS, OPT_flra_remat, NULL, 1 },
+    { OPT_LEVELS_2_PLUS, OPT_ffast_do_loop, NULL, 1 },
 
     /* -O3 optimizations.  */
     { OPT_LEVELS_3_PLUS, OPT_ftree_loop_distribute_patterns, NULL, 1 },
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_corner.f90 b/gcc/testsuite/gfortran.dg/do_corner.f90
new file mode 100644
index 0000000..088326d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/do_corner.f90
@@ -0,0 +1,24 @@
+! { dg-do run }
+! { dg-options "-fno-fast-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
+    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
+    j = j + 1
+  end do
+  if (j .ne. 11) call abort
+
+end program
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..decaf9a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/do_corner_warn.f90
@@ -0,0 +1,22 @@
+! { dg-options "-Wundefined-do-loop -ffast-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 infinite as it iterates to MAX_INT" }
+    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 infinite as it iterates to MIN_INT" }
+    j = j + 1
+  end do
+  if (j .ne. 11) call abort
+
+end program
-- 
2.8.4