trans-stmt.c (forall_info): Replace the next_nest and outer fields that previously implemented a...

* trans-stmt.c (forall_info): Replace the next_nest and outer
	fields that previously implemented a doubly-linked list with a
	single prev_nest field (singly-linked list).
	(gfc_trans_nested_forall_loop): The nested_forall_info argument
	now denotes the innermost FORALL in the loop nest.
	(compute_overall_iter_number): Use prev_nest instead of next_nest.
	(gfc_trans_forall_1): Link/cons the new "info" to the head of the
	nested_forall_info linked list.  Free the current "info" when done.

	* gfortran.dg/forall_7.f90: New test case.

From-SVN: r121236
This commit is contained in:
Roger Sayle 2007-01-27 19:02:25 +00:00 committed by Roger Sayle
parent a00b8d1a38
commit e8d366ec6b
4 changed files with 40 additions and 17 deletions

View File

@ -1,3 +1,14 @@
2007-01-27 Roger Sayle <roger@eyesopen.com>
* trans-stmt.c (forall_info): Replace the next_nest and outer
fields that previously implemented a doubly-linked list with a
single prev_nest field (singly-linked list).
(gfc_trans_nested_forall_loop): The nested_forall_info argument
now denotes the innermost FORALL in the loop nest.
(compute_overall_iter_number): Use prev_nest instead of next_nest.
(gfc_trans_forall_1): Link/cons the new "info" to the head of the
nested_forall_info linked list. Free the current "info" when done.
2007-01-27 Paul Thomas <pault@gcc.gnu.org> 2007-01-27 Paul Thomas <pault@gcc.gnu.org>
PR fortran/30407 PR fortran/30407

View File

@ -57,8 +57,7 @@ typedef struct forall_info
tree maskindex; tree maskindex;
int nvar; int nvar;
tree size; tree size;
struct forall_info *outer; struct forall_info *prev_nest;
struct forall_info *next_nest;
} }
forall_info; forall_info;
@ -1653,8 +1652,6 @@ gfc_trans_nested_forall_loop (forall_info * nested_forall_info, tree body,
gfc_start_block (&header); gfc_start_block (&header);
forall_tmp = nested_forall_info; forall_tmp = nested_forall_info;
while (forall_tmp->next_nest != NULL)
forall_tmp = forall_tmp->next_nest;
while (forall_tmp != NULL) while (forall_tmp != NULL)
{ {
/* Generate body with masks' control. */ /* Generate body with masks' control. */
@ -1671,7 +1668,7 @@ gfc_trans_nested_forall_loop (forall_info * nested_forall_info, tree body,
} }
} }
body = gfc_trans_forall_loop (forall_tmp, body, mask_flag, &header); body = gfc_trans_forall_loop (forall_tmp, body, mask_flag, &header);
forall_tmp = forall_tmp->outer; forall_tmp = forall_tmp->prev_nest;
mask_flag = 1; mask_flag = 1;
} }
@ -2043,7 +2040,7 @@ compute_overall_iter_number (forall_info *nested_forall_info, tree inner_size,
/* First check whether all the bounds are constant. */ /* First check whether all the bounds are constant. */
for (forall_tmp = nested_forall_info; for (forall_tmp = nested_forall_info;
forall_tmp; forall_tmp;
forall_tmp = forall_tmp->next_nest) forall_tmp = forall_tmp->prev_nest)
if (forall_tmp->mask || !INTEGER_CST_P (forall_tmp->size)) if (forall_tmp->mask || !INTEGER_CST_P (forall_tmp->size))
{ {
all_const_p = false; all_const_p = false;
@ -2055,7 +2052,7 @@ compute_overall_iter_number (forall_info *nested_forall_info, tree inner_size,
tree tmp = inner_size; tree tmp = inner_size;
for (forall_tmp = nested_forall_info; for (forall_tmp = nested_forall_info;
forall_tmp; forall_tmp;
forall_tmp = forall_tmp->next_nest) forall_tmp = forall_tmp->prev_nest)
tmp = fold_build2 (MULT_EXPR, gfc_array_index_type, tmp = fold_build2 (MULT_EXPR, gfc_array_index_type,
tmp, forall_tmp->size); tmp, forall_tmp->size);
return tmp; return tmp;
@ -2584,16 +2581,8 @@ gfc_trans_forall_1 (gfc_code * code, forall_info * nested_forall_info)
} }
/* Link the current forall level to nested_forall_info. */ /* Link the current forall level to nested_forall_info. */
if (nested_forall_info) info->prev_nest = nested_forall_info;
{ nested_forall_info = info;
forall_info *forall_tmp = nested_forall_info;
while (forall_tmp->next_nest != NULL)
forall_tmp = forall_tmp->next_nest;
info->outer = forall_tmp;
forall_tmp->next_nest = info;
}
else
nested_forall_info = info;
/* Copy the mask into a temporary variable if required. /* Copy the mask into a temporary variable if required.
For now we assume a mask temporary is needed. */ For now we assume a mask temporary is needed. */
@ -2713,6 +2702,9 @@ gfc_trans_forall_1 (gfc_code * code, forall_info * nested_forall_info)
gfc_free (varexpr); gfc_free (varexpr);
gfc_free (saved_vars); gfc_free (saved_vars);
/* Free the space for this forall_info. */
gfc_free (info);
if (pmask) if (pmask)
{ {
/* Free the temporary for the mask. */ /* Free the temporary for the mask. */

View File

@ -1,3 +1,7 @@
2007-01-27 Roger Sayle <roger@eyesopen.com>
* gfortran.dg/forall_7.f90: New test case.
2007-01-27 Paul Thomas <pault@gcc.gnu.org> 2007-01-27 Paul Thomas <pault@gcc.gnu.org>
PR fortran/30407 PR fortran/30407

View File

@ -0,0 +1,16 @@
! { dg-do run }
integer :: a(10,10)
integer :: tot
a(:,:) = 0
forall (i = 1:10)
forall (j = 1:10)
a(i,j) = 1
end forall
forall (k = 1:10)
a(i,k) = a(i,k) + 1
end forall
end forall
tot = sum(a(:,:))
! print *, tot
if (tot .ne. 200) call abort ()
end