* trans-array.c (outermost_loop): New function.

	(gfc_trans_array_constructor, gfc_set_vector_loop_bounds,
	gfc_add_loop_ss_code): Put generated code out of the outermost loop.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180902 138bc75d-0d04-0410-961f-82ee72b054a4

2 files changed, 47 insertions, 25 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index e359eca5f07..e073ddf916a 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,5 +1,11 @@
 2011-11-03  Mikael Morin  <mikael@gcc.gnu.org>
 
+	* trans-array.c (outermost_loop): New function.
+	(gfc_trans_array_constructor, gfc_set_vector_loop_bounds,
+	gfc_add_loop_ss_code): Put generated code out of the outermost loop.
+
+2011-11-03  Mikael Morin  <mikael@gcc.gnu.org>
+
 	* trans-array.c (constant_array_constructor_loop_size):
 	Handle multiple loops.
 
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 299bd807564..0f3d1718521 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -2108,6 +2108,16 @@ get_loop_upper_bound_for_array (gfc_ss *array, int array_dim)
 }
 
 
+static gfc_loopinfo *
+outermost_loop (gfc_loopinfo * loop)
+{
+  while (loop->parent != NULL)
+    loop = loop->parent;
+
+  return loop;
+}
+
+
 /* Array constructors are handled by constructing a temporary, then using that
    within the scalarization loop.  This is not optimal, but seems by far the
    simplest method.  */
@@ -2125,7 +2135,7 @@ trans_array_constructor (gfc_ss * ss, locus * where)
   bool dynamic;
   bool old_first_len, old_typespec_chararray_ctor;
   tree old_first_len_val;
-  gfc_loopinfo *loop;
+  gfc_loopinfo *loop, *outer_loop;
   gfc_ss_info *ss_info;
   gfc_expr *expr;
   gfc_ss *s;
@@ -2136,6 +2146,7 @@ trans_array_constructor (gfc_ss * ss, locus * where)
   old_typespec_chararray_ctor = typespec_chararray_ctor;
 
   loop = ss->loop;
+  outer_loop = outermost_loop (loop);
   ss_info = ss->info;
   expr = ss_info->expr;
 
@@ -2171,11 +2182,11 @@ trans_array_constructor (gfc_ss * ss, locus * where)
 	  gfc_conv_expr_type (&length_se, expr->ts.u.cl->length,
 			      gfc_charlen_type_node);
 	  ss_info->string_length = length_se.expr;
-	  gfc_add_block_to_block (&loop->pre, &length_se.pre);
-	  gfc_add_block_to_block (&loop->post, &length_se.post);
+	  gfc_add_block_to_block (&outer_loop->pre, &length_se.pre);
+	  gfc_add_block_to_block (&outer_loop->post, &length_se.post);
 	}
       else
-	const_string = get_array_ctor_strlen (&loop->pre, c,
+	const_string = get_array_ctor_strlen (&outer_loop->pre, c,
 					      &ss_info->string_length);
 
       /* Complex character array constructors should have been taken care of
@@ -2252,15 +2263,15 @@ trans_array_constructor (gfc_ss * ss, locus * where)
   if (TREE_CODE (*loop_ubound0) == VAR_DECL)
     dynamic = true;
 
-  gfc_trans_create_temp_array (&loop->pre, &loop->post, ss, type, NULL_TREE,
-			       dynamic, true, false, where);
+  gfc_trans_create_temp_array (&outer_loop->pre, &outer_loop->post, ss, type,
+			       NULL_TREE, dynamic, true, false, where);
 
   desc = ss_info->data.array.descriptor;
   offset = gfc_index_zero_node;
   offsetvar = gfc_create_var_np (gfc_array_index_type, "offset");
   TREE_NO_WARNING (offsetvar) = 1;
   TREE_USED (offsetvar) = 0;
-  gfc_trans_array_constructor_value (&loop->pre, type, desc, c,
+  gfc_trans_array_constructor_value (&outer_loop->pre, type, desc, c,
 				     &offset, &offsetvar, dynamic);
 
   /* If the array grows dynamically, the upper bound of the loop variable
@@ -2270,10 +2281,10 @@ trans_array_constructor (gfc_ss * ss, locus * where)
       tmp = fold_build2_loc (input_location, MINUS_EXPR,
 			     gfc_array_index_type,
 			     offsetvar, gfc_index_one_node);
-      tmp = gfc_evaluate_now (tmp, &loop->pre);
+      tmp = gfc_evaluate_now (tmp, &outer_loop->pre);
       gfc_conv_descriptor_ubound_set (&loop->pre, desc, gfc_rank_cst[0], tmp);
       if (*loop_ubound0 && TREE_CODE (*loop_ubound0) == VAR_DECL)
-	gfc_add_modify (&loop->pre, *loop_ubound0, tmp);
+	gfc_add_modify (&outer_loop->pre, *loop_ubound0, tmp);
       else
 	*loop_ubound0 = tmp;
     }
@@ -2307,7 +2318,7 @@ finish:
 static void
 set_vector_loop_bounds (gfc_ss * ss)
 {
-  gfc_loopinfo *loop;
+  gfc_loopinfo *loop, *outer_loop;
   gfc_array_info *info;
   gfc_se se;
   tree tmp;
@@ -2316,6 +2327,8 @@ set_vector_loop_bounds (gfc_ss * ss)
   int n;
   int dim;
 
+  outer_loop = outermost_loop (ss->loop);
+
   info = &ss->info->data.array;
 
   for (; ss; ss = ss->parent)
@@ -2343,7 +2356,7 @@ set_vector_loop_bounds (gfc_ss * ss)
 			     gfc_array_index_type,
 			     gfc_conv_descriptor_ubound_get (desc, zero),
 			     gfc_conv_descriptor_lbound_get (desc, zero));
-	  tmp = gfc_evaluate_now (tmp, &loop->pre);
+	  tmp = gfc_evaluate_now (tmp, &outer_loop->pre);
 	  loop->to[n] = tmp;
 	}
     }
@@ -2358,7 +2371,7 @@ static void
 gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript,
 		      locus * where)
 {
-  gfc_loopinfo *nested_loop;
+  gfc_loopinfo *nested_loop, *outer_loop;
   gfc_se se;
   gfc_ss_info *ss_info;
   gfc_array_info *info;
@@ -2366,6 +2379,8 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript,
   bool skip_nested = false;
   int n;
 
+  outer_loop = outermost_loop (loop);
+
   /* TODO: This can generate bad code if there are ordering dependencies,
      e.g., a callee allocated function and an unknown size constructor.  */
   gcc_assert (ss != NULL);
@@ -2389,7 +2404,7 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript,
 	     dimension indices, but not array section bounds.  */
 	  gfc_init_se (&se, NULL);
 	  gfc_conv_expr (&se, expr);
-	  gfc_add_block_to_block (&loop->pre, &se.pre);
+	  gfc_add_block_to_block (&outer_loop->pre, &se.pre);
 
 	  if (expr->ts.type != BT_CHARACTER)
 	    {
@@ -2398,11 +2413,11 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript,
 	      if (subscript)
 		se.expr = convert(gfc_array_index_type, se.expr);
 	      if (!ss_info->where)
-		se.expr = gfc_evaluate_now (se.expr, &loop->pre);
-	      gfc_add_block_to_block (&loop->pre, &se.post);
+		se.expr = gfc_evaluate_now (se.expr, &outer_loop->pre);
+	      gfc_add_block_to_block (&outer_loop->pre, &se.post);
 	    }
 	  else
-	    gfc_add_block_to_block (&loop->post, &se.post);
+	    gfc_add_block_to_block (&outer_loop->post, &se.post);
 
 	  ss_info->data.scalar.value = se.expr;
 	  ss_info->string_length = se.string_length;
@@ -2413,10 +2428,11 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript,
 	     now.  */
 	  gfc_init_se (&se, NULL);
 	  gfc_conv_expr (&se, expr);
-	  gfc_add_block_to_block (&loop->pre, &se.pre);
-	  gfc_add_block_to_block (&loop->post, &se.post);
+	  gfc_add_block_to_block (&outer_loop->pre, &se.pre);
+	  gfc_add_block_to_block (&outer_loop->post, &se.post);
 
-	  ss_info->data.scalar.value = gfc_evaluate_now (se.expr, &loop->pre);
+	  ss_info->data.scalar.value = gfc_evaluate_now (se.expr,
+							 &outer_loop->pre);
 	  ss_info->string_length = se.string_length;
 	  break;
 
@@ -2438,8 +2454,8 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript,
 	  /* Get the vector's descriptor and store it in SS.  */
 	  gfc_init_se (&se, NULL);
 	  gfc_conv_expr_descriptor (&se, expr, gfc_walk_expr (expr));
-	  gfc_add_block_to_block (&loop->pre, &se.pre);
-	  gfc_add_block_to_block (&loop->post, &se.post);
+	  gfc_add_block_to_block (&outer_loop->pre, &se.pre);
+	  gfc_add_block_to_block (&outer_loop->post, &se.post);
 	  info->descriptor = se.expr;
 	  break;
 
@@ -2454,8 +2470,8 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript,
 	  se.loop = loop;
 	  se.ss = ss;
 	  gfc_conv_expr (&se, expr);
-	  gfc_add_block_to_block (&loop->pre, &se.pre);
-	  gfc_add_block_to_block (&loop->post, &se.post);
+	  gfc_add_block_to_block (&outer_loop->pre, &se.pre);
+	  gfc_add_block_to_block (&outer_loop->post, &se.post);
 	  ss_info->string_length = se.string_length;
 	  break;
 
@@ -2469,8 +2485,8 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript,
 	      gfc_conv_expr_type (&se, expr->ts.u.cl->length,
 				  gfc_charlen_type_node);
 	      ss_info->string_length = se.expr;
-	      gfc_add_block_to_block (&loop->pre, &se.pre);
-	      gfc_add_block_to_block (&loop->post, &se.post);
+	      gfc_add_block_to_block (&outer_loop->pre, &se.pre);
+	      gfc_add_block_to_block (&outer_loop->post, &se.post);
 	    }
 	  trans_array_constructor (ss, where);
 	  break;