trans-stmt.c (gfc_trans_simple_do): New function.
* trans-stmt.c (gfc_trans_simple_do): New function. (gfc_trans_do): Use it. Evaluate iteration bounds before entering loop. Update comments. testsuite/ * gfortran.dg/do_1.f90: New test. From-SVN: r88607
This commit is contained in:
Paul Brook
Paul Brook
parent
5a6aa19c25
commit
fbdad37d85
|
|
@ -1,3 +1,9 @@
|
|||
2004-10-06 Paul Brook <paul@codesourcery.com>
|
||||
|
||||
* trans-stmt.c (gfc_trans_simple_do): New function.
|
||||
(gfc_trans_do): Use it. Evaluate iteration bounds before entering
|
||||
loop. Update comments.
|
||||
|
||||
2004-10-04 Tobias Schlueter <tobias.schlueter@physik.uni-muenchen.de>
|
||||
|
||||
PR fortran/17283
|
||||
|
|
|
|||
|
|
@ -485,13 +485,113 @@ gfc_trans_arithmetic_if (gfc_code * code)
|
|||
}
|
||||
|
||||
|
||||
/* Translate the simple DO construct. This is where the loop varable 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
|
||||
body
|
||||
END DO
|
||||
|
||||
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;
|
||||
}
|
||||
}
|
||||
end_label:
|
||||
|
||||
This helps the optimizers by avoiding the extra induction variable
|
||||
used in the general case. */
|
||||
|
||||
static tree
|
||||
gfc_trans_simple_do (gfc_code * code, stmtblock_t *pblock, tree dovar,
|
||||
tree from, tree to, tree step)
|
||||
{
|
||||
stmtblock_t body;
|
||||
tree type;
|
||||
tree cond;
|
||||
tree tmp;
|
||||
tree cycle_label;
|
||||
tree exit_label;
|
||||
|
||||
type = TREE_TYPE (dovar);
|
||||
|
||||
/* Initialize the DO variable: dovar = from. */
|
||||
gfc_add_modify_expr (pblock, dovar, from);
|
||||
|
||||
/* 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->block->backend_decl = tree_cons (cycle_label, exit_label, NULL);
|
||||
|
||||
/* Loop body. */
|
||||
gfc_start_block (&body);
|
||||
|
||||
/* Main loop body. */
|
||||
tmp = gfc_trans_code (code->block->next);
|
||||
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);
|
||||
}
|
||||
|
||||
/* Evaluate the loop condition. */
|
||||
cond = build2 (EQ_EXPR, boolean_type_node, dovar, to);
|
||||
cond = gfc_evaluate_now (cond, &body);
|
||||
|
||||
/* Increment the loop variable. */
|
||||
tmp = build2 (PLUS_EXPR, type, dovar, step);
|
||||
gfc_add_modify_expr (&body, dovar, tmp);
|
||||
|
||||
/* The loop exit. */
|
||||
tmp = build1_v (GOTO_EXPR, exit_label);
|
||||
TREE_USED (exit_label) = 1;
|
||||
tmp = build3_v (COND_EXPR, cond, tmp, build_empty_stmt ());
|
||||
gfc_add_expr_to_block (&body, tmp);
|
||||
|
||||
/* Finish the loop body. */
|
||||
tmp = gfc_finish_block (&body);
|
||||
tmp = build1_v (LOOP_EXPR, tmp);
|
||||
|
||||
/* Only execute the loop if the number of iterations is positive. */
|
||||
if (tree_int_cst_sgn (step) > 0)
|
||||
cond = fold (build2 (LE_EXPR, boolean_type_node, dovar, to));
|
||||
else
|
||||
cond = fold (build2 (GE_EXPR, boolean_type_node, dovar, to));
|
||||
tmp = build3_v (COND_EXPR, cond, tmp, build_empty_stmt ());
|
||||
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 DO construct. This obviously is one of the most
|
||||
important ones to get right with any compiler, but especially
|
||||
so for Fortran.
|
||||
|
||||
Currently we calculate the loop count before entering the loop, but
|
||||
it may be possible to optimize if step is a constant. The main
|
||||
advantage is that the loop test is a single GENERIC node
|
||||
We special case some loop forms as described in gfc_trans_simple_do.
|
||||
For other cases we implement them with a separate loop count,
|
||||
as described in the standard.
|
||||
|
||||
We translate a do loop from:
|
||||
|
||||
|
|
@ -501,30 +601,24 @@ gfc_trans_arithmetic_if (gfc_code * code)
|
|||
|
||||
to:
|
||||
|
||||
pre_dovar;
|
||||
pre_from;
|
||||
pre_to;
|
||||
pre_step;
|
||||
temp1=to_expr-from_expr;
|
||||
step_temp=step_expr;
|
||||
range_temp=step_tmp/range_temp;
|
||||
for ( ; range_temp > 0 ; range_temp = range_temp - 1)
|
||||
[evaluate loop bounds and step]
|
||||
count = to + step - from;
|
||||
dovar = from;
|
||||
for (;;)
|
||||
{
|
||||
body;
|
||||
cycle_label:
|
||||
dovar_temp = dovar
|
||||
dovar=dovar_temp + step_temp;
|
||||
dovar += step
|
||||
count--;
|
||||
if (count <=0) goto exit_label;
|
||||
}
|
||||
exit_label:
|
||||
|
||||
Some optimization is done for empty do loops. We can't just let
|
||||
dovar=to because it's possible for from+range*loopcount!=to. Anyone
|
||||
who writes empty DO deserves sub-optimal (but correct) code anyway.
|
||||
|
||||
TODO: Large loop counts
|
||||
Does not work loop counts which do not fit into a signed integer kind,
|
||||
The code above assumes the loop count fits into a signed integer kind,
|
||||
i.e. Does not work for loop counts > 2^31 for integer(kind=4) variables
|
||||
We must support the full range. */
|
||||
We must support the full range.
|
||||
TODO: Real type do variables. */
|
||||
|
||||
tree
|
||||
gfc_trans_do (gfc_code * code)
|
||||
|
|
@ -545,8 +639,7 @@ gfc_trans_do (gfc_code * code)
|
|||
|
||||
gfc_start_block (&block);
|
||||
|
||||
/* Create GIMPLE versions of all expressions in the iterator. */
|
||||
|
||||
/* Evaluate all the expressions in the iterator. */
|
||||
gfc_init_se (&se, NULL);
|
||||
gfc_conv_expr_lhs (&se, code->ext.iterator->var);
|
||||
gfc_add_block_to_block (&block, &se.pre);
|
||||
|
|
@ -556,21 +649,24 @@ gfc_trans_do (gfc_code * code)
|
|||
gfc_init_se (&se, NULL);
|
||||
gfc_conv_expr_type (&se, code->ext.iterator->start, type);
|
||||
gfc_add_block_to_block (&block, &se.pre);
|
||||
from = se.expr;
|
||||
from = gfc_evaluate_now (se.expr, &block);
|
||||
|
||||
gfc_init_se (&se, NULL);
|
||||
gfc_conv_expr_type (&se, code->ext.iterator->end, type);
|
||||
gfc_add_block_to_block (&block, &se.pre);
|
||||
to = se.expr;
|
||||
to = gfc_evaluate_now (se.expr, &block);
|
||||
|
||||
gfc_init_se (&se, NULL);
|
||||
gfc_conv_expr_type (&se, code->ext.iterator->step, type);
|
||||
|
||||
/* We don't want this changing part way through. */
|
||||
gfc_make_safe_expr (&se);
|
||||
gfc_add_block_to_block (&block, &se.pre);
|
||||
step = se.expr;
|
||||
step = gfc_evaluate_now (se.expr, &block);
|
||||
|
||||
/* Special case simple loops. */
|
||||
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);
|
||||
|
||||
/* Initialize loop count. This code is executed before we enter the
|
||||
loop body. We generate: count = (to + step - from) / step. */
|
||||
|
||||
|
|
|
|||
|
|
@ -1,3 +1,7 @@
|
|||
2004-10-06 Paul Brook <paul@codesourcery.com>
|
||||
|
||||
* gfortran.dg/do_1.f90: New test.
|
||||
|
||||
2004-10-06 Kaveh R. Ghazi <ghazi@caip.rutgers.edu>
|
||||
|
||||
* gcc.c-torture/execute/builtins/lib/strcpy.c: Don't abort when
|
||||
|
|
|
|||
|
|
@ -0,0 +1,80 @@
|
|||
! { dg-do run }
|
||||
! 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), step > 1
|
||||
j = 0
|
||||
do i = HUGE(i) - 10, HUGE(i), 2
|
||||
j = j + 1
|
||||
end do
|
||||
if (j .ne. 6) call abort
|
||||
j = 0
|
||||
do i = HUGE(i) - 9, HUGE(i), 2
|
||||
j = j + 1
|
||||
end do
|
||||
if (j .ne. 5) call abort
|
||||
|
||||
! Same again, but unknown loop step
|
||||
if (test1(10, 1) .ne. 11) call abort
|
||||
if (test1(10, 2) .ne. 6) call abort
|
||||
if (test1(9, 2) .ne. 5) call abort
|
||||
|
||||
! Zero iterations
|
||||
j = 0
|
||||
do i = 1, 0, 1
|
||||
j = j + 1
|
||||
end do
|
||||
if (j .ne. 0) call abort
|
||||
j = 0
|
||||
do i = 1, 0, 2
|
||||
j = j + 1
|
||||
end do
|
||||
if (j .ne. 0) call abort
|
||||
j = 0
|
||||
do i = 1, 2, -1
|
||||
j = j + 1
|
||||
end do
|
||||
if (j .ne. 0) call abort
|
||||
call test2 (0, 1)
|
||||
call test2 (0, 2)
|
||||
call test2 (2, -1)
|
||||
call test2 (2, -2)
|
||||
|
||||
! Bound near smallest value
|
||||
j = 0;
|
||||
do i = -HUGE(i), -HUGE(i), 10
|
||||
j = j + 1
|
||||
end do
|
||||
if (j .ne. 1) call abort
|
||||
contains
|
||||
! Returns the number of iterations performed.
|
||||
function test1(r, step)
|
||||
implicit none
|
||||
integer test1, r, step
|
||||
integer k, n
|
||||
k = 0
|
||||
do n = HUGE(n) - r, HUGE(n), step
|
||||
k = k + 1
|
||||
end do
|
||||
test1 = k
|
||||
end function
|
||||
|
||||
subroutine test2 (lim, step)
|
||||
implicit none
|
||||
integer lim, step
|
||||
integer k, n
|
||||
k = 0
|
||||
do n = 1, lim, step
|
||||
k = k + 1
|
||||
end do
|
||||
if (k .ne. 0) call abort
|
||||
end subroutine
|
||||
end program
|
||||
Loading…
Reference in New Issue