Skip to content

R
riscv-gcc-1
Commit 011daa76 by Roger Sayle Committed by Roger Sayle
Options

trans-stmt.c (generate_loop_for_temp_to_lhs): Add an additional INVERT argument… 

trans-stmt.c (generate_loop_for_temp_to_lhs): Add an additional INVERT argument to invert the sense of the WHEREMASK argument.


	* trans-stmt.c (generate_loop_for_temp_to_lhs): Add an additional
	INVERT argument to invert the sense of the WHEREMASK argument.
	Remove unneeded code to AND together a list of masks.
	(generate_loop_for_rhs_to_temp): Likewise.
	(gfc_trans_assign_need_temp): Likewise.
	(gfc_trans_forall_1): Likewise.
	(gfc_evaluate_where_mask): Likewise, add a new INVERT argument
	to specify the sense of the MASK argument.
	(gfc_trans_where_assign): Likewise.
	(gfc_trans_where_2): Likewise.  Restructure code that decides
	whether we need to allocate zero, one or two temporary masks.
	If this is a top-level WHERE (i.e. the incoming MAKS is NULL),
	we only need to allocate at most one temporary mask, and can
	invert it's sense to provide the complementary pending execution
	mask.  Only calculate the size of the required temporary arrays
	if we need any.
	(gfc_trans_where): Update call to gfc_trans_where_2.

From-SVN: r111630
parent 7362e452
Showing with 148 additions and 68 deletions
gcc/fortran/ChangeLog
2006-03-01 Roger Sayle <roger@eyesopen.com>
* trans-stmt.c (generate_loop_for_temp_to_lhs): Add an additional
INVERT argument to invert the sense of the WHEREMASK argument.
Remove unneeded code to AND together a list of masks.
(generate_loop_for_rhs_to_temp): Likewise.
(gfc_trans_assign_need_temp): Likewise.
(gfc_trans_forall_1): Likewise.
(gfc_evaluate_where_mask): Likewise, add a new INVERT argument
to specify the sense of the MASK argument.
(gfc_trans_where_assign): Likewise.
(gfc_trans_where_2): Likewise. Restructure code that decides
whether we need to allocate zero, one or two temporary masks.
If this is a top-level WHERE (i.e. the incoming MAKS is NULL),
we only need to allocate at most one temporary mask, and can
invert it's sense to provide the complementary pending execution
mask. Only calculate the size of the required temporary arrays
if we need any.
(gfc_trans_where): Update call to gfc_trans_where_2.
2006-03-01 Paul Thomas <pault@gcc.gnu.org> 2006-03-01 Paul Thomas <pault@gcc.gnu.org>
* iresolve.c (gfc_resolve_dot_product): Remove any difference in * iresolve.c (gfc_resolve_dot_product): Remove any difference in
......
gcc/fortran/trans-stmt.c
...@@ -62,7 +62,8 @@ typedef struct forall_info ...@@ -62,7 +62,8 @@ typedef struct forall_info
} }
forall_info; forall_info;
static void gfc_trans_where_2 (gfc_code *, tree, forall_info *, stmtblock_t *); static void gfc_trans_where_2 (gfc_code *, tree, bool,
forall_info *, stmtblock_t *);
/* Translate a F95 label number to a LABEL_EXPR. */ /* Translate a F95 label number to a LABEL_EXPR. */
...@@ -1602,13 +1603,13 @@ gfc_do_allocate (tree bytesize, tree size, tree * pdata, stmtblock_t * pblock, ...@@ -1602,13 +1603,13 @@ gfc_do_allocate (tree bytesize, tree size, tree * pdata, stmtblock_t * pblock,
static tree static tree
generate_loop_for_temp_to_lhs (gfc_expr *expr, tree tmp1, tree count3, generate_loop_for_temp_to_lhs (gfc_expr *expr, tree tmp1, tree count3,
tree count1, tree wheremask) tree count1, tree wheremask, bool invert)
{ {
gfc_ss *lss; gfc_ss *lss;
gfc_se lse, rse; gfc_se lse, rse;
stmtblock_t block, body; stmtblock_t block, body;
gfc_loopinfo loop1; gfc_loopinfo loop1;
tree tmp, tmp2; tree tmp;
tree wheremaskexpr; tree wheremaskexpr;
/* Walk the lhs. */ /* Walk the lhs. */
...@@ -1676,14 +1677,10 @@ generate_loop_for_temp_to_lhs (gfc_expr *expr, tree tmp1, tree count3, ...@@ -1676,14 +1677,10 @@ generate_loop_for_temp_to_lhs (gfc_expr *expr, tree tmp1, tree count3,
if (wheremask) if (wheremask)
{ {
wheremaskexpr = gfc_build_array_ref (wheremask, count3); wheremaskexpr = gfc_build_array_ref (wheremask, count3);
tmp2 = TREE_CHAIN (wheremask); if (invert)
while (tmp2) wheremaskexpr = fold_build1 (TRUTH_NOT_EXPR,
{ TREE_TYPE (wheremaskexpr),
tmp1 = gfc_build_array_ref (tmp2, count3); wheremaskexpr);
wheremaskexpr = fold_build2 (TRUTH_AND_EXPR, TREE_TYPE (tmp1),
wheremaskexpr, tmp1);
tmp2 = TREE_CHAIN (tmp2);
}
tmp = fold_build3 (COND_EXPR, void_type_node, tmp = fold_build3 (COND_EXPR, void_type_node,
wheremaskexpr, tmp, build_empty_stmt ()); wheremaskexpr, tmp, build_empty_stmt ());
} }
...@@ -1715,20 +1712,21 @@ generate_loop_for_temp_to_lhs (gfc_expr *expr, tree tmp1, tree count3, ...@@ -1715,20 +1712,21 @@ generate_loop_for_temp_to_lhs (gfc_expr *expr, tree tmp1, tree count3,
} }
/* Generate codes to copy rhs to the temporary. TMP1 is the address of temporary /* Generate codes to copy rhs to the temporary. TMP1 is the address of
LSS and RSS are formed in function compute_inner_temp_size(), and should temporary, LSS and RSS are formed in function compute_inner_temp_size(),
not be freed. */ and should not be freed. WHEREMASK is the conditional execution mask
whose sense may be inverted by INVERT. */
static tree static tree
generate_loop_for_rhs_to_temp (gfc_expr *expr2, tree tmp1, tree count3, generate_loop_for_rhs_to_temp (gfc_expr *expr2, tree tmp1, tree count3,
tree count1, gfc_ss *lss, gfc_ss *rss, tree count1, gfc_ss *lss, gfc_ss *rss,
tree wheremask) tree wheremask, bool invert)
{ {
stmtblock_t block, body1; stmtblock_t block, body1;
gfc_loopinfo loop; gfc_loopinfo loop;
gfc_se lse; gfc_se lse;
gfc_se rse; gfc_se rse;
tree tmp, tmp2; tree tmp;
tree wheremaskexpr; tree wheremaskexpr;
gfc_start_block (&block); gfc_start_block (&block);
...@@ -1774,14 +1772,10 @@ generate_loop_for_rhs_to_temp (gfc_expr *expr2, tree tmp1, tree count3, ...@@ -1774,14 +1772,10 @@ generate_loop_for_rhs_to_temp (gfc_expr *expr2, tree tmp1, tree count3,
if (wheremask) if (wheremask)
{ {
wheremaskexpr = gfc_build_array_ref (wheremask, count3); wheremaskexpr = gfc_build_array_ref (wheremask, count3);
tmp2 = TREE_CHAIN (wheremask); if (invert)
while (tmp2) wheremaskexpr = fold_build1 (TRUTH_NOT_EXPR,
{ TREE_TYPE (wheremaskexpr),
tmp1 = gfc_build_array_ref (tmp2, count3); wheremaskexpr);
wheremaskexpr = fold_build2 (TRUTH_AND_EXPR, TREE_TYPE (tmp1),
wheremaskexpr, tmp1);
tmp2 = TREE_CHAIN (tmp2);
}
tmp = fold_build3 (COND_EXPR, void_type_node, tmp = fold_build3 (COND_EXPR, void_type_node,
wheremaskexpr, tmp, build_empty_stmt ()); wheremaskexpr, tmp, build_empty_stmt ());
} }
...@@ -2007,7 +2001,8 @@ allocate_temp_for_forall_nest (forall_info * nested_forall_info, tree type, ...@@ -2007,7 +2001,8 @@ allocate_temp_for_forall_nest (forall_info * nested_forall_info, tree type,
DEALLOCATE (tmp) DEALLOCATE (tmp)
*/ */
static void static void
gfc_trans_assign_need_temp (gfc_expr * expr1, gfc_expr * expr2, tree wheremask, gfc_trans_assign_need_temp (gfc_expr * expr1, gfc_expr * expr2,
tree wheremask, bool invert,
forall_info * nested_forall_info, forall_info * nested_forall_info,
stmtblock_t * block) stmtblock_t * block)
{ {
...@@ -2051,7 +2046,7 @@ gfc_trans_assign_need_temp (gfc_expr * expr1, gfc_expr * expr2, tree wheremask, ...@@ -2051,7 +2046,7 @@ gfc_trans_assign_need_temp (gfc_expr * expr1, gfc_expr * expr2, tree wheremask,
/* Generate codes to copy rhs to the temporary . */ /* Generate codes to copy rhs to the temporary . */
tmp = generate_loop_for_rhs_to_temp (expr2, tmp1, count, count1, lss, rss, tmp = generate_loop_for_rhs_to_temp (expr2, tmp1, count, count1, lss, rss,
wheremask); wheremask, invert);
/* Generate body and loops according to the information in /* Generate body and loops according to the information in
nested_forall_info. */ nested_forall_info. */
...@@ -2066,7 +2061,8 @@ gfc_trans_assign_need_temp (gfc_expr * expr1, gfc_expr * expr2, tree wheremask, ...@@ -2066,7 +2061,8 @@ gfc_trans_assign_need_temp (gfc_expr * expr1, gfc_expr * expr2, tree wheremask,
gfc_add_modify_expr (block, count, gfc_index_zero_node); gfc_add_modify_expr (block, count, gfc_index_zero_node);
/* Generate codes to copy the temporary to lhs. */ /* Generate codes to copy the temporary to lhs. */
tmp = generate_loop_for_temp_to_lhs (expr1, tmp1, count, count1, wheremask); tmp = generate_loop_for_temp_to_lhs (expr1, tmp1, count, count1,
wheremask, invert);
/* Generate body and loops according to the information in /* Generate body and loops according to the information in
nested_forall_info. */ nested_forall_info. */
...@@ -2499,7 +2495,7 @@ gfc_trans_forall_1 (gfc_code * code, forall_info * nested_forall_info) ...@@ -2499,7 +2495,7 @@ gfc_trans_forall_1 (gfc_code * code, forall_info * nested_forall_info)
/* Temporaries due to array assignment data dependencies introduce /* Temporaries due to array assignment data dependencies introduce
no end of problems. */ no end of problems. */
if (need_temp) if (need_temp)
gfc_trans_assign_need_temp (c->expr, c->expr2, NULL, gfc_trans_assign_need_temp (c->expr, c->expr2, NULL, false,
nested_forall_info, &block); nested_forall_info, &block);
else else
{ {
...@@ -2515,7 +2511,7 @@ gfc_trans_forall_1 (gfc_code * code, forall_info * nested_forall_info) ...@@ -2515,7 +2511,7 @@ gfc_trans_forall_1 (gfc_code * code, forall_info * nested_forall_info)
case EXEC_WHERE: case EXEC_WHERE:
/* Translate WHERE or WHERE construct nested in FORALL. */ /* Translate WHERE or WHERE construct nested in FORALL. */
gfc_trans_where_2 (c, NULL, nested_forall_info, &block); gfc_trans_where_2 (c, NULL, false, nested_forall_info, &block);
break; break;
/* Pointer assignment inside FORALL. */ /* Pointer assignment inside FORALL. */
...@@ -2595,14 +2591,15 @@ tree gfc_trans_forall (gfc_code * code) ...@@ -2595,14 +2591,15 @@ tree gfc_trans_forall (gfc_code * code)
needed by the WHERE mask expression multiplied by the iterator number of needed by the WHERE mask expression multiplied by the iterator number of
the nested forall. the nested forall.
ME is the WHERE mask expression. ME is the WHERE mask expression.
MASK is the current execution mask upon input. MASK is the current execution mask upon input, whose sense may or may
not be inverted as specified by the INVERT argument.
CMASK is the updated execution mask on output, or NULL if not required. CMASK is the updated execution mask on output, or NULL if not required.
PMASK is the pending execution mask on output, or NULL if not required. PMASK is the pending execution mask on output, or NULL if not required.
BLOCK is the block in which to place the condition evaluation loops. */ BLOCK is the block in which to place the condition evaluation loops. */
static void static void
gfc_evaluate_where_mask (gfc_expr * me, forall_info * nested_forall_info, gfc_evaluate_where_mask (gfc_expr * me, forall_info * nested_forall_info,
tree mask, tree cmask, tree pmask, tree mask, bool invert, tree cmask, tree pmask,
tree mask_type, stmtblock_t * block) tree mask_type, stmtblock_t * block)
{ {
tree tmp, tmp1; tree tmp, tmp1;
...@@ -2667,6 +2664,8 @@ gfc_evaluate_where_mask (gfc_expr * me, forall_info * nested_forall_info, ...@@ -2667,6 +2664,8 @@ gfc_evaluate_where_mask (gfc_expr * me, forall_info * nested_forall_info,
if (mask && (cmask || pmask)) if (mask && (cmask || pmask))
{ {
tmp = gfc_build_array_ref (mask, count); tmp = gfc_build_array_ref (mask, count);
if (invert)
tmp = fold_build1 (TRUTH_NOT_EXPR, mask_type, tmp);
gfc_add_modify_expr (&body1, mtmp, tmp); gfc_add_modify_expr (&body1, mtmp, tmp);
} }
...@@ -2724,10 +2723,12 @@ gfc_evaluate_where_mask (gfc_expr * me, forall_info * nested_forall_info, ...@@ -2724,10 +2723,12 @@ gfc_evaluate_where_mask (gfc_expr * me, forall_info * nested_forall_info,
/* Translate an assignment statement in a WHERE statement or construct /* Translate an assignment statement in a WHERE statement or construct
statement. The MASK expression is used to control which elements statement. The MASK expression is used to control which elements
of EXPR1 shall be assigned. */ of EXPR1 shall be assigned. The sense of MASK is specified by
INVERT. */
static tree static tree
gfc_trans_where_assign (gfc_expr *expr1, gfc_expr *expr2, tree mask, gfc_trans_where_assign (gfc_expr *expr1, gfc_expr *expr2,
tree mask, bool invert,
tree count1, tree count2) tree count1, tree count2)
{ {
gfc_se lse; gfc_se lse;
...@@ -2838,6 +2839,8 @@ gfc_trans_where_assign (gfc_expr *expr1, gfc_expr *expr2, tree mask, ...@@ -2838,6 +2839,8 @@ gfc_trans_where_assign (gfc_expr *expr1, gfc_expr *expr2, tree mask,
/* Form the mask expression according to the mask. */ /* Form the mask expression according to the mask. */
index = count1; index = count1;
maskexpr = gfc_build_array_ref (mask, index); maskexpr = gfc_build_array_ref (mask, index);
if (invert)
maskexpr = fold_build1 (TRUTH_NOT_EXPR, TREE_TYPE (maskexpr), maskexpr);
/* Use the scalar assignment as is. */ /* Use the scalar assignment as is. */
tmp = gfc_trans_scalar_assign (&lse, &rse, expr1->ts.type); tmp = gfc_trans_scalar_assign (&lse, &rse, expr1->ts.type);
...@@ -2888,6 +2891,9 @@ gfc_trans_where_assign (gfc_expr *expr1, gfc_expr *expr2, tree mask, ...@@ -2888,6 +2891,9 @@ gfc_trans_where_assign (gfc_expr *expr1, gfc_expr *expr2, tree mask,
/* Form the mask expression according to the mask tree list. */ /* Form the mask expression according to the mask tree list. */
index = count2; index = count2;
maskexpr = gfc_build_array_ref (mask, index); maskexpr = gfc_build_array_ref (mask, index);
if (invert)
maskexpr = fold_build1 (TRUTH_NOT_EXPR, TREE_TYPE (maskexpr),
maskexpr);
/* Use the scalar assignment as is. */ /* Use the scalar assignment as is. */
tmp = gfc_trans_scalar_assign (&lse, &rse, expr1->ts.type); tmp = gfc_trans_scalar_assign (&lse, &rse, expr1->ts.type);
...@@ -2926,7 +2932,7 @@ gfc_trans_where_assign (gfc_expr *expr1, gfc_expr *expr2, tree mask, ...@@ -2926,7 +2932,7 @@ gfc_trans_where_assign (gfc_expr *expr1, gfc_expr *expr2, tree mask,
MASK is the control mask. */ MASK is the control mask. */
static void static void
gfc_trans_where_2 (gfc_code * code, tree mask, gfc_trans_where_2 (gfc_code * code, tree mask, bool invert,
forall_info * nested_forall_info, stmtblock_t * block) forall_info * nested_forall_info, stmtblock_t * block)
{ {
stmtblock_t inner_size_body; stmtblock_t inner_size_body;
...@@ -2939,6 +2945,8 @@ gfc_trans_where_2 (gfc_code * code, tree mask, ...@@ -2939,6 +2945,8 @@ gfc_trans_where_2 (gfc_code * code, tree mask,
gfc_code *cnext; gfc_code *cnext;
tree tmp; tree tmp;
tree count1, count2; tree count1, count2;
bool need_cmask;
bool need_pmask;
int need_temp; int need_temp;
tree pcmask = NULL_TREE; tree pcmask = NULL_TREE;
tree ppmask = NULL_TREE; tree ppmask = NULL_TREE;
...@@ -2948,6 +2956,49 @@ gfc_trans_where_2 (gfc_code * code, tree mask, ...@@ -2948,6 +2956,49 @@ gfc_trans_where_2 (gfc_code * code, tree mask,
/* the WHERE statement or the WHERE construct statement. */ /* the WHERE statement or the WHERE construct statement. */
cblock = code->block; cblock = code->block;
/* As the mask array can be very big, prefer compact boolean types. */
mask_type = gfc_get_logical_type (gfc_logical_kinds[0].kind);
/* Determine which temporary masks are needed. */
if (!cblock->block)
{
/* One clause: No ELSEWHEREs. */
need_cmask = (cblock->next != 0);
need_pmask = false;
}
else if (cblock->block->block)
{
/* Three or more clauses: Conditional ELSEWHEREs. */
need_cmask = true;
need_pmask = true;
}
else if (cblock->next)
{
/* Two clauses, the first non-empty. */
need_cmask = true;
need_pmask = (mask != NULL_TREE
&& cblock->block->next != 0);
}
else if (!cblock->block->next)
{
/* Two clauses, both empty. */
need_cmask = false;
need_pmask = false;
}
/* Two clauses, the first empty, the second non-empty. */
else if (mask)
{
need_cmask = (cblock->block->expr != 0);
need_pmask = true;
}
else
{
need_cmask = true;
need_pmask = false;
}
if (need_cmask || need_pmask)
{
/* Calculate the size of temporary needed by the mask-expr. */ /* Calculate the size of temporary needed by the mask-expr. */
gfc_init_block (&inner_size_body); gfc_init_block (&inner_size_body);
inner_size = compute_inner_temp_size (cblock->expr, cblock->expr, inner_size = compute_inner_temp_size (cblock->expr, cblock->expr,
...@@ -2957,42 +3008,23 @@ gfc_trans_where_2 (gfc_code * code, tree mask, ...@@ -2957,42 +3008,23 @@ gfc_trans_where_2 (gfc_code * code, tree mask,
size = compute_overall_iter_number (nested_forall_info, inner_size, size = compute_overall_iter_number (nested_forall_info, inner_size,
&inner_size_body, block); &inner_size_body, block);
/* As the mask array can be very big, prefer compact boolean types. */ /* Allocate temporary for WHERE mask if needed. */
mask_type = gfc_get_logical_type (gfc_logical_kinds[0].kind); if (need_cmask)
/* Allocate temporary for WHERE mask. We only need a "cmask" if
there are statements to be executed. The following test only
checks the first ELSEWHERE to catch the F90 cases. */
if (cblock->next
|| (cblock->block && cblock->block->next && cblock->block->expr)
|| (cblock->block && cblock->block->block))
{
cmask = allocate_temp_for_forall_nest_1 (mask_type, size, block, cmask = allocate_temp_for_forall_nest_1 (mask_type, size, block,
&pcmask); &pcmask);
}
else
{
pcmask = NULL_TREE;
cmask = NULL_TREE;
}
/* Allocate temporary for !mask. We only need a "pmask" if there /* Allocate temporary for !mask if needed. */
is an ELSEWHERE clause containing executable statements. Again if (need_pmask)
we only lookahead a single ELSEWHERE to catch the F90 cases. */
if ((cblock->block && cblock->block->next)
|| (cblock->block && cblock->block->block))
{
pmask = allocate_temp_for_forall_nest_1 (mask_type, size, block, pmask = allocate_temp_for_forall_nest_1 (mask_type, size, block,
&ppmask); &ppmask);
} }
else
{
ppmask = NULL_TREE;
pmask = NULL_TREE;
}
while (cblock) while (cblock)
{ {
/* Each time around this loop, the where clause is conditional
on the value of mask and invert, which are updated at the
bottom of the loop. */
/* Has mask-expr. */ /* Has mask-expr. */
if (cblock->expr) if (cblock->expr)
{ {
...@@ -3001,16 +3033,28 @@ gfc_trans_where_2 (gfc_code * code, tree mask, ...@@ -3001,16 +3033,28 @@ gfc_trans_where_2 (gfc_code * code, tree mask,
then we don't need to update the control mask (cmask). then we don't need to update the control mask (cmask).
If this is the last clause of the WHERE construct, then If this is the last clause of the WHERE construct, then
we don't need to update the pending control mask (pmask). */ we don't need to update the pending control mask (pmask). */
gfc_evaluate_where_mask (cblock->expr, nested_forall_info, mask, if (mask)
gfc_evaluate_where_mask (cblock->expr, nested_forall_info,
mask, invert,
cblock->next ? cmask : NULL_TREE, cblock->next ? cmask : NULL_TREE,
cblock->block ? pmask : NULL_TREE, cblock->block ? pmask : NULL_TREE,
mask_type, block); mask_type, block);
else
gfc_evaluate_where_mask (cblock->expr, nested_forall_info,
NULL_TREE, false,
(cblock->next || cblock->block)
? cmask : NULL_TREE,
NULL_TREE, mask_type, block);
invert = false;
} }
/* It's a final elsewhere-stmt. No mask-expr is present. */ /* It's a final elsewhere-stmt. No mask-expr is present. */
else else
cmask = mask; cmask = mask;
/* The body of this where clause are controlled by cmask with
sense specified by invert. */
/* Get the assignment statement of a WHERE statement, or the first /* Get the assignment statement of a WHERE statement, or the first
statement in where-body-construct of a WHERE construct. */ statement in where-body-construct of a WHERE construct. */
cnext = cblock->next; cnext = cblock->next;
...@@ -3026,7 +3070,8 @@ gfc_trans_where_2 (gfc_code * code, tree mask, ...@@ -3026,7 +3070,8 @@ gfc_trans_where_2 (gfc_code * code, tree mask,
{ {
need_temp = gfc_check_dependency (expr1, expr2, 0); need_temp = gfc_check_dependency (expr1, expr2, 0);
if (need_temp) if (need_temp)
gfc_trans_assign_need_temp (expr1, expr2, cmask, gfc_trans_assign_need_temp (expr1, expr2,
cmask, invert,
nested_forall_info, block); nested_forall_info, block);
else else
{ {
...@@ -3036,7 +3081,8 @@ gfc_trans_where_2 (gfc_code * code, tree mask, ...@@ -3036,7 +3081,8 @@ gfc_trans_where_2 (gfc_code * code, tree mask,
gfc_add_modify_expr (block, count1, gfc_index_zero_node); gfc_add_modify_expr (block, count1, gfc_index_zero_node);
gfc_add_modify_expr (block, count2, gfc_index_zero_node); gfc_add_modify_expr (block, count2, gfc_index_zero_node);
tmp = gfc_trans_where_assign (expr1, expr2, cmask, tmp = gfc_trans_where_assign (expr1, expr2,
cmask, invert,
count1, count2); count1, count2);
tmp = gfc_trans_nested_forall_loop (nested_forall_info, tmp = gfc_trans_nested_forall_loop (nested_forall_info,
...@@ -3052,7 +3098,8 @@ gfc_trans_where_2 (gfc_code * code, tree mask, ...@@ -3052,7 +3098,8 @@ gfc_trans_where_2 (gfc_code * code, tree mask,
gfc_add_modify_expr (block, count1, gfc_index_zero_node); gfc_add_modify_expr (block, count1, gfc_index_zero_node);
gfc_add_modify_expr (block, count2, gfc_index_zero_node); gfc_add_modify_expr (block, count2, gfc_index_zero_node);
tmp = gfc_trans_where_assign (expr1, expr2, cmask, tmp = gfc_trans_where_assign (expr1, expr2,
cmask, invert,
count1, count2); count1, count2);
gfc_add_expr_to_block (block, tmp); gfc_add_expr_to_block (block, tmp);
...@@ -3061,8 +3108,8 @@ gfc_trans_where_2 (gfc_code * code, tree mask, ...@@ -3061,8 +3108,8 @@ gfc_trans_where_2 (gfc_code * code, tree mask,
/* WHERE or WHERE construct is part of a where-body-construct. */ /* WHERE or WHERE construct is part of a where-body-construct. */
case EXEC_WHERE: case EXEC_WHERE:
/* Ensure that MASK is not modified by next gfc_trans_where_2. */ gfc_trans_where_2 (cnext, cmask, invert,
gfc_trans_where_2 (cnext, cmask, nested_forall_info, block); nested_forall_info, block);
break; break;
default: default:
...@@ -3074,8 +3121,21 @@ gfc_trans_where_2 (gfc_code * code, tree mask, ...@@ -3074,8 +3121,21 @@ gfc_trans_where_2 (gfc_code * code, tree mask,
} }
/* The next masked-elsewhere-stmt, elsewhere-stmt, or end-where-stmt. */ /* The next masked-elsewhere-stmt, elsewhere-stmt, or end-where-stmt. */
cblock = cblock->block; cblock = cblock->block;
if (mask == NULL_TREE)
{
/* If we're the initial WHERE, we can simply invert the sense
of the current mask to obtain the "mask" for the remaining
ELSEWHEREs. */
invert = true;
mask = cmask;
}
else
{
/* Otherwise, for nested WHERE's we need to use the pending mask. */
invert = false;
mask = pmask; mask = pmask;
} }
}
/* If we allocated a pending mask array, deallocate it now. */ /* If we allocated a pending mask array, deallocate it now. */
if (ppmask) if (ppmask)
...@@ -3283,7 +3343,7 @@ gfc_trans_where (gfc_code * code) ...@@ -3283,7 +3343,7 @@ gfc_trans_where (gfc_code * code)
gfc_start_block (&block); gfc_start_block (&block);
gfc_trans_where_2 (code, NULL, NULL, &block); gfc_trans_where_2 (code, NULL, false, NULL, &block);
return gfc_finish_block (&block); return gfc_finish_block (&block);
} }
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment