From 061caf9ab5ba1084fdf980ccd99dd70f42712da3 Mon Sep 17 00:00:00 2001 From: marxin Date: Tue, 28 Jun 2016 15:11:13 +0200 Subject: [PATCH] Introduce -ffast-do-loop flag. gcc/fortran/ChangeLog: 2016-06-30 Martin Liska * 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 * 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 * 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