* trans.h (struct gfc_ss): New field parent.

[pf3gnuchains/gcc-fork.git] / gcc / fortran / trans-array.c

diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 663d12e..abff8b5 100644 (file)
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -489,6 +489,11 @@ gfc_free_ss_chain (gfc_ss * ss)
 static void
 free_ss_info (gfc_ss_info *ss_info)
 {
+  ss_info->refcount--;
+  if (ss_info->refcount > 0)
+    return;
+
+  gcc_assert (ss_info->refcount == 0);
   free (ss_info);
 }
 
@@ -532,6 +537,7 @@ gfc_get_array_ss (gfc_ss *next, gfc_expr *expr, int dimen, gfc_ss_type type)
   int i;
 
   ss_info = gfc_get_ss_info ();
+  ss_info->refcount++;
   ss_info->type = type;
   ss_info->expr = expr;
 
@@ -556,6 +562,7 @@ gfc_get_temp_ss (tree type, tree string_length, int dimen)
   int i;
 
   ss_info = gfc_get_ss_info ();
+  ss_info->refcount++;
   ss_info->type = GFC_SS_TEMP;
   ss_info->string_length = string_length;
   ss_info->data.temp.type = type;
@@ -580,6 +587,7 @@ gfc_get_scalar_ss (gfc_ss *next, gfc_expr *expr)
   gfc_ss_info *ss_info;
 
   ss_info = gfc_get_ss_info ();
+  ss_info->refcount++;
   ss_info->type = GFC_SS_SCALAR;
   ss_info->expr = expr;
 
@@ -610,6 +618,27 @@ gfc_cleanup_loop (gfc_loopinfo * loop)
 }
 
 
+static void
+set_ss_loop (gfc_ss *ss, gfc_loopinfo *loop)
+{
+  int n;
+
+  for (; ss != gfc_ss_terminator; ss = ss->next)
+    {
+      ss->loop = loop;
+
+      if (ss->info->type == GFC_SS_SCALAR
+         || ss->info->type == GFC_SS_REFERENCE
+         || ss->info->type == GFC_SS_TEMP)
+       continue;
+
+      for (n = 0; n < GFC_MAX_DIMENSIONS; n++)
+       if (ss->info->data.array.subscript[n] != NULL)
+         set_ss_loop (ss->info->data.array.subscript[n], loop);
+    }
+}
+
+
 /* Associate a SS chain with a loop.  */
 
 void
@@ -620,6 +649,8 @@ gfc_add_ss_to_loop (gfc_loopinfo * loop, gfc_ss * head)
   if (head == gfc_ss_terminator)
     return;
 
+  set_ss_loop (head, loop);
+
   ss = head;
   for (; ss && ss != gfc_ss_terminator; ss = ss->next)
     {
@@ -857,15 +888,14 @@ get_array_ref_dim (gfc_ss *ss, int loop_dim)
    callee allocated array.
 
    PRE, POST, INITIAL, DYNAMIC and DEALLOC are as for
-   gfc_trans_allocate_array_storage.
- */
+   gfc_trans_allocate_array_storage.  */
 
 tree
-gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post,
-                            gfc_loopinfo * loop, gfc_ss * ss,
+gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, gfc_ss * ss,
                             tree eltype, tree initial, bool dynamic,
                             bool dealloc, bool callee_alloc, locus * where)
 {
+  gfc_loopinfo *loop;
   gfc_array_info *info;
   tree from[GFC_MAX_DIMENSIONS], to[GFC_MAX_DIMENSIONS];
   tree type;
@@ -876,6 +906,7 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post,
   tree cond;
   tree or_expr;
   int n, dim, tmp_dim;
+  int total_dim = 0;
 
   memset (from, 0, sizeof (from));
   memset (to, 0, sizeof (to));
@@ -883,11 +914,13 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post,
   info = &ss->info->data.array;
 
   gcc_assert (ss->dimen > 0);
-  gcc_assert (loop->dimen == ss->dimen);
+  gcc_assert (ss->loop->dimen == ss->dimen);
 
   if (gfc_option.warn_array_temp && where)
     gfc_warning ("Creating array temporary at %L", where);
 
+  loop = ss->loop;
+  total_dim = loop->dimen;
   /* Set the lower bound to zero.  */
   for (n = 0; n < loop->dimen; n++)
     {
@@ -925,7 +958,7 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post,
 
   /* Initialize the descriptor.  */
   type =
-    gfc_get_array_type_bounds (eltype, ss->dimen, 0, from, to, 1,
+    gfc_get_array_type_bounds (eltype, total_dim, 0, from, to, 1,
                               GFC_ARRAY_UNKNOWN, true);
   desc = gfc_create_var (type, "atmp");
   GFC_DECL_PACKED_ARRAY (desc) = 1;
@@ -954,8 +987,8 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post,
 
   /* If there is at least one null loop->to[n], it is a callee allocated
      array.  */
-  for (n = 0; n < loop->dimen; n++)
-    if (loop->to[n] == NULL_TREE)
+  for (n = 0; n < total_dim; n++)
+    if (to[n] == NULL_TREE)
       {
        size = NULL_TREE;
        break;
@@ -978,7 +1011,7 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post,
     }
   else
     {
-      for (n = 0; n < loop->dimen; n++)
+      for (n = 0; n < total_dim; n++)
        {
          /* Store the stride and bound components in the descriptor.  */
          gfc_conv_descriptor_stride_set (pre, desc, gfc_rank_cst[n], size);
@@ -1032,8 +1065,8 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post,
   gfc_trans_allocate_array_storage (pre, post, info, size, nelem, initial,
                                    dynamic, dealloc);
 
-  if (ss->dimen > loop->temp_dim)
-    loop->temp_dim = ss->dimen;
+  if (ss->dimen > ss->loop->temp_dim)
+    ss->loop->temp_dim = ss->dimen;
 
   return size;
 }
@@ -1950,7 +1983,7 @@ constant_array_constructor_loop_size (gfc_loopinfo * loop)
    simplest method.  */
 
 static void
-gfc_trans_array_constructor (gfc_loopinfo * loop, gfc_ss * ss, locus * where)
+trans_array_constructor (gfc_ss * ss, locus * where)
 {
   gfc_constructor_base c;
   tree offset;
@@ -1961,6 +1994,7 @@ gfc_trans_array_constructor (gfc_loopinfo * loop, gfc_ss * ss, locus * where)
   bool dynamic;
   bool old_first_len, old_typespec_chararray_ctor;
   tree old_first_len_val;
+  gfc_loopinfo *loop;
   gfc_ss_info *ss_info;
   gfc_expr *expr;
 
@@ -1969,6 +2003,7 @@ gfc_trans_array_constructor (gfc_loopinfo * loop, gfc_ss * ss, locus * where)
   old_first_len_val = first_len_val;
   old_typespec_chararray_ctor = typespec_chararray_ctor;
 
+  loop = ss->loop;
   ss_info = ss->info;
   expr = ss_info->expr;
 
@@ -2078,8 +2113,8 @@ gfc_trans_array_constructor (gfc_loopinfo * loop, gfc_ss * ss, locus * where)
   if (TREE_CODE (loop->to[0]) == VAR_DECL)
     dynamic = true;
 
-  gfc_trans_create_temp_array (&loop->pre, &loop->post, loop, ss,
-                              type, NULL_TREE, dynamic, true, false, where);
+  gfc_trans_create_temp_array (&loop->pre, &loop->post, ss, type, NULL_TREE,
+                              dynamic, true, false, where);
 
   desc = ss_info->data.array.descriptor;
   offset = gfc_index_zero_node;
@@ -2131,8 +2166,9 @@ finish:
    loop bounds.  */
 
 static void
-set_vector_loop_bounds (gfc_loopinfo * loop, gfc_ss * ss)
+set_vector_loop_bounds (gfc_ss * ss)
 {
+  gfc_loopinfo *loop;
   gfc_array_info *info;
   gfc_se se;
   tree tmp;
@@ -2142,6 +2178,7 @@ set_vector_loop_bounds (gfc_loopinfo * loop, gfc_ss * ss)
   int dim;
 
   info = &ss->info->data.array;
+  loop = ss->loop;
 
   for (n = 0; n < loop->dimen; n++)
     {
@@ -2240,7 +2277,7 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript,
            if (info->subscript[n])
              gfc_add_loop_ss_code (loop, info->subscript[n], true, where);
 
-         set_vector_loop_bounds (loop, ss);
+         set_vector_loop_bounds (ss);
          break;
 
        case GFC_SS_VECTOR:
@@ -2281,7 +2318,7 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript,
              gfc_add_block_to_block (&loop->pre, &se.pre);
              gfc_add_block_to_block (&loop->post, &se.post);
            }
-         gfc_trans_array_constructor (loop, ss, where);
+         trans_array_constructor (ss, where);
          break;
 
         case GFC_SS_TEMP:
@@ -3156,7 +3193,8 @@ gfc_trans_scalarizing_loops (gfc_loopinfo * loop, stmtblock_t * body)
 
   /* Clear all the used flags.  */
   for (ss = loop->ss; ss != gfc_ss_terminator; ss = ss->loop_chain)
-    ss->info->useflags = 0;
+    if (ss->parent == NULL)
+      ss->info->useflags = 0;
 }
 
 
@@ -4174,9 +4212,8 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where)
 
       gcc_assert (tmp_ss->dimen != 0);
 
-      gfc_trans_create_temp_array (&loop->pre, &loop->post, loop,
-                                  tmp_ss, tmp, NULL_TREE,
-                                  false, true, false, where);
+      gfc_trans_create_temp_array (&loop->pre, &loop->post, tmp_ss, tmp,
+                                  NULL_TREE, false, true, false, where);
     }
 
   /* For array parameters we don't have loop variables, so don't calculate the