OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

trans-stmt.c (struct temporary_list): Delete.

Browse Source 
* trans-stmt.c (struct temporary_list): Delete.
	(gfc_trans_where_2): Major reorganization.  Remove no longer needed
	TEMP argument.  Allocate and deallocate the control mask and
	pending control mask locally.
	(gfc_trans_forall_1): Delete TEMP local variable, and update
	call to gfc_trans_where_2.  No need to deallocate arrays after.
	(gfc_evaluate_where_mask): Major reorganization.  Change return
	type to void.  Pass in parent execution mask, MASK, and two
	already allocated mask arrays CMASK and PMASK.  On return
	CMASK := MASK & COND, PMASK := MASK & !COND.  MASK, CMASK and
	CMASK may all be NULL, or refer to the same temporary arrays.
	(gfc_trans_where): Update call to gfc_trans_where_2.  We no
	longer need a TEMP variable or to deallocate temporary arrays
	allocated by gfc_trans_where_2.

From-SVN: r111245
This commit is contained in:
Roger Sayle 2006-02-18 17:26:35 +00:00 committed by Roger Sayle
parent 4ea42ebadb
commit 3891cee230
2 changed files with 136 additions and 176 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
gcc/fortran/ChangeLog
View File

@ -1,3 +1,20 @@
2006-02-18 Roger Sayle <roger@eyesopen.com>
* trans-stmt.c (struct temporary_list): Delete.
(gfc_trans_where_2): Major reorganization. Remove no longer needed
TEMP argument. Allocate and deallocate the control mask and
pending control mask locally.
(gfc_trans_forall_1): Delete TEMP local variable, and update
call to gfc_trans_where_2. No need to deallocate arrays after.
(gfc_evaluate_where_mask): Major reorganization. Change return
type to void. Pass in parent execution mask, MASK, and two
already allocated mask arrays CMASK and PMASK. On return
CMASK := MASK & COND, PMASK := MASK & !COND. MASK, CMASK and
CMASK may all be NULL, or refer to the same temporary arrays.
(gfc_trans_where): Update call to gfc_trans_where_2. We no
longer need a TEMP variable or to deallocate temporary arrays
allocated by gfc_trans_where_2.
2006-02-18 Danny Smith <dannysmith@users.sourceforeg.net>
* gfortran.h (gfc_add_attribute): Change uint to unsigned int.

295
gcc/fortran/trans-stmt.c
View File

@ -49,13 +49,6 @@ typedef struct iter_info
}
iter_info;
typedef struct temporary_list
{
tree temporary;
struct temporary_list *next;
}
temporary_list;
typedef struct forall_info
{
iter_info *this_loop;
@ -69,8 +62,7 @@ typedef struct forall_info
}
forall_info;
static void gfc_trans_where_2 (gfc_code *, tree, forall_info *,
stmtblock_t *, temporary_list **temp);
static void gfc_trans_where_2 (gfc_code *, tree, forall_info *, stmtblock_t *);
/* Translate a F95 label number to a LABEL_EXPR. */
@ -2317,7 +2309,6 @@ gfc_trans_forall_1 (gfc_code * code, forall_info * nested_forall_info)
gfc_saved_var *saved_vars;
iter_info *this_forall, *iter_tmp;
forall_info *info, *forall_tmp;
temporary_list *temp;
gfc_start_block (&block);
@ -2523,27 +2514,9 @@ gfc_trans_forall_1 (gfc_code * code, forall_info * nested_forall_info)
break;
case EXEC_WHERE:
/* Translate WHERE or WHERE construct nested in FORALL. */
temp = NULL;
gfc_trans_where_2 (c, NULL, nested_forall_info, &block, &temp);
while (temp)
{
tree args;
temporary_list *p;
/* Free the temporary. */
args = gfc_chainon_list (NULL_TREE, temp->temporary);
tmp = build_function_call_expr (gfor_fndecl_internal_free, args);
gfc_add_expr_to_block (&block, tmp);
p = temp;
temp = temp->next;
gfc_free (p);
}
break;
gfc_trans_where_2 (c, NULL, nested_forall_info, &block);
break;
/* Pointer assignment inside FORALL. */
case EXEC_POINTER_ASSIGN:
@ -2622,71 +2595,27 @@ tree gfc_trans_forall (gfc_code * code)
needed by the WHERE mask expression multiplied by the iterator number of
the nested forall.
ME is the WHERE mask expression.
MASK is the temporary whose value is mask's value.
NMASK is another temporary whose value is !mask, or NULL if not required.
TEMP records the temporary's address allocated in this function in order
to free them outside this function.
MASK, NMASK and TEMP are all OUT arguments. */
MASK is the current execution mask upon input.
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.
BLOCK is the block in which to place the condition evaluation loops. */
static tree
static void
gfc_evaluate_where_mask (gfc_expr * me, forall_info * nested_forall_info,
tree * mask, tree * nmask, temporary_list ** temp,
stmtblock_t * block)
tree mask, tree cmask, tree pmask,
tree mask_type, stmtblock_t * block)
{
tree tmp, tmp1;
gfc_ss *lss, *rss;
gfc_loopinfo loop;
tree ptemp1, ntmp, ptemp2;
tree inner_size, size;
stmtblock_t body, body1, inner_size_body;
stmtblock_t body, body1;
tree count, cond, mtmp;
gfc_se lse, rse;
tree mask_type;
tree count;
tree tmpexpr;
gfc_init_loopinfo (&loop);
/* Calculate the size of temporary needed by the mask-expr. */
gfc_init_block (&inner_size_body);
inner_size = compute_inner_temp_size (me, me, &inner_size_body, &lss, &rss);
/* Calculate the total size of temporary needed. */
size = compute_overall_iter_number (nested_forall_info, inner_size,
&inner_size_body, block);
/* As the mask array can be very big, prefer compact boolean types. */
mask_type = gfc_get_logical_type (gfc_logical_kinds[0].kind);
/* Allocate temporary for where mask. */
tmp = allocate_temp_for_forall_nest_1 (mask_type, size, block, &ptemp1);
/* Record the temporary address in order to free it later. */
if (ptemp1)
{
temporary_list *tempo;
tempo = (temporary_list *) gfc_getmem (sizeof (temporary_list));
tempo->temporary = ptemp1;
tempo->next = *temp;
*temp = tempo;
}
if (nmask)
{
/* Allocate temporary for !mask. */
ntmp = allocate_temp_for_forall_nest_1 (mask_type, size, block, &ptemp2);
/* Record the temporary in order to free it later. */
if (ptemp2)
{
temporary_list *tempo;
tempo = (temporary_list *) gfc_getmem (sizeof (temporary_list));
tempo->temporary = ptemp2;
tempo->next = *temp;
*temp = tempo;
}
}
else
ntmp = NULL_TREE;
lss = gfc_walk_expr (me);
rss = gfc_walk_expr (me);
/* Variable to index the temporary. */
count = gfc_create_var (gfc_array_index_type, "count");
@ -2723,22 +2652,46 @@ gfc_evaluate_where_mask (gfc_expr * me, forall_info * nested_forall_info,
rse.ss = rss;
gfc_conv_expr (&rse, me);
}
/* Form the expression of the temporary. */
lse.expr = gfc_build_array_ref (tmp, count);
/* Use the scalar assignment to fill temporary TMP. */
tmp1 = gfc_trans_scalar_assign (&lse, &rse, me->ts.type);
gfc_add_expr_to_block (&body1, tmp1);
/* Variable to evalate mask condition. */
cond = gfc_create_var (mask_type, "cond");
if (mask && (cmask || pmask))
mtmp = gfc_create_var (mask_type, "mask");
else mtmp = NULL_TREE;
if (nmask)
gfc_add_block_to_block (&body1, &lse.pre);
gfc_add_block_to_block (&body1, &rse.pre);
gfc_add_modify_expr (&body1, cond, fold_convert (mask_type, rse.expr));
if (mask && (cmask || pmask))
{
/* Fill temporary NTMP. */
tmp1 = build1 (TRUTH_NOT_EXPR, TREE_TYPE (lse.expr), lse.expr);
tmpexpr = gfc_build_array_ref (ntmp, count);
gfc_add_modify_expr (&body1, tmpexpr, tmp1);
tmp = gfc_build_array_ref (mask, count);
gfc_add_modify_expr (&body1, mtmp, tmp);
}
if (lss == gfc_ss_terminator)
if (cmask)
{
tmp1 = gfc_build_array_ref (cmask, count);
tmp = cond;
if (mask)
tmp = build2 (TRUTH_AND_EXPR, mask_type, mtmp, tmp);
gfc_add_modify_expr (&body1, tmp1, tmp);
}
if (pmask)
{
tmp1 = gfc_build_array_ref (pmask, count);
tmp = build1 (TRUTH_NOT_EXPR, mask_type, cond);
if (mask)
tmp = build2 (TRUTH_AND_EXPR, mask_type, mtmp, tmp);
gfc_add_modify_expr (&body1, tmp1, tmp);
}
gfc_add_block_to_block (&body1, &lse.post);
gfc_add_block_to_block (&body1, &rse.post);
if (lss == gfc_ss_terminator)
{
gfc_add_block_to_block (&body, &body1);
}
@ -2766,12 +2719,6 @@ gfc_evaluate_where_mask (gfc_expr * me, forall_info * nested_forall_info,
tmp1 = gfc_trans_nested_forall_loop (nested_forall_info, tmp1, 1, 1);
gfc_add_expr_to_block (block, tmp1);
*mask = tmp;
if (nmask)
*nmask = ntmp;
return tmp1;
}
@ -2999,80 +2946,76 @@ gfc_trans_where_assign (gfc_expr *expr1, gfc_expr *expr2, tree mask,
/* Translate the WHERE construct or statement.
This function can be called iteratively to translate the nested WHERE
construct or statement.
MASK is the control mask.
TEMP records the temporary address which must be freed later. */
MASK is the control mask. */
static void
gfc_trans_where_2 (gfc_code * code, tree mask,
forall_info * nested_forall_info, stmtblock_t * block,
temporary_list ** temp)
forall_info * nested_forall_info, stmtblock_t * block)
{
stmtblock_t inner_size_body;
tree inner_size, size;
gfc_ss *lss, *rss;
tree mask_type;
gfc_expr *expr1;
gfc_expr *expr2;
gfc_code *cblock;
gfc_code *cnext;
tree tmp, tmp1, tmp2;
tree tmp;
tree count1, count2;
tree mask_copy;
int need_temp;
tree *tmp1_ptr;
tree pmask;
pmask = NULL_TREE;
tree pcmask = NULL_TREE;
tree ppmask = NULL_TREE;
tree cmask = NULL_TREE;
tree pmask = NULL_TREE;
/* the WHERE statement or the WHERE construct statement. */
cblock = code->block;
/* Calculate the size of temporary needed by the mask-expr. */
gfc_init_block (&inner_size_body);
inner_size = compute_inner_temp_size (cblock->expr, cblock->expr,
&inner_size_body, &lss, &rss);
/* Calculate the total size of temporary needed. */
size = compute_overall_iter_number (nested_forall_info, inner_size,
&inner_size_body, block);
/* As the mask array can be very big, prefer compact boolean types. */
mask_type = gfc_get_logical_type (gfc_logical_kinds[0].kind);
/* Allocate temporary for where mask. */
cmask = allocate_temp_for_forall_nest_1 (mask_type, size, block, &pcmask);
if (cblock->block)
{
/* Allocate temporary for !mask. */
pmask = allocate_temp_for_forall_nest_1 (mask_type, size, block,
&ppmask);
}
else
{
ppmask = NULL_TREE;
pmask = NULL_TREE;
}
while (cblock)
{
/* Has mask-expr. */
if (cblock->expr)
{
/* If this is the last clause of the WHERE construct, then
we don't need to allocate/populate/deallocate a complementary
pending control mask (pmask). */
we don't need to update the pending control mask (pmask). */
if (! cblock->block)
{
tmp1 = NULL_TREE;
tmp1_ptr = NULL;
}
else
tmp1_ptr = &tmp1;
pmask = NULL_TREE;
/* Ensure that the WHERE mask be evaluated only once. */
tmp2 = gfc_evaluate_where_mask (cblock->expr, nested_forall_info,
&tmp, tmp1_ptr, temp, block);
gfc_evaluate_where_mask (cblock->expr, nested_forall_info,
mask, cmask, pmask, mask_type, block);
/* Set the control mask and the pending control mask. */
/* It's a where-stmt. */
if (mask == NULL)
{
mask = tmp;
pmask = tmp1;
}
/* It's a nested where-stmt. */
else if (mask && pmask == NULL)
{
tree tmp2;
/* Use the TREE_CHAIN to list the masks. */
tmp2 = copy_list (mask);
pmask = chainon (mask, tmp1);
mask = chainon (tmp2, tmp);
}
/* It's a masked-elsewhere-stmt. */
else if (mask && cblock->expr)
{
tree tmp2;
tmp2 = copy_list (pmask);
mask = pmask;
tmp2 = chainon (tmp2, tmp);
pmask = chainon (mask, tmp1);
mask = tmp2;
}
}
/* It's a elsewhere-stmt. No mask-expr is present. */
else
mask = pmask;
cmask = mask;
/* Get the assignment statement of a WHERE statement, or the first
statement in where-body-construct of a WHERE construct. */
@ -3089,7 +3032,7 @@ gfc_trans_where_2 (gfc_code * code, tree mask,
{
need_temp = gfc_check_dependency (expr1, expr2, 0);
if (need_temp)
gfc_trans_assign_need_temp (expr1, expr2, mask,
gfc_trans_assign_need_temp (expr1, expr2, cmask,
nested_forall_info, block);
else
{
@ -3099,8 +3042,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, count2, gfc_index_zero_node);
tmp = gfc_trans_where_assign (expr1, expr2, mask, count1,
count2);
tmp = gfc_trans_where_assign (expr1, expr2, cmask,
count1, count2);
tmp = gfc_trans_nested_forall_loop (nested_forall_info,
tmp, 1, 1);
@ -3115,8 +3058,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, count2, gfc_index_zero_node);
tmp = gfc_trans_where_assign (expr1, expr2, mask, count1,
count2);
tmp = gfc_trans_where_assign (expr1, expr2, cmask,
count1, count2);
gfc_add_expr_to_block (block, tmp);
}
@ -3124,11 +3067,9 @@ gfc_trans_where_2 (gfc_code * code, tree mask,
/* WHERE or WHERE construct is part of a where-body-construct. */
case EXEC_WHERE:
/* Ensure that MASK is not modified by next gfc_trans_where_2. */
mask_copy = copy_list (mask);
gfc_trans_where_2 (cnext, mask_copy, nested_forall_info,
block, temp);
break;
/* Ensure that MASK is not modified by next gfc_trans_where_2. */
gfc_trans_where_2 (cnext, cmask, nested_forall_info, block);
break;
default:
gcc_unreachable ();
@ -3139,7 +3080,24 @@ gfc_trans_where_2 (gfc_code * code, tree mask,
}
/* The next masked-elsewhere-stmt, elsewhere-stmt, or end-where-stmt. */
cblock = cblock->block;
mask = pmask;
}
/* If we allocated a pending mask array, deallocate it now. */
if (ppmask)
{
tree args = gfc_chainon_list (NULL_TREE, ppmask);
tmp = build_function_call_expr (gfor_fndecl_internal_free, args);
gfc_add_expr_to_block (block, tmp);
}
/* If we allocated a current mask array, deallocate it now. */
if (pcmask)
{
tree args = gfc_chainon_list (NULL_TREE, pcmask);
tmp = build_function_call_expr (gfor_fndecl_internal_free, args);
gfc_add_expr_to_block (block, tmp);
}
}
/* Translate a simple WHERE construct or statement without dependencies.
@ -3282,11 +3240,8 @@ tree
gfc_trans_where (gfc_code * code)
{
stmtblock_t block;
temporary_list *temp, *p;
gfc_code *cblock;
gfc_code *eblock;
tree args;
tree tmp;
cblock = code->block;
if (cblock->next
@ -3333,21 +3288,9 @@ gfc_trans_where (gfc_code * code)
}
gfc_start_block (&block);
temp = NULL;
gfc_trans_where_2 (code, NULL, NULL, &block, &temp);
gfc_trans_where_2 (code, NULL, NULL, &block);
/* Add calls to free temporaries which were dynamically allocated. */
while (temp)
{
args = gfc_chainon_list (NULL_TREE, temp->temporary);
tmp = build_function_call_expr (gfor_fndecl_internal_free, args);
gfc_add_expr_to_block (&block, tmp);
p = temp;
temp = temp->next;
gfc_free (p);
}
return gfc_finish_block (&block);
}