[Patch, fortran] [49..51/66] inline sum and product: Update the scalarizer: New parent loop.

[Mikael Morin <mikael.morin@sfr.fr>]

[-- Attachment #1: Type: text/plain, Size: 227 bytes --]

This introduces a convenience pointer parent for the gfc_loopinfo struct
(patch 49).
Patches 50 and 51 (with context diff) use it to update
gfc_trans_array_constructor and constant_array_constructor_loop_size
respectively.
OK?

[-- Attachment #2: pr43829-49.CL --]
[-- Type: text/plain, Size: 291 bytes --]

2011-10-19  Mikael Morin  <mikael@gcc.gnu.org>

	* trans.h (struct gfc_loopinfo): New field parent.
	* trans-array.c (gfc_cleanup_loop): Free nested loops.
	(gfc_add_ss_to_loop): Set nested_loop's parent loop.
	(gfc_trans_array_constructor): Update assertion.
	(gfc_conv_loop_setup): Ditto.

[-- Attachment #3: pr43829-49.patch --]
[-- Type: text/x-diff, Size: 2362 bytes --]

diff --git a/trans-array.c b/trans-array.c
index 27356a1..5659b70 100644
--- a/trans-array.c
+++ b/trans-array.c
@@ -604,6 +604,7 @@ gfc_get_scalar_ss (gfc_ss *next, gfc_expr *expr)
 void
 gfc_cleanup_loop (gfc_loopinfo * loop)
 {
+  gfc_loopinfo *loop_next, **ploop;
   gfc_ss *ss;
   gfc_ss *next;
 
@@ -615,6 +616,23 @@ gfc_cleanup_loop (gfc_loopinfo * loop)
       gfc_free_ss (ss);
       ss = next;
     }
+
+  /* Remove reference to self in the parent loop.  */
+  if (loop->parent)
+    for (ploop = &loop->parent->nested; *ploop; ploop = &(*ploop)->next)
+      if (*ploop == loop)
+	{
+	  *ploop = loop->next;
+	  break;
+	}
+
+  /* Free non-freed nested loops.  */
+  for (loop = loop->nested; loop; loop = loop_next)
+    {
+      loop_next = loop->next;
+      gfc_cleanup_loop (loop);
+      free (loop);
+    }
 }
 
 
@@ -664,10 +682,15 @@ gfc_add_ss_to_loop (gfc_loopinfo * loop, gfc_ss * head)
 	     added one, to avoid duplicate nested loops.  */
 	  if (nested_loop != loop->nested)
 	    {
+	      gcc_assert (nested_loop->parent == NULL);
+	      nested_loop->parent = loop;
+
 	      gcc_assert (nested_loop->next == NULL);
 	      nested_loop->next = loop->nested;
 	      loop->nested = nested_loop;
 	    }
+	  else
+	    gcc_assert (nested_loop->parent == loop);
 	}
 
       if (ss->next == gfc_ss_terminator)
@@ -2158,6 +2181,7 @@ trans_array_constructor (gfc_ss * ss, locus * where)
       mpz_t size;
 
       /* We should have a 1-dimensional, zero-based loop.  */
+      gcc_assert (loop->parent == NULL && loop->nested == NULL);
       gcc_assert (loop->dimen == 1);
       gcc_assert (integer_zerop (loop->from[0]));
 
@@ -4302,6 +4326,7 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where)
 
       tmp_ss_info = tmp_ss->info;
       gcc_assert (tmp_ss_info->type == GFC_SS_TEMP);
+      gcc_assert (loop->parent == NULL);
 
       /* Make absolutely sure that this is a complete type.  */
       if (tmp_ss_info->string_length)
diff --git a/trans.h b/trans.h
index 0549aa7..4d745f1 100644
--- a/trans.h
+++ b/trans.h
@@ -279,6 +279,9 @@ typedef struct gfc_loopinfo
   /* The SS describing the temporary used in an assignment.  */
   gfc_ss *temp_ss;
 
+  /* Non-null if this loop is nested in another one.  */
+  struct gfc_loopinfo *parent;
+
   /* Chain of nested loops.  */
   struct gfc_loopinfo *nested, *next;
 

[-- Attachment #4: pr43829-50.CL --]
[-- Type: text/plain, Size: 180 bytes --]

2011-10-19  Mikael Morin  <mikael@gcc.gnu.org>

	* trans-array.c (get_rank, get_loop_upper_bound_for_array):
	New functions.
	(gfc_trans_array_constructor): Handle multiple loops.

[-- Attachment #5: pr43829-50.patch --]
[-- Type: text/x-diff, Size: 3195 bytes --]

diff --git a/trans-array.c b/trans-array.c
index 5659b70..083ce5c 100644
--- a/trans-array.c
+++ b/trans-array.c
@@ -2034,6 +2034,19 @@ trans_constant_array_constructor (gfc_ss * ss, tree type)
 }
 
 
+static int
+get_rank (gfc_loopinfo *loop)
+{
+  int rank;
+
+  rank = 0;
+  for (; loop; loop = loop->parent)
+    rank += loop->dimen;
+
+  return rank;
+}
+
+
 /* Helper routine of gfc_trans_array_constructor to determine if the
    bounds of the loop specified by LOOP are constant and simple enough
    to use with trans_constant_array_constructor.  Returns the
@@ -2072,6 +2085,23 @@ constant_array_constructor_loop_size (gfc_loopinfo * loop)
 }
 
 
+static tree *
+get_loop_upper_bound_for_array (gfc_ss *array, int array_dim)
+{
+  gfc_ss *ss;
+  int n;
+
+  gcc_assert (array->nested_ss == NULL);
+
+  for (ss = array; ss; ss = ss->parent)
+    for (n = 0; n < ss->loop->dimen; n++)
+      if (array_dim == get_array_ref_dim_for_loop_dim (ss, n))
+	return &(ss->loop->to[n]);
+
+  gcc_unreachable ();
+}
+
+
 /* 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.  */
@@ -2085,6 +2115,7 @@ trans_array_constructor (gfc_ss * ss, locus * where)
   tree desc;
   tree type;
   tree tmp;
+  tree *loop_ubound0;
   bool dynamic;
   bool old_first_len, old_typespec_chararray_ctor;
   tree old_first_len_val;
@@ -2114,7 +2145,7 @@ trans_array_constructor (gfc_ss * ss, locus * where)
       first_len = true;
     }
 
-  gcc_assert (ss->dimen == loop->dimen);
+  gcc_assert (ss->dimen == ss->loop->dimen);
 
   c = expr->value.constructor;
   if (expr->ts.type == BT_CHARACTER)
@@ -2157,7 +2188,9 @@ trans_array_constructor (gfc_ss * ss, locus * where)
   /* See if the constructor determines the loop bounds.  */
   dynamic = false;
 
-  if (expr->shape && loop->dimen > 1 && loop->to[0] == NULL_TREE)
+  loop_ubound0 = get_loop_upper_bound_for_array (ss, 0);
+
+  if (expr->shape && get_rank (loop) > 1 && *loop_ubound0 == NULL_TREE)
     {
       /* We have a multidimensional parameter.  */
       for (s = ss; s; s = s->parent)
@@ -2176,7 +2209,7 @@ trans_array_constructor (gfc_ss * ss, locus * where)
 	}
     }
 
-  if (loop->to[0] == NULL_TREE)
+  if (*loop_ubound0 == NULL_TREE)
     {
       mpz_t size;
 
@@ -2210,7 +2243,7 @@ trans_array_constructor (gfc_ss * ss, locus * where)
 	}
     }
 
-  if (TREE_CODE (loop->to[0]) == VAR_DECL)
+  if (TREE_CODE (*loop_ubound0) == VAR_DECL)
     dynamic = true;
 
   gfc_trans_create_temp_array (&loop->pre, &loop->post, ss, type, NULL_TREE,
@@ -2233,10 +2266,10 @@ trans_array_constructor (gfc_ss * ss, locus * where)
 			     offsetvar, gfc_index_one_node);
       tmp = gfc_evaluate_now (tmp, &loop->pre);
       gfc_conv_descriptor_ubound_set (&loop->pre, desc, gfc_rank_cst[0], tmp);
-      if (loop->to[0] && TREE_CODE (loop->to[0]) == VAR_DECL)
-	gfc_add_modify (&loop->pre, loop->to[0], tmp);
+      if (*loop_ubound0 && TREE_CODE (*loop_ubound0) == VAR_DECL)
+	gfc_add_modify (&loop->pre, *loop_ubound0, tmp);
       else
-	loop->to[0] = tmp;
+	*loop_ubound0 = tmp;
     }
 
   if (TREE_USED (offsetvar))

[-- Attachment #6: pr43829-51.CL --]
[-- Type: text/plain, Size: 129 bytes --]

2011-10-19  Mikael Morin  <mikael@gcc.gnu.org>

	* trans-array.c (constant_array_constructor_loop_size):
	Handle multiple loops.

[-- Attachment #7: pr43829-51.patch --]
[-- Type: text/x-diff, Size: 2029 bytes --]

diff --git a/trans-array.c b/trans-array.c
index 083ce5c..299bd80 100644
--- a/trans-array.c
+++ b/trans-array.c
@@ -2053,32 +2053,38 @@ get_rank (gfc_loopinfo *loop)
    iteration count of the loop if suitable, and NULL_TREE otherwise.  */
 
 static tree
-constant_array_constructor_loop_size (gfc_loopinfo * loop)
+constant_array_constructor_loop_size (gfc_loopinfo * l)
 {
+  gfc_loopinfo *loop;
   tree size = gfc_index_one_node;
   tree tmp;
-  int i;
+  int i, total_dim;
+
+  total_dim = get_rank (l);
 
-  for (i = 0; i < loop->dimen; i++)
+  for (loop = l; loop; loop = loop->parent)
     {
-      /* If the bounds aren't constant, return NULL_TREE.  */
-      if (!INTEGER_CST_P (loop->from[i]) || !INTEGER_CST_P (loop->to[i]))
-	return NULL_TREE;
-      if (!integer_zerop (loop->from[i]))
+      for (i = 0; i < loop->dimen; i++)
 	{
-	  /* Only allow nonzero "from" in one-dimensional arrays.  */
-	  if (loop->dimen != 1)
+	  /* If the bounds aren't constant, return NULL_TREE.  */
+	  if (!INTEGER_CST_P (loop->from[i]) || !INTEGER_CST_P (loop->to[i]))
 	    return NULL_TREE;
-	  tmp = fold_build2_loc (input_location, MINUS_EXPR,
-				 gfc_array_index_type,
-				 loop->to[i], loop->from[i]);
+	  if (!integer_zerop (loop->from[i]))
+	    {
+	      /* Only allow nonzero "from" in one-dimensional arrays.  */
+	      if (total_dim != 1)
+		return NULL_TREE;
+	      tmp = fold_build2_loc (input_location, MINUS_EXPR,
+				     gfc_array_index_type,
+				     loop->to[i], loop->from[i]);
+	    }
+	  else
+	    tmp = loop->to[i];
+	  tmp = fold_build2_loc (input_location, PLUS_EXPR,
+				 gfc_array_index_type, tmp, gfc_index_one_node);
+	  size = fold_build2_loc (input_location, MULT_EXPR,
+				  gfc_array_index_type, size, tmp);
 	}
-      else
-	tmp = loop->to[i];
-      tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
-			     tmp, gfc_index_one_node);
-      size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
-			      size, tmp);
     }
 
   return size;

[-- Attachment #8: pr43829-51.diff --]
[-- Type: text/x-diff, Size: 2320 bytes --]

diff --git a/trans-array.c b/trans-array.c
index 083ce5c77ee5a97219710a7274575d03bd82db37..299bd80756401aa68435a99bff874e0ff9981aa1 100644
*** a/trans-array.c
--- b/trans-array.c
*************** get_rank (gfc_loopinfo *loop)
*** 2053,2064 ****
     iteration count of the loop if suitable, and NULL_TREE otherwise.  */
  
  static tree
! constant_array_constructor_loop_size (gfc_loopinfo * loop)
  {
    tree size = gfc_index_one_node;
    tree tmp;
!   int i;
  
    for (i = 0; i < loop->dimen; i++)
      {
        /* If the bounds aren't constant, return NULL_TREE.  */
--- 2053,2069 ----
     iteration count of the loop if suitable, and NULL_TREE otherwise.  */
  
  static tree
! constant_array_constructor_loop_size (gfc_loopinfo * l)
  {
+   gfc_loopinfo *loop;
    tree size = gfc_index_one_node;
    tree tmp;
!   int i, total_dim;
! 
!   total_dim = get_rank (l);
  
+   for (loop = l; loop; loop = loop->parent)
+     {
        for (i = 0; i < loop->dimen; i++)
  	{
  	  /* If the bounds aren't constant, return NULL_TREE.  */
*************** constant_array_constructor_loop_size (gf
*** 2067,2073 ****
        if (!integer_zerop (loop->from[i]))
  	{
  	  /* Only allow nonzero "from" in one-dimensional arrays.  */
! 	  if (loop->dimen != 1)
  	    return NULL_TREE;
  	  tmp = fold_build2_loc (input_location, MINUS_EXPR,
  				 gfc_array_index_type,
--- 2072,2078 ----
  	  if (!integer_zerop (loop->from[i]))
  	    {
  	      /* Only allow nonzero "from" in one-dimensional arrays.  */
! 	      if (total_dim != 1)
  		return NULL_TREE;
  	      tmp = fold_build2_loc (input_location, MINUS_EXPR,
  				     gfc_array_index_type,
*************** constant_array_constructor_loop_size (gf
*** 2075,2084 ****
  	}
        else
  	tmp = loop->to[i];
!       tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
! 			     tmp, gfc_index_one_node);
!       size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
! 			      size, tmp);
      }
  
    return size;
--- 2080,2090 ----
  	    }
  	  else
  	    tmp = loop->to[i];
! 	  tmp = fold_build2_loc (input_location, PLUS_EXPR,
! 				 gfc_array_index_type, tmp, gfc_index_one_node);
! 	  size = fold_build2_loc (input_location, MULT_EXPR,
! 				  gfc_array_index_type, size, tmp);
! 	}
      }
  
    return size;