}
+/* 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:
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)
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);
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. */
--- /dev/null
+! { 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
projects / platform / upstream / linaro-gcc.git / commitdiff