This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[PATCH] Fix PR fortran/15080
- From: Jakub Jelinek <jakub at redhat dot com>
- To: Paul Brook <paul at codesourcery dot com>
- Cc: gcc-patches at gcc dot gnu dot org, fortran at gcc dot gnu dot org
- Date: Fri, 29 Apr 2005 10:02:57 -0400
- Subject: [PATCH] Fix PR fortran/15080
- Reply-to: Jakub Jelinek <jakub at redhat dot com>
Hi!
This patch seems to fix forall_3.f90 testcase and makes Fortran testsuite
pass fully (I only get 8 gfortran.dg/ret_pointer_1.f90 XPASSes on x86-64).
The patch does essentially 2 things:
1) calls compute_inner_temp_size from gfc_trans_assign_need_temp
with a temporary stmtblock_t and emits that block inside of the loop
where num is incremented
2) stops using inner_size in the second 2 loops (one that initializes
the temp array, one that uses it). Instead of using 2 counters (count1
and count2), increasing count2 in the inner loop and after the inner
loop increasing count1 by inner_size, it simply uses one flat counter
(count1). This way we don't have to compute inner_size more than once.
2005-04-29 Jakub Jelinek <jakub@redhat.com>
PR fortran/15080
* trans-stmt.c (generate_loop_for_temp_to_lhs): Remove SIZE and COUNT2
arguments. If LSS is gfc_ss_terminator, increment COUNT1 by 1, instead
of incrementing COUNT2 and using COUNT1+COUNT2 increment COUNT1 and use
just that as index.
(generate_loop_for_rhs_to_temp): Likewise.
(compute_overall_iter_number): Add INNER_SIZE_BODY argument.
It non-NULL, add it to body.
(allocate_temp_for_forall_nest): Add INNER_SIZE_BODY argument,
propagate it down to compute_overall_iter_number.
(gfc_trans_assign_need_temp): Remove COUNT2. Call
compute_inner_temp_size into a new stmtblock_t. Adjust calls to
allocate_temp_for_forall_nest, generate_loop_for_rhs_to_temp
and generate_loop_for_temp_to_lhs.
(gfc_trans_pointer_assign_need_temp, gfc_evaluate_where_mask):
Adjust calls to allocate_temp_for_forall_nest.
--- gcc/fortran/trans-stmt.c.jj 2005-04-01 09:29:56.000000000 +0200
+++ gcc/fortran/trans-stmt.c 2005-04-29 15:40:32.000000000 +0200
@@ -1516,15 +1516,14 @@ gfc_do_allocate (tree bytesize, tree siz
/* Generate codes to copy the temporary to the actual lhs. */
static tree
-generate_loop_for_temp_to_lhs (gfc_expr *expr, tree tmp1, tree size,
- tree count3, tree count1, tree count2, tree wheremask)
+generate_loop_for_temp_to_lhs (gfc_expr *expr, tree tmp1, tree count3,
+ tree count1, tree wheremask)
{
gfc_ss *lss;
gfc_se lse, rse;
stmtblock_t block, body;
gfc_loopinfo loop1;
tree tmp, tmp2;
- tree index;
tree wheremaskexpr;
/* Walk the lhs. */
@@ -1548,8 +1547,10 @@ generate_loop_for_temp_to_lhs (gfc_expr
gfc_add_block_to_block (&block, &lse.post);
/* Increment the count1. */
- tmp = fold_build2 (PLUS_EXPR, TREE_TYPE (count1), count1, size);
+ tmp = fold_build2 (PLUS_EXPR, TREE_TYPE (count1), count1,
+ gfc_index_one_node);
gfc_add_modify_expr (&block, count1, tmp);
+
tmp = gfc_finish_block (&block);
}
else
@@ -1569,8 +1570,6 @@ generate_loop_for_temp_to_lhs (gfc_expr
gfc_conv_loop_setup (&loop1);
gfc_mark_ss_chain_used (lss, 1);
- /* Initialize count2. */
- gfc_add_modify_expr (&block, count2, gfc_index_zero_node);
/* Start the scalarized loop body. */
gfc_start_scalarized_body (&loop1, &body);
@@ -1581,11 +1580,7 @@ generate_loop_for_temp_to_lhs (gfc_expr
/* Form the expression of the temporary. */
if (lss != gfc_ss_terminator)
- {
- index = fold_build2 (PLUS_EXPR, gfc_array_index_type,
- count1, count2);
- rse.expr = gfc_build_array_ref (tmp1, index);
- }
+ rse.expr = gfc_build_array_ref (tmp1, count1);
/* Translate expr. */
gfc_conv_expr (&lse, expr);
@@ -1596,31 +1591,31 @@ generate_loop_for_temp_to_lhs (gfc_expr
if (wheremask)
{
wheremaskexpr = gfc_build_array_ref (wheremask, count3);
- tmp2 = TREE_CHAIN (wheremask);
- while (tmp2)
- {
- tmp1 = gfc_build_array_ref (tmp2, count3);
- wheremaskexpr = build2 (TRUTH_AND_EXPR, TREE_TYPE (tmp1),
+ tmp2 = TREE_CHAIN (wheremask);
+ while (tmp2)
+ {
+ tmp1 = gfc_build_array_ref (tmp2, count3);
+ wheremaskexpr = build2 (TRUTH_AND_EXPR, TREE_TYPE (tmp1),
wheremaskexpr, tmp1);
- tmp2 = TREE_CHAIN (tmp2);
- }
- tmp = build3_v (COND_EXPR, wheremaskexpr, tmp, build_empty_stmt ());
+ tmp2 = TREE_CHAIN (tmp2);
+ }
+ tmp = build3_v (COND_EXPR, wheremaskexpr, tmp, build_empty_stmt ());
}
gfc_add_expr_to_block (&body, tmp);
- /* Increment count2. */
+ /* Increment count1. */
tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type,
- count2, gfc_index_one_node);
- gfc_add_modify_expr (&body, count2, tmp);
+ count1, gfc_index_one_node);
+ gfc_add_modify_expr (&body, count1, tmp);
/* Increment count3. */
if (count3)
- {
- tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type,
+ {
+ tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type,
count3, gfc_index_one_node);
- gfc_add_modify_expr (&body, count3, tmp);
- }
+ gfc_add_modify_expr (&body, count3, tmp);
+ }
/* Generate the copying loops. */
gfc_trans_scalarizing_loops (&loop1, &body);
@@ -1628,9 +1623,6 @@ generate_loop_for_temp_to_lhs (gfc_expr
gfc_add_block_to_block (&block, &loop1.post);
gfc_cleanup_loop (&loop1);
- /* Increment count1. */
- tmp = fold_build2 (PLUS_EXPR, TREE_TYPE (count1), count1, size);
- gfc_add_modify_expr (&block, count1, tmp);
tmp = gfc_finish_block (&block);
}
return tmp;
@@ -1642,15 +1634,15 @@ generate_loop_for_temp_to_lhs (gfc_expr
not be freed. */
static tree
-generate_loop_for_rhs_to_temp (gfc_expr *expr2, tree tmp1, tree size,
- tree count3, tree count1, tree count2,
- gfc_ss *lss, gfc_ss *rss, tree wheremask)
+generate_loop_for_rhs_to_temp (gfc_expr *expr2, tree tmp1, tree count3,
+ tree count1, gfc_ss *lss, gfc_ss *rss,
+ tree wheremask)
{
stmtblock_t block, body1;
gfc_loopinfo loop;
gfc_se lse;
gfc_se rse;
- tree tmp, tmp2, index;
+ tree tmp, tmp2;
tree wheremaskexpr;
gfc_start_block (&block);
@@ -1666,9 +1658,6 @@ generate_loop_for_rhs_to_temp (gfc_expr
}
else
{
- /* Initialize count2. */
- gfc_add_modify_expr (&block, count2, gfc_index_zero_node);
-
/* Initialize the loop. */
gfc_init_loopinfo (&loop);
@@ -1689,8 +1678,7 @@ generate_loop_for_rhs_to_temp (gfc_expr
gfc_conv_expr (&rse, expr2);
/* Form the expression of the temporary. */
- index = fold_build2 (PLUS_EXPR, gfc_array_index_type, count1, count2);
- lse.expr = gfc_build_array_ref (tmp1, index);
+ lse.expr = gfc_build_array_ref (tmp1, count1);
}
/* Use the scalar assignment. */
@@ -1702,12 +1690,12 @@ generate_loop_for_rhs_to_temp (gfc_expr
wheremaskexpr = gfc_build_array_ref (wheremask, count3);
tmp2 = TREE_CHAIN (wheremask);
while (tmp2)
- {
- tmp1 = gfc_build_array_ref (tmp2, count3);
- wheremaskexpr = build2 (TRUTH_AND_EXPR, TREE_TYPE (tmp1),
+ {
+ tmp1 = gfc_build_array_ref (tmp2, count3);
+ wheremaskexpr = build2 (TRUTH_AND_EXPR, TREE_TYPE (tmp1),
wheremaskexpr, tmp1);
- tmp2 = TREE_CHAIN (tmp2);
- }
+ tmp2 = TREE_CHAIN (tmp2);
+ }
tmp = build3_v (COND_EXPR, wheremaskexpr, tmp, build_empty_stmt ());
}
@@ -1716,21 +1704,26 @@ generate_loop_for_rhs_to_temp (gfc_expr
if (lss == gfc_ss_terminator)
{
gfc_add_block_to_block (&block, &body1);
+
+ /* Increment count1. */
+ tmp = fold_build2 (PLUS_EXPR, TREE_TYPE (count1), count1,
+ gfc_index_one_node);
+ gfc_add_modify_expr (&block, count1, tmp);
}
else
{
- /* Increment count2. */
+ /* Increment count1. */
tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type,
- count2, gfc_index_one_node);
- gfc_add_modify_expr (&body1, count2, tmp);
+ count1, gfc_index_one_node);
+ gfc_add_modify_expr (&body1, count1, tmp);
/* Increment count3. */
if (count3)
- {
- tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type,
+ {
+ tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type,
count3, gfc_index_one_node);
- gfc_add_modify_expr (&body1, count3, tmp);
- }
+ gfc_add_modify_expr (&body1, count3, tmp);
+ }
/* Generate the copying loops. */
gfc_trans_scalarizing_loops (&loop, &body1);
@@ -1740,11 +1733,8 @@ generate_loop_for_rhs_to_temp (gfc_expr
gfc_cleanup_loop (&loop);
/* TODO: Reuse lss and rss when copying temp->lhs. Need to be careful
- as tree nodes in SS may not be valid in different scope. */
+ as tree nodes in SS may not be valid in different scope. */
}
- /* Increment count1. */
- tmp = fold_build2 (PLUS_EXPR, TREE_TYPE (count1), count1, size);
- gfc_add_modify_expr (&block, count1, tmp);
tmp = gfc_finish_block (&block);
return tmp;
@@ -1822,7 +1812,7 @@ compute_inner_temp_size (gfc_expr *expr1
static tree
compute_overall_iter_number (forall_info *nested_forall_info, tree inner_size,
- stmtblock_t *block)
+ stmtblock_t *inner_size_body, stmtblock_t *block)
{
tree tmp, number;
stmtblock_t body;
@@ -1832,6 +1822,8 @@ compute_overall_iter_number (forall_info
gfc_add_modify_expr (block, number, gfc_index_zero_node);
gfc_start_block (&body);
+ if (inner_size_body)
+ gfc_add_block_to_block (&body, inner_size_body);
if (nested_forall_info)
tmp = build2 (PLUS_EXPR, gfc_array_index_type, number,
inner_size);
@@ -1856,8 +1848,8 @@ compute_overall_iter_number (forall_info
static tree
allocate_temp_for_forall_nest (forall_info * nested_forall_info, tree type,
- tree inner_size, stmtblock_t * block,
- tree * ptemp1)
+ tree inner_size, stmtblock_t * inner_size_body,
+ stmtblock_t * block, tree * ptemp1)
{
tree unit;
tree temp1;
@@ -1865,7 +1857,8 @@ allocate_temp_for_forall_nest (forall_in
tree bytesize, size;
/* Calculate the total size of temporary needed in forall construct. */
- size = compute_overall_iter_number (nested_forall_info, inner_size, block);
+ size = compute_overall_iter_number (nested_forall_info, inner_size,
+ inner_size_body, block);
unit = TYPE_SIZE_UNIT (type);
bytesize = fold_build2 (MULT_EXPR, gfc_array_index_type, size, unit);
@@ -1891,17 +1884,16 @@ gfc_trans_assign_need_temp (gfc_expr * e
tree type;
tree inner_size;
gfc_ss *lss, *rss;
- tree count, count1, count2;
+ tree count, count1;
tree tmp, tmp1;
tree ptemp1;
tree mask, maskindex;
forall_info *forall_tmp;
+ stmtblock_t inner_size_body;
- /* Create vars. count1 is the current iterator number of the nested forall.
- count2 is the current iterator number of the inner loops needed in the
- assignment. */
+ /* Create vars. count1 is the current iterator number of the nested
+ forall. */
count1 = gfc_create_var (gfc_array_index_type, "count1");
- count2 = gfc_create_var (gfc_array_index_type, "count2");
/* Count is the wheremask index. */
if (wheremask)
@@ -1917,15 +1909,17 @@ gfc_trans_assign_need_temp (gfc_expr * e
/* Calculate the size of temporary needed in the assignment. Return loop, lss
and rss which are used in function generate_loop_for_rhs_to_temp(). */
- inner_size = compute_inner_temp_size (expr1, expr2, block, &lss, &rss);
+ gfc_init_block (&inner_size_body);
+ inner_size = compute_inner_temp_size (expr1, expr2, &inner_size_body,
+ &lss, &rss);
/* The type of LHS. Used in function allocate_temp_for_forall_nest */
type = gfc_typenode_for_spec (&expr1->ts);
/* Allocate temporary for nested forall construct according to the
information in nested_forall_info and inner_size. */
- tmp1 = allocate_temp_for_forall_nest (nested_forall_info, type,
- inner_size, block, &ptemp1);
+ tmp1 = allocate_temp_for_forall_nest (nested_forall_info, type, inner_size,
+ &inner_size_body, block, &ptemp1);
/* Initialize the maskindexes. */
forall_tmp = nested_forall_info;
@@ -1939,8 +1933,8 @@ gfc_trans_assign_need_temp (gfc_expr * e
}
/* Generate codes to copy rhs to the temporary . */
- tmp = generate_loop_for_rhs_to_temp (expr2, tmp1, inner_size, count,
- count1, count2, lss, rss, wheremask);
+ tmp = generate_loop_for_rhs_to_temp (expr2, tmp1, count, count1, lss, rss,
+ wheremask);
/* Generate body and loops according to the information in
nested_forall_info. */
@@ -1966,8 +1960,7 @@ gfc_trans_assign_need_temp (gfc_expr * e
gfc_add_modify_expr (block, count, gfc_index_zero_node);
/* Generate codes to copy the temporary to lhs. */
- tmp = generate_loop_for_temp_to_lhs (expr1, tmp1, inner_size, count,
- count1, count2, wheremask);
+ tmp = generate_loop_for_temp_to_lhs (expr1, tmp1, count, count1, wheremask);
/* Generate body and loops according to the information in
nested_forall_info. */
@@ -2020,8 +2013,8 @@ gfc_trans_pointer_assign_need_temp (gfc_
/* Allocate temporary for nested forall construct according to the
information in nested_forall_info and inner_size. */
- tmp1 = allocate_temp_for_forall_nest (nested_forall_info,
- type, inner_size, block, &ptemp1);
+ tmp1 = allocate_temp_for_forall_nest (nested_forall_info, type,
+ inner_size, NULL, block, &ptemp1);
gfc_start_block (&body);
gfc_init_se (&lse, NULL);
lse.expr = gfc_build_array_ref (tmp1, count);
@@ -2110,7 +2103,7 @@ gfc_trans_pointer_assign_need_temp (gfc_
/* Allocate temporary for nested forall construct. */
tmp1 = allocate_temp_for_forall_nest (nested_forall_info, parmtype,
- inner_size, block, &ptemp1);
+ inner_size, NULL, block, &ptemp1);
gfc_start_block (&body);
gfc_init_se (&lse, NULL);
lse.expr = gfc_build_array_ref (tmp1, count);
@@ -2580,7 +2573,7 @@ gfc_evaluate_where_mask (gfc_expr * me,
/* Allocate temporary for where mask. */
tmp = allocate_temp_for_forall_nest (nested_forall_info, boolean_type_node,
- inner_size, block, &ptemp1);
+ inner_size, NULL, block, &ptemp1);
/* Record the temporary address in order to free it later. */
if (ptemp1)
{
@@ -2593,7 +2586,7 @@ gfc_evaluate_where_mask (gfc_expr * me,
/* Allocate temporary for !mask. */
ntmp = allocate_temp_for_forall_nest (nested_forall_info, boolean_type_node,
- inner_size, block, &ptemp2);
+ inner_size, NULL, block, &ptemp2);
/* Record the temporary in order to free it later. */
if (ptemp2)
{
Jakub