re PR fortran/13465 (Data statement for large arrays compiles verrrry slllowwwly and shows quadratic behaviour.)

        PR 13465
        * data.c (find_con_by_offset): Search ordered list; handle
        elements with repeat counts.
        (gfc_assign_data_value_range): New.
        * gfortran.h (struct gfc_data_value): Make repeat unsigned.
        (gfc_assign_data_value_range): Declare.
        * match.c (top_val_list): Extract repeat count into a temporary.
        * resolve.c (values): Make left unsigned.
        (next_data_value): Don't decrement left.
        (check_data_variable): Use gfc_assign_data_value_range.

From-SVN: r86443

1 files changed, 48 insertions, 16 deletions

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 1dc4db8..dfca4ab 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -4037,7 +4037,7 @@ resolve_symbol (gfc_symbol * sym)
 static struct
 {
   gfc_data_value *vnode;
-  int left;
+  unsigned int left;
 }
 values;
 
@@ -4047,7 +4047,6 @@ values;
 static try
 next_data_value (void)
 {
-
   while (values.left == 0)
     {
       if (values.vnode->next == NULL)
@@ -4057,7 +4056,6 @@ next_data_value (void)
       values.left = values.vnode->repeat;
     }
 
-  values.left--;
   return SUCCESS;
 }
 
@@ -4086,7 +4084,10 @@ check_data_variable (gfc_data_variable * var, locus * where)
     gfc_internal_error ("check_data_variable(): Bad expression");
 
   if (e->rank == 0)
-    mpz_init_set_ui (size, 1);
+    {
+      mpz_init_set_ui (size, 1);
+      ref = NULL;
+    }
   else
     {
       ref = e->ref;
@@ -4145,19 +4146,54 @@ check_data_variable (gfc_data_variable * var, locus * where)
       if (t == FAILURE)
 	break;
 
+      /* If we have more than one element left in the repeat count,
+	 and we have more than one element left in the target variable,
+	 then create a range assignment.  */
+      /* ??? Only done for full arrays for now, since array sections
+	 seem tricky.  */
+      if (mark == AR_FULL && ref && ref->next == NULL
+	  && values.left > 1 && mpz_cmp_ui (size, 1) > 0)
+	{
+	  mpz_t range;
+
+	  if (mpz_cmp_ui (size, values.left) >= 0)
+	    {
+	      mpz_init_set_ui (range, values.left);
+	      mpz_sub_ui (size, size, values.left);
+	      values.left = 0;
+	    }
+	  else
+	    {
+	      mpz_init_set (range, size);
+	      values.left -= mpz_get_ui (size);
+	      mpz_set_ui (size, 0);
+	    }
+
+	  gfc_assign_data_value_range (var->expr, values.vnode->expr,
+				       offset, range);
+
+	  mpz_add (offset, offset, range);
+	  mpz_clear (range);
+	}
+
       /* Assign initial value to symbol.  */
-      gfc_assign_data_value (var->expr, values.vnode->expr, offset);
+      else
+	{
+	  values.left -= 1;
+	  mpz_sub_ui (size, size, 1);
 
-      if (mark == AR_FULL)
-        mpz_add_ui (offset, offset, 1);
+	  gfc_assign_data_value (var->expr, values.vnode->expr, offset);
 
-      /* Modify the array section indexes and recalculate the offset for
-         next element.  */
-      else if (mark == AR_SECTION)
-        gfc_advance_section (section_index, ar, &offset);
+	  if (mark == AR_FULL)
+	    mpz_add_ui (offset, offset, 1);
 
-      mpz_sub_ui (size, size, 1);
+	  /* Modify the array section indexes and recalculate the offset
+	     for next element.  */
+	  else if (mark == AR_SECTION)
+	    gfc_advance_section (section_index, ar, &offset);
+	}
     }
+
   if (mark == AR_SECTION)
     {
       for (i = 0; i < ar->dimen; i++)
@@ -4253,7 +4289,6 @@ traverse_data_var (gfc_data_variable * var, locus * where)
 static try
 resolve_data_variables (gfc_data_variable * d)
 {
-
   for (; d; d = d->next)
     {
       if (d->list == NULL)
@@ -4287,7 +4322,6 @@ resolve_data_variables (gfc_data_variable * d)
 static void
 resolve_data (gfc_data * d)
 {
-
   if (resolve_data_variables (d->var) == FAILURE)
     return;
 
@@ -4312,7 +4346,6 @@ resolve_data (gfc_data * d)
 int
 gfc_impure_variable (gfc_symbol * sym)
 {
-
   if (sym->attr.use_assoc || sym->attr.in_common)
     return 1;
 
@@ -4606,4 +4639,3 @@ gfc_resolve (gfc_namespace * ns)
 
   gfc_current_ns = old_ns;
 }
-