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

	* 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

1 files changed, 119 insertions, 176 deletions

diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index 2f8d09b..32c750a 100644
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -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;
+
+  gfc_add_block_to_block (&body1, &lse.pre);
+  gfc_add_block_to_block (&body1, &rse.pre);
 
-  if (nmask)
+  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);
-
-          /* 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);
+          gfc_evaluate_where_mask (cblock->expr, nested_forall_info,
+				   mask, cmask, pmask, mask_type, block);
 
-              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);
 
-  /* 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);
+  gfc_trans_where_2 (code, NULL, NULL, &block);
 
-      p = temp;
-      temp = temp->next;
-      gfc_free (p);
-    }
   return gfc_finish_block (&block);
 }