OSDN Git Service

* trans-array.c (gfc_trans_array_constructor, trans_array_constructor):
[pf3gnuchains/gcc-fork.git] / gcc / fortran / trans-array.c
index eef0f09..01a411a 100644 (file)
@@ -463,7 +463,7 @@ void
 gfc_mark_ss_chain_used (gfc_ss * ss, unsigned flags)
 {
   for (; ss != gfc_ss_terminator; ss = ss->next)
-    ss->useflags = flags;
+    ss->info->useflags = flags;
 }
 
 static void gfc_free_ss (gfc_ss *);
@@ -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);
 }
 
@@ -508,8 +513,8 @@ gfc_free_ss (gfc_ss * ss)
     case GFC_SS_SECTION:
       for (n = 0; n < ss->dimen; n++)
        {
-         if (ss->data.info.subscript[ss->dim[n]])
-           gfc_free_ss_chain (ss->data.info.subscript[ss->dim[n]]);
+         if (ss_info->data.array.subscript[ss->dim[n]])
+           gfc_free_ss_chain (ss_info->data.array.subscript[ss->dim[n]]);
        }
       break;
 
@@ -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,13 +562,14 @@ 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;
 
   ss = gfc_get_ss ();
   ss->info = ss_info;
   ss->next = gfc_ss_terminator;
-  ss->data.temp.type = type;
   ss->dimen = dimen;
   for (i = 0; i < ss->dimen; i++)
     ss->dim[i] = i;
@@ -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)
     {
@@ -880,7 +911,7 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post,
   memset (from, 0, sizeof (from));
   memset (to, 0, sizeof (to));
 
-  info = &ss->data.info;
+  info = &ss->info->data.array;
 
   gcc_assert (ss->dimen > 0);
   gcc_assert (loop->dimen == ss->dimen);
@@ -902,6 +933,11 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post,
                        pre);
       loop->from[n] = gfc_index_zero_node;
 
+      /* We have just changed the loop bounds, we must clear the
+        corresponding specloop, so that delta calculation is not skipped
+        later in set_delta.  */
+      loop->specloop[n] = NULL;
+
       /* We are constructing the temporary's descriptor based on the loop
         dimensions. As the dimensions may be accessed in arbitrary order
         (think of transpose) the size taken from the n'th loop may not map
@@ -956,12 +992,12 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post,
        break;
       }
 
-  for (n = 0; n < loop->dimen; n++)
+  if (size == NULL_TREE)
     {
-      dim = ss->dim[n];
-
-      if (size == NULL_TREE)
+      for (n = 0; n < loop->dimen; n++)
        {
+         dim = ss->dim[n];
+
          /* For a callee allocated array express the loop bounds in terms
             of the descriptor fields.  */
          tmp = fold_build2_loc (input_location,
@@ -969,39 +1005,42 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post,
                gfc_conv_descriptor_ubound_get (desc, gfc_rank_cst[dim]),
                gfc_conv_descriptor_lbound_get (desc, gfc_rank_cst[dim]));
          loop->to[n] = tmp;
-         continue;
        }
-       
-      /* Store the stride and bound components in the descriptor.  */
-      gfc_conv_descriptor_stride_set (pre, desc, gfc_rank_cst[n], size);
+    }
+  else
+    {
+      for (n = 0; n < loop->dimen; n++)
+       {
+         /* Store the stride and bound components in the descriptor.  */
+         gfc_conv_descriptor_stride_set (pre, desc, gfc_rank_cst[n], size);
 
-      gfc_conv_descriptor_lbound_set (pre, desc, gfc_rank_cst[n],
-                                     gfc_index_zero_node);
+         gfc_conv_descriptor_lbound_set (pre, desc, gfc_rank_cst[n],
+                                         gfc_index_zero_node);
 
-      gfc_conv_descriptor_ubound_set (pre, desc, gfc_rank_cst[n],
-                                     to[n]);
+         gfc_conv_descriptor_ubound_set (pre, desc, gfc_rank_cst[n], to[n]);
 
-      tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
-                            to[n], gfc_index_one_node);
+         tmp = fold_build2_loc (input_location, PLUS_EXPR,
+                                gfc_array_index_type,
+                                to[n], gfc_index_one_node);
 
-      /* Check whether the size for this dimension is negative.  */
-      cond = fold_build2_loc (input_location, LE_EXPR, boolean_type_node, tmp,
-                             gfc_index_zero_node);
-      cond = gfc_evaluate_now (cond, pre);
+         /* Check whether the size for this dimension is negative.  */
+         cond = fold_build2_loc (input_location, LE_EXPR, boolean_type_node,
+                                 tmp, gfc_index_zero_node);
+         cond = gfc_evaluate_now (cond, pre);
 
-      if (n == 0)
-       or_expr = cond;
-      else
-       or_expr = fold_build2_loc (input_location, TRUTH_OR_EXPR,
-                                  boolean_type_node, or_expr, cond);
+         if (n == 0)
+           or_expr = cond;
+         else
+           or_expr = fold_build2_loc (input_location, TRUTH_OR_EXPR,
+                                      boolean_type_node, or_expr, cond);
 
-      size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
-                             size, tmp);
-      size = gfc_evaluate_now (size, pre);
+         size = fold_build2_loc (input_location, MULT_EXPR,
+                                 gfc_array_index_type, size, tmp);
+         size = gfc_evaluate_now (size, pre);
+       }
     }
 
   /* Get the size of the array.  */
-
   if (size && !callee_alloc)
     {
       /* If or_expr is true, then the extent in at least one
@@ -1884,7 +1923,7 @@ trans_constant_array_constructor (gfc_ss * ss, tree type)
 
   tmp = gfc_build_constant_array_constructor (ss->info->expr, type);
 
-  info = &ss->data.info;
+  info = &ss->info->data.array;
 
   info->descriptor = tmp;
   info->data = gfc_build_addr_expr (NULL_TREE, tmp);
@@ -1942,7 +1981,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;
@@ -1953,6 +1992,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;
 
@@ -1961,6 +2001,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;
 
@@ -2073,7 +2114,7 @@ gfc_trans_array_constructor (gfc_loopinfo * loop, gfc_ss * ss, locus * where)
   gfc_trans_create_temp_array (&loop->pre, &loop->post, loop, ss,
                               type, NULL_TREE, dynamic, true, false, where);
 
-  desc = ss->data.info.descriptor;
+  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;
@@ -2123,8 +2164,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;
@@ -2133,7 +2175,8 @@ set_vector_loop_bounds (gfc_loopinfo * loop, gfc_ss * ss)
   int n;
   int dim;
 
-  info = &ss->data.info;
+  info = &ss->info->data.array;
+  loop = ss->loop;
 
   for (n = 0; n < loop->dimen; n++)
     {
@@ -2149,7 +2192,7 @@ set_vector_loop_bounds (gfc_loopinfo * loop, gfc_ss * ss)
                      && info->subscript[dim]->info->type == GFC_SS_VECTOR);
 
          gfc_init_se (&se, NULL);
-         desc = info->subscript[dim]->data.info.descriptor;
+         desc = info->subscript[dim]->info->data.array.descriptor;
          zero = gfc_rank_cst[0];
          tmp = fold_build2_loc (input_location, MINUS_EXPR,
                             gfc_array_index_type,
@@ -2172,6 +2215,7 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript,
 {
   gfc_se se;
   gfc_ss_info *ss_info;
+  gfc_array_info *info;
   gfc_expr *expr;
   int n;
 
@@ -2185,6 +2229,7 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript,
 
       ss_info = ss->info;
       expr = ss_info->expr;
+      info = &ss_info->data.array;
 
       switch (ss_info->type)
        {
@@ -2201,7 +2246,7 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript,
                 scalarization loop, except for WHERE assignments.  */
              if (subscript)
                se.expr = convert(gfc_array_index_type, se.expr);
-             if (!ss->where)
+             if (!ss_info->where)
                se.expr = gfc_evaluate_now (se.expr, &loop->pre);
              gfc_add_block_to_block (&loop->pre, &se.post);
            }
@@ -2227,11 +2272,10 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript,
        case GFC_SS_SECTION:
          /* Add the expressions for scalar and vector subscripts.  */
          for (n = 0; n < GFC_MAX_DIMENSIONS; n++)
-           if (ss->data.info.subscript[n])
-             gfc_add_loop_ss_code (loop, ss->data.info.subscript[n], true,
-                                   where);
+           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:
@@ -2240,7 +2284,7 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript,
          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);
-         ss->data.info.descriptor = se.expr;
+         info->descriptor = se.expr;
          break;
 
        case GFC_SS_INTRINSIC:
@@ -2272,7 +2316,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:
@@ -2295,9 +2339,11 @@ gfc_conv_ss_descriptor (stmtblock_t * block, gfc_ss * ss, int base)
 {
   gfc_se se;
   gfc_ss_info *ss_info;
+  gfc_array_info *info;
   tree tmp;
 
   ss_info = ss->info;
+  info = &ss_info->data.array;
 
   /* Get the descriptor for the array to be scalarized.  */
   gcc_assert (ss_info->expr->expr_type == EXPR_VARIABLE);
@@ -2305,7 +2351,7 @@ gfc_conv_ss_descriptor (stmtblock_t * block, gfc_ss * ss, int base)
   se.descriptor_only = 1;
   gfc_conv_expr_lhs (&se, ss_info->expr);
   gfc_add_block_to_block (block, &se.pre);
-  ss->data.info.descriptor = se.expr;
+  info->descriptor = se.expr;
   ss_info->string_length = se.string_length;
 
   if (base)
@@ -2320,15 +2366,15 @@ gfc_conv_ss_descriptor (stmtblock_t * block, gfc_ss * ss, int base)
            || (TREE_CODE (tmp) == ADDR_EXPR
                && DECL_P (TREE_OPERAND (tmp, 0)))))
        tmp = gfc_evaluate_now (tmp, block);
-      ss->data.info.data = tmp;
+      info->data = tmp;
 
       tmp = gfc_conv_array_offset (se.expr);
-      ss->data.info.offset = gfc_evaluate_now (tmp, block);
+      info->offset = gfc_evaluate_now (tmp, block);
 
       /* Make absolutely sure that the saved_offset is indeed saved
         so that the variable is still accessible after the loops
         are translated.  */
-      ss->data.info.saved_offset = ss->data.info.offset;
+      info->saved_offset = info->offset;
     }
 }
 
@@ -2481,7 +2527,7 @@ trans_array_bound_check (gfc_se * se, gfc_ss *ss, tree index, int n,
   if (!(gfc_option.rtcheck & GFC_RTCHECK_BOUNDS))
     return index;
 
-  descriptor = ss->data.info.descriptor;
+  descriptor = ss->info->data.array.descriptor;
 
   index = gfc_evaluate_now (index, &se->pre);
 
@@ -2555,7 +2601,7 @@ conv_array_index_offset (gfc_se * se, gfc_ss * ss, int dim, int i,
   tree desc;
   tree data;
 
-  info = &ss->data.info;
+  info = &ss->info->data.array;
 
   /* Get the index into the array for this dimension.  */
   if (ar)
@@ -2582,7 +2628,7 @@ conv_array_index_offset (gfc_se * se, gfc_ss * ss, int dim, int i,
          gcc_assert (info && se->loop);
          gcc_assert (info->subscript[dim]
                      && info->subscript[dim]->info->type == GFC_SS_VECTOR);
-         desc = info->subscript[dim]->data.info.descriptor;
+         desc = info->subscript[dim]->info->data.array.descriptor;
 
          /* Get a zero-based index into the vector.  */
          index = fold_build2_loc (input_location, MINUS_EXPR,
@@ -2673,7 +2719,7 @@ gfc_conv_scalarized_array_ref (gfc_se * se, gfc_array_ref * ar)
 
   ss = se->ss;
   expr = ss->info->expr;
-  info = &ss->data.info;
+  info = &ss->info->data.array;
   if (ar)
     n = se->loop->order[0];
   else
@@ -2866,7 +2912,7 @@ add_array_offset (stmtblock_t *pblock, gfc_loopinfo *loop, gfc_ss *ss,
   gfc_array_info *info;
   tree stride, index;
 
-  info = &ss->data.info;
+  info = &ss->info->data.array;
 
   gfc_init_se (&se, NULL);
   se.loop = loop;
@@ -2890,6 +2936,7 @@ gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim, int flag,
                         stmtblock_t * pblock)
 {
   tree stride;
+  gfc_ss_info *ss_info;
   gfc_array_info *info;
   gfc_ss_type ss_type;
   gfc_ss *ss;
@@ -2900,17 +2947,19 @@ gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim, int flag,
      for this dimension.  */
   for (ss = loop->ss; ss != gfc_ss_terminator; ss = ss->loop_chain)
     {
-      if ((ss->useflags & flag) == 0)
+      ss_info = ss->info;
+
+      if ((ss_info->useflags & flag) == 0)
        continue;
 
-      ss_type = ss->info->type;
+      ss_type = ss_info->type;
       if (ss_type != GFC_SS_SECTION
          && ss_type != GFC_SS_FUNCTION
          && ss_type != GFC_SS_CONSTRUCTOR
          && ss_type != GFC_SS_COMPONENT)
        continue;
 
-      info = &ss->data.info;
+      info = &ss_info->data.array;
 
       gcc_assert (dim < ss->dimen);
       gcc_assert (ss->dimen == loop->dimen);
@@ -3142,7 +3191,7 @@ 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->useflags = 0;
+    ss->info->useflags = 0;
 }
 
 
@@ -3175,18 +3224,21 @@ gfc_trans_scalarized_loop_boundary (gfc_loopinfo * loop, stmtblock_t * body)
   for (ss = loop->ss; ss != gfc_ss_terminator; ss = ss->loop_chain)
     {
       gfc_ss_type ss_type;
+      gfc_ss_info *ss_info;
 
-      if ((ss->useflags & 2) == 0)
+      ss_info = ss->info;
+
+      if ((ss_info->useflags & 2) == 0)
        continue;
 
-      ss_type = ss->info->type;
+      ss_type = ss_info->type;
       if (ss_type != GFC_SS_SECTION
          && ss_type != GFC_SS_FUNCTION
          && ss_type != GFC_SS_CONSTRUCTOR
          && ss_type != GFC_SS_COMPONENT)
        continue;
 
-      ss->data.info.offset = ss->data.info.saved_offset;
+      ss_info->data.array.offset = ss_info->data.array.saved_offset;
     }
 
   /* Restart all the inner loops we just finished.  */
@@ -3253,7 +3305,7 @@ gfc_conv_section_startstride (gfc_loopinfo * loop, gfc_ss * ss, int dim)
 
   gcc_assert (ss->info->type == GFC_SS_SECTION);
 
-  info = &ss->data.info;
+  info = &ss->info->data.array;
   ar = &info->ref->u.ar;
 
   if (ar->dimen_type[dim] == DIMEN_VECTOR)
@@ -3352,7 +3404,7 @@ done:
 
       ss_info = ss->info;
       expr = ss_info->expr;
-      info = &ss->data.info;
+      info = &ss_info->data.array;
 
       if (expr && expr->shape && !info->shape)
        info->shape = expr->shape;
@@ -3388,9 +3440,9 @@ done:
            {
              int dim = ss->dim[n];
 
-             ss->data.info.start[dim]  = gfc_index_zero_node;
-             ss->data.info.end[dim]    = gfc_index_zero_node;
-             ss->data.info.stride[dim] = gfc_index_one_node;
+             info->start[dim]  = gfc_index_zero_node;
+             info->end[dim]    = gfc_index_zero_node;
+             info->stride[dim] = gfc_index_one_node;
            }
          break;
 
@@ -3439,7 +3491,7 @@ done:
          gfc_start_block (&inner);
 
          /* TODO: range checking for mapped dimensions.  */
-         info = &ss->data.info;
+         info = &ss_info->data.array;
 
          /* This code only checks ranges.  Elemental and vector
             dimensions are checked later.  */
@@ -3466,7 +3518,7 @@ done:
                                       expr_loc, msg);
              free (msg);
 
-             desc = ss->data.info.descriptor;
+             desc = info->descriptor;
 
              /* This is the run-time equivalent of resolve.c's
                 check_dimension().  The logical is more readable there
@@ -3720,7 +3772,7 @@ gfc_could_be_alias (gfc_ss * lss, gfc_ss * rss)
   /* For derived types we must check all the component types.  We can ignore
      array references as these will have the same base type as the previous
      component ref.  */
-  for (lref = lexpr->ref; lref != lss->data.info.ref; lref = lref->next)
+  for (lref = lexpr->ref; lref != lss->info->data.array.ref; lref = lref->next)
     {
       if (lref->type != REF_COMPONENT)
        continue;
@@ -3740,7 +3792,7 @@ gfc_could_be_alias (gfc_ss * lss, gfc_ss * rss)
            return 1;
        }
 
-      for (rref = rexpr->ref; rref != rss->data.info.ref;
+      for (rref = rexpr->ref; rref != rss->info->data.array.ref;
           rref = rref->next)
        {
          if (rref->type != REF_COMPONENT)
@@ -3775,7 +3827,7 @@ gfc_could_be_alias (gfc_ss * lss, gfc_ss * rss)
   lsym_pointer = lsym->attr.pointer;
   lsym_target = lsym->attr.target;
 
-  for (rref = rexpr->ref; rref != rss->data.info.ref; rref = rref->next)
+  for (rref = rexpr->ref; rref != rss->info->data.array.ref; rref = rref->next)
     {
       if (rref->type != REF_COMPONENT)
        break;
@@ -3910,25 +3962,25 @@ temporary:
 }
 
 
-/* Initialize the scalarization loop.  Creates the loop variables.  Determines
-   the range of the loop variables.  Creates a temporary if required.
-   Calculates how to transform from loop variables to array indices for each
-   expression.  Also generates code for scalar expressions which have been
-   moved outside the loop.  */
+/* Browse through each array's information from the scalarizer and set the loop
+   bounds according to the "best" one (per dimension), i.e. the one which
+   provides the most information (constant bounds, shape, etc).  */
 
-void
-gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where)
+static void
+set_loop_bounds (gfc_loopinfo *loop)
 {
   int n, dim, spec_dim;
   gfc_array_info *info;
   gfc_array_info *specinfo;
-  gfc_ss *ss, *tmp_ss;
+  gfc_ss *ss;
   tree tmp;
-  gfc_ss *loopspec[GFC_MAX_DIMENSIONS];
+  gfc_ss **loopspec;
   bool dynamic[GFC_MAX_DIMENSIONS];
   mpz_t *cshape;
   mpz_t i;
 
+  loopspec = loop->specloop;
+
   mpz_init (i);
   for (n = 0; n < loop->dimen; n++)
     {
@@ -3946,12 +3998,12 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where)
              || ss_type == GFC_SS_REFERENCE)
            continue;
 
-         info = &ss->data.info;
+         info = &ss->info->data.array;
          dim = ss->dim[n];
 
          if (loopspec[n] != NULL)
            {
-             specinfo = &loopspec[n]->data.info;
+             specinfo = &loopspec[n]->info->data.array;
              spec_dim = loopspec[n]->dim[n];
            }
          else
@@ -4039,7 +4091,7 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where)
         that's bad news.  */
       gcc_assert (loopspec[n]);
 
-      info = &loopspec[n]->data.info;
+      info = &loopspec[n]->info->data.array;
       dim = loopspec[n]->dim[n];
 
       /* Set the extents of this range.  */
@@ -4110,6 +4162,25 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where)
          loop->from[n] = gfc_index_zero_node;
        }
     }
+  mpz_clear (i);
+}
+
+
+static void set_delta (gfc_loopinfo *loop);
+
+
+/* Initialize the scalarization loop.  Creates the loop variables.  Determines
+   the range of the loop variables.  Creates a temporary if required.
+   Also generates code for scalar expressions which have been
+   moved outside the loop.  */
+
+void
+gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where)
+{
+  gfc_ss *tmp_ss;
+  tree tmp;
+
+  set_loop_bounds (loop);
 
   /* Add all the scalar code that can be taken out of the loops.
      This may include calculating the loop bounds, so do it before
@@ -4127,13 +4198,13 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where)
 
       /* Make absolutely sure that this is a complete type.  */
       if (tmp_ss_info->string_length)
-       loop->temp_ss->data.temp.type
+       tmp_ss_info->data.temp.type
                = gfc_get_character_type_len_for_eltype
-                       (TREE_TYPE (loop->temp_ss->data.temp.type),
+                       (TREE_TYPE (tmp_ss_info->data.temp.type),
                         tmp_ss_info->string_length);
 
-      tmp = loop->temp_ss->data.temp.type;
-      memset (&loop->temp_ss->data.info, 0, sizeof (gfc_array_info));
+      tmp = tmp_ss_info->data.temp.type;
+      memset (&tmp_ss_info->data.array, 0, sizeof (gfc_array_info));
       tmp_ss_info->type = GFC_SS_SECTION;
 
       gcc_assert (tmp_ss->dimen != 0);
@@ -4143,16 +4214,29 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where)
                                   false, true, false, where);
     }
 
-  for (n = 0; n < loop->temp_dim; n++)
-    loopspec[loop->order[n]] = NULL;
-
-  mpz_clear (i);
-
   /* For array parameters we don't have loop variables, so don't calculate the
      translations.  */
   if (loop->array_parameter)
     return;
 
+  set_delta (loop);
+}
+
+
+/* Calculates how to transform from loop variables to array indices for each
+   array: once loop bounds are chosen, sets the difference (DELTA field) between
+   loop bounds and array reference bounds, for each array info.  */
+
+static void
+set_delta (gfc_loopinfo *loop)
+{
+  gfc_ss *ss, **loopspec;
+  gfc_array_info *info;
+  tree tmp;
+  int n, dim;
+
+  loopspec = loop->specloop;
+
   /* Calculate the translation from loop variables to array indices.  */
   for (ss = loop->ss; ss != gfc_ss_terminator; ss = ss->loop_chain)
     {
@@ -4164,7 +4248,7 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where)
          && ss_type != GFC_SS_CONSTRUCTOR)
        continue;
 
-      info = &ss->data.info;
+      info = &ss->info->data.array;
 
       for (n = 0; n < ss->dimen; n++)
        {
@@ -5805,7 +5889,7 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss)
 
       gcc_assert (ss_type == GFC_SS_SECTION);
       gcc_assert (ss_expr == expr);
-      info = &ss->data.info;
+      info = &ss_info->data.array;
 
       /* Get the descriptor for the array.  */
       gfc_conv_ss_descriptor (&se->pre, ss, 0);
@@ -5915,7 +5999,7 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss)
       else
        {
          /* Transformational function.  */
-         info = &ss->data.info;
+         info = &ss_info->data.array;
          need_tmp = 0;
        }
       break;
@@ -5927,7 +6011,7 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss)
          && gfc_constant_array_constructor_p (expr->value.constructor))
        {
          need_tmp = 0;
-         info = &ss->data.info;
+         info = &ss_info->data.array;
        }
       else
        {
@@ -6027,7 +6111,7 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss)
       /* Finish the copying loops.  */
       gfc_trans_scalarizing_loops (&loop, &block);
 
-      desc = loop.temp_ss->data.info.descriptor;
+      desc = loop.temp_ss->info->data.array.descriptor;
     }
   else if (expr->expr_type == EXPR_FUNCTION && !transposed_dims (ss))
     {
@@ -7220,6 +7304,7 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop,
   stmtblock_t fblock;
   gfc_ss *rss;
   gfc_ss *lss;
+  gfc_array_info *linfo;
   tree realloc_expr;
   tree alloc_expr;
   tree size1;
@@ -7271,6 +7356,8 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop,
   if (lss == gfc_ss_terminator)
     return NULL_TREE;
 
+  linfo = &lss->info->data.array;
+
   /* Find an ss for the rhs. For operator expressions, we see the
      ss's for the operands. Any one of these will do.  */
   rss = loop->ss;
@@ -7285,7 +7372,7 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop,
 
   /* Since the lhs is allocatable, this must be a descriptor type.
      Get the data and array size.  */
-  desc = lss->data.info.descriptor;
+  desc = linfo->descriptor;
   gcc_assert (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (desc)));
   array1 = gfc_conv_descriptor_data_get (desc);
 
@@ -7355,7 +7442,7 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop,
 
   /* Get the rhs size.  Fix both sizes.  */
   if (expr2)
-    desc2 = rss->data.info.descriptor;
+    desc2 = rss->info->data.array.descriptor;
   else
     desc2 = NULL_TREE;
   size2 = gfc_index_one_node;
@@ -7445,9 +7532,9 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop,
      running offset.  Use the saved_offset instead.  */
   tmp = gfc_conv_descriptor_offset (desc);
   gfc_add_modify (&fblock, tmp, offset);
-  if (lss->data.info.saved_offset
-       && TREE_CODE (lss->data.info.saved_offset) == VAR_DECL)
-      gfc_add_modify (&fblock, lss->data.info.saved_offset, tmp);
+  if (linfo->saved_offset
+      && TREE_CODE (linfo->saved_offset) == VAR_DECL)
+    gfc_add_modify (&fblock, linfo->saved_offset, tmp);
 
   /* Now set the deltas for the lhs.  */
   for (n = 0; n < expr1->rank; n++)
@@ -7457,9 +7544,9 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop,
       tmp = fold_build2_loc (input_location, MINUS_EXPR,
                             gfc_array_index_type, tmp,
                             loop->from[dim]);
-      if (lss->data.info.delta[dim]
-           && TREE_CODE (lss->data.info.delta[dim]) == VAR_DECL)
-       gfc_add_modify (&fblock, lss->data.info.delta[dim], tmp);
+      if (linfo->delta[dim]
+         && TREE_CODE (linfo->delta[dim]) == VAR_DECL)
+       gfc_add_modify (&fblock, linfo->delta[dim], tmp);
     }
 
   /* Get the new lhs size in bytes.  */
@@ -7523,11 +7610,11 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop,
   gfc_add_expr_to_block (&fblock, tmp);
 
   /* Make sure that the scalarizer data pointer is updated.  */
-  if (lss->data.info.data
-       && TREE_CODE (lss->data.info.data) == VAR_DECL)
+  if (linfo->data
+      && TREE_CODE (linfo->data) == VAR_DECL)
     {
       tmp = gfc_conv_descriptor_data_get (desc);
-      gfc_add_modify (&fblock, lss->data.info.data, tmp);
+      gfc_add_modify (&fblock, linfo->data, tmp);
     }
 
   /* Add the exit label.  */
@@ -7717,7 +7804,7 @@ gfc_walk_array_ref (gfc_ss * ss, gfc_expr * expr, gfc_ref * ref)
 
        case AR_FULL:
          newss = gfc_get_array_ss (ss, expr, ar->as->rank, GFC_SS_SECTION);
-         newss->data.info.ref = ref;
+         newss->info->data.array.ref = ref;
 
          /* Make sure array is the same as array(:,:), this way
             we don't need to special case all the time.  */
@@ -7735,7 +7822,7 @@ gfc_walk_array_ref (gfc_ss * ss, gfc_expr * expr, gfc_ref * ref)
 
        case AR_SECTION:
          newss = gfc_get_array_ss (ss, expr, 0, GFC_SS_SECTION);
-         newss->data.info.ref = ref;
+         newss->info->data.array.ref = ref;
 
          /* We add SS chains for all the subscripts in the section.  */
          for (n = 0; n < ar->dimen; n++)
@@ -7749,7 +7836,7 @@ gfc_walk_array_ref (gfc_ss * ss, gfc_expr * expr, gfc_ref * ref)
                  gcc_assert (ar->start[n]);
                  indexss = gfc_get_scalar_ss (gfc_ss_terminator, ar->start[n]);
                  indexss->loop_chain = gfc_ss_terminator;
-                 newss->data.info.subscript[n] = indexss;
+                 newss->info->data.array.subscript[n] = indexss;
                  break;
 
                case DIMEN_RANGE:
@@ -7765,7 +7852,7 @@ gfc_walk_array_ref (gfc_ss * ss, gfc_expr * expr, gfc_ref * ref)
                  indexss = gfc_get_array_ss (gfc_ss_terminator, ar->start[n],
                                              1, GFC_SS_VECTOR);
                  indexss->loop_chain = gfc_ss_terminator;
-                 newss->data.info.subscript[n] = indexss;
+                 newss->info->data.array.subscript[n] = indexss;
                  newss->dim[newss->dimen] = n;
                  newss->dimen++;
                  break;
@@ -7778,7 +7865,7 @@ gfc_walk_array_ref (gfc_ss * ss, gfc_expr * expr, gfc_ref * ref)
          /* We should have at least one non-elemental dimension,
             unless we are creating a descriptor for a (scalar) coarray.  */
          gcc_assert (newss->dimen > 0
-                     || newss->data.info.ref->u.ar.as->corank > 0);
+                     || newss->info->data.array.ref->u.ar.as->corank > 0);
          ss = newss;
          break;