This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[Fortran] Another round of WHERE statement optimizations
- From: Roger Sayle <roger at eyesopen dot com>
- To: fortran at gcc dot gnu dot org
- Cc: gcc-patches at gcc dot gnu dot org
- Date: Thu, 16 Feb 2006 14:34:33 -0700 (MST)
- Subject: [Fortran] Another round of WHERE statement optimizations
The following patch is the next installment in the series of patches to
improve gfortran's code generation for F95's WHERE construct. One issue
with the current implementation is the large number of execution mask
arrays that are concurrently allocated.
Consider the following F95 source code:
program where_1
integer :: a(4)
integer :: b(4)
a = (/1, 2, 3, 4/)
b = (/0, 0, 0, 0/)
where (a .eq. 1)
b = 1
elsewhere (a .eq. 2)
b = 2
elsewhere (a .eq. 3)
b = 3
elsewhere
b = 4
endwhere
print *,b
end program
Currently, trans-stmt.c allocates true masks and false masks (termed
execution masks and pending execution masks in the relevant standards)
for each conditional in a where construct.
Hence the above code is generated as:
temp1 = (bool*)malloc(4);
temp2 = (bool*)malloc(4);
for (int i1=0; i1<4; i1++)
{
temp1[i1] = (a[i1] == 1);
temp2[i1] = !temp1[i1];
}
for (int i2=0; i2<4; i2++)
if (temp1[i2])
b[i2] = 1;
temp3 = (bool*)malloc(4);
temp4 = (bool*)malloc(4);
for (int i3=0; i3<4; i3++)
{
temp3[i3] = (a[i3] == 2);
temp4[i3] = !temp3[i3];
}
for (int i4=0; i4<4; i4++)
if (temp2[i4] && temp3[i4])
b[i4] = 2;
temp5 = (bool*)malloc(4);
temp6 = (bool*)malloc(4);
for (int i5=0; i5<4; i5++)
{
temp5[i5] = (a[i5] == 3);
temp6[i6] = !temp5[i5];
}
for (int i6=0; i6<4; i6++)
if (temp2[i6] && temp4[i6] && temp5[i6])
b[i6] = 3;
for (int i7=0; i7<4; i7++)
if (temp2[i7] && temp4[i7] && temp6[i7])
b[i7] = 4;
free(temp1);
free(temp2);
free(temp3);
free(temp4);
free(temp5);
free(temp6);
Notice both the large number of mask allocations (two per conditional)
and the inefficiency that these are repeatedly ANDed together in later
where assignments (i.e. the temp2, temp4 and temp6 references in the
COND_EXPR for the final elsewhere's b = 4 masked assignment).
The patch below attempts to clean all of this up, such that we only
dynamically allocate a single pair of execution masks for each WHERE
construct. Nested WHEREs allocate their own masks, but ELSEWHEREs
require no allocation. The trick is to perform the ANDing as execution
proceeds, and always maintain a single execution mask and pending
execution mask for the current position in the WHERE construct.
For the example code above, we now generate:
temp1 = (bool*)malloc(4);
temp2 = (bool*)malloc(4);
for (int i1=0; i1<4; i1++)
{
temp1[i1] = (a[i1] == 1);
temp2[i1] = !temp1[i1];
}
for (int i2=0; i2<4; i2++)
if (temp1[i2])
b[i2] = 1;
for (int i3=0; i3<4; i3++)
{
bool cond = (a[i3] == 2);
temp1[i3] = temp2[i1] && cond;
temp2[i3] = temp2[il] && !cond;
}
for (int i4=0; i4<4; i4++)
if (temp1[i4])
b[i4] = 2;
for (int i5=0; i5<4; i5++)
{
bool cond = (a[i5] == 3);
temp1[i5] = temp2[i5] && cond;
temp2[i5] = temp2[i5] && !cond;
}
for (int i6=0; i6<4; i6++)
if (temp1[i6])
b[i6] = 3;
for (int i7=0; i7<4; i7++)
if (temp2[i7])
b[i2] = 4;
free(temp1);
free(temp2);
Peak memory usage is also reduced as nested masks are now deallocated
when the execution of their WHERE construct is completed. Previously
all of the masks in all of the branches a WHERE construct were live
until the top-level WHERE finished.
This change also simplifies the code internally. Temporary mask arrays
are now allocated and deallocated in gfc_trans_where_2. This means
there's no longer a need to maintain a list of arrays to deallocate in
a temporary_list structure, or to loop over it after calling
gfc_trans_where_2.
There are still a number of follow-up clean-ups and optimizations that can
be made once this patch is in, but this change is already a significant
hunk to review. The two obvious improvements are that we can now remove
the TRUTH_AND_EXPR from gfc_trans_where_assign (as the mask list now
always contains only a single element), and avoiding the updating of
"cmask" for empty where/elsewhere clauses. i.e.
WHERE ((1/a) .ne. 0)
ENDWHERE
need not allocate any memory, but must perform the potentially trapping
divisions.
The following patch has been tested on x86_64-unknown-linux-gnu with a
top-level "make bootstrap", including fortran, and regression tested with
a "make check-gfortran" in the gcc/ directory with no new failures.
Ok for mainline?
2006-02-16 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.
Index: trans-stmt.c
===================================================================
*** trans-stmt.c (revision 110992)
--- trans-stmt.c (working copy)
*************** typedef struct iter_info
*** 49,61 ****
}
iter_info;
- typedef struct temporary_list
- {
- tree temporary;
- struct temporary_list *next;
- }
- temporary_list;
-
typedef struct forall_info
{
iter_info *this_loop;
--- 49,54 ----
*************** typedef struct forall_info
*** 69,76 ****
}
forall_info;
! static void gfc_trans_where_2 (gfc_code *, tree, forall_info *,
! stmtblock_t *, temporary_list **temp);
/* Translate a F95 label number to a LABEL_EXPR. */
--- 62,68 ----
}
forall_info;
! static void gfc_trans_where_2 (gfc_code *, tree, forall_info *, stmtblock_t *);
/* Translate a F95 label number to a LABEL_EXPR. */
*************** gfc_trans_forall_1 (gfc_code * code, for
*** 2317,2323 ****
gfc_saved_var *saved_vars;
iter_info *this_forall, *iter_tmp;
forall_info *info, *forall_tmp;
- temporary_list *temp;
gfc_start_block (&block);
--- 2309,2314 ----
*************** gfc_trans_forall_1 (gfc_code * code, for
*** 2523,2549 ****
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;
/* Pointer assignment inside FORALL. */
case EXEC_POINTER_ASSIGN:
--- 2514,2522 ----
break;
case EXEC_WHERE:
/* Translate WHERE or WHERE construct nested in FORALL. */
! gfc_trans_where_2 (c, NULL, nested_forall_info, &block);
! break;
/* Pointer assignment inside FORALL. */
case EXEC_POINTER_ASSIGN:
*************** tree gfc_trans_forall (gfc_code * code)
*** 2622,2692 ****
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. */
! static tree
gfc_evaluate_where_mask (gfc_expr * me, forall_info * nested_forall_info,
! tree * mask, tree * nmask, temporary_list ** temp,
! 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;
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;
/* Variable to index the temporary. */
count = gfc_create_var (gfc_array_index_type, "count");
--- 2595,2621 ----
needed by the WHERE mask expression multiplied by the iterator number of
the nested forall.
ME is the WHERE mask expression.
! 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 void
gfc_evaluate_where_mask (gfc_expr * me, forall_info * nested_forall_info,
! tree mask, tree cmask, tree pmask,
! tree mask_type, stmtblock_t * block)
{
tree tmp, tmp1;
gfc_ss *lss, *rss;
gfc_loopinfo loop;
! stmtblock_t body, body1;
! tree count, cond, mtmp;
gfc_se lse, rse;
gfc_init_loopinfo (&loop);
! lss = gfc_walk_expr (me);
! rss = gfc_walk_expr (me);
/* Variable to index the temporary. */
count = gfc_create_var (gfc_array_index_type, "count");
*************** gfc_evaluate_where_mask (gfc_expr * me,
*** 2723,2744 ****
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);
! if (nmask)
{
! /* 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);
}
! if (lss == gfc_ss_terminator)
{
gfc_add_block_to_block (&body, &body1);
}
--- 2652,2697 ----
rse.ss = rss;
gfc_conv_expr (&rse, me);
}
! /* 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;
!
! 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))
{
! tmp = gfc_build_array_ref (mask, count);
! gfc_add_modify_expr (&body1, mtmp, tmp);
}
! 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);
}
*************** gfc_evaluate_where_mask (gfc_expr * me,
*** 2766,2777 ****
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;
}
--- 2719,2724 ----
*************** gfc_trans_where_assign (gfc_expr *expr1,
*** 2999,3078 ****
/* 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. */
static void
gfc_trans_where_2 (gfc_code * code, tree mask,
! forall_info * nested_forall_info, stmtblock_t * block,
! temporary_list ** temp)
{
gfc_expr *expr1;
gfc_expr *expr2;
gfc_code *cblock;
gfc_code *cnext;
! tree tmp, tmp1, tmp2;
tree count1, count2;
- tree mask_copy;
int need_temp;
! tree *tmp1_ptr;
! tree pmask;
!
! pmask = NULL_TREE;
/* the WHERE statement or the WHERE construct statement. */
cblock = code->block;
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). */
if (! cblock->block)
! {
! tmp1 = NULL_TREE;
! tmp1_ptr = NULL;
! }
! else
! tmp1_ptr = &tmp1;
/* Ensure that the WHERE mask be evaluated only once. */
! tmp2 = gfc_evaluate_where_mask (cblock->expr, nested_forall_info,
! &tmp, tmp1_ptr, temp, 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;
/* Get the assignment statement of a WHERE statement, or the first
statement in where-body-construct of a WHERE construct. */
--- 2946,3021 ----
/* 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. */
static void
gfc_trans_where_2 (gfc_code * code, tree mask,
! 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;
tree count1, count2;
int need_temp;
! 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 update the pending control mask (pmask). */
if (! cblock->block)
! pmask = NULL_TREE;
/* Ensure that the WHERE mask be evaluated only once. */
! gfc_evaluate_where_mask (cblock->expr, nested_forall_info,
! mask, cmask, pmask, mask_type, block);
}
/* It's a elsewhere-stmt. No mask-expr is present. */
else
! cmask = mask;
/* Get the assignment statement of a WHERE statement, or the first
statement in where-body-construct of a WHERE construct. */
*************** gfc_trans_where_2 (gfc_code * code, tree
*** 3089,3095 ****
{
need_temp = gfc_check_dependency (expr1, expr2, 0);
if (need_temp)
! gfc_trans_assign_need_temp (expr1, expr2, mask,
nested_forall_info, block);
else
{
--- 3032,3038 ----
{
need_temp = gfc_check_dependency (expr1, expr2, 0);
if (need_temp)
! gfc_trans_assign_need_temp (expr1, expr2, cmask,
nested_forall_info, block);
else
{
*************** gfc_trans_where_2 (gfc_code * code, tree
*** 3099,3106 ****
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_nested_forall_loop (nested_forall_info,
tmp, 1, 1);
--- 3042,3049 ----
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, cmask,
! count1, count2);
tmp = gfc_trans_nested_forall_loop (nested_forall_info,
tmp, 1, 1);
*************** gfc_trans_where_2 (gfc_code * code, tree
*** 3115,3122 ****
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);
gfc_add_expr_to_block (block, tmp);
}
--- 3058,3065 ----
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, cmask,
! count1, count2);
gfc_add_expr_to_block (block, tmp);
}
*************** gfc_trans_where_2 (gfc_code * code, tree
*** 3124,3134 ****
/* 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;
default:
gcc_unreachable ();
--- 3067,3075 ----
/* 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. */
! gfc_trans_where_2 (cnext, cmask, nested_forall_info, block);
! break;
default:
gcc_unreachable ();
*************** gfc_trans_where_2 (gfc_code * code, tree
*** 3139,3145 ****
--- 3080,3103 ----
}
/* 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.
*************** tree
*** 3282,3292 ****
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
--- 3240,3247 ----
*************** gfc_trans_where (gfc_code * code)
*** 3333,3353 ****
}
gfc_start_block (&block);
- temp = NULL;
-
- gfc_trans_where_2 (code, NULL, NULL, &block, &temp);
! /* 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);
}
--- 3288,3296 ----
}
gfc_start_block (&block);
! gfc_trans_where_2 (code, NULL, NULL, &block);
return gfc_finish_block (&block);
}
Roger
--