re PR fortran/28974 (Extremely slow compilation of enumerated DATA statements.)

2006-11-15  Bud Davis <bdavis9659@sbcglobal.net>

        PR fortran/28974
        * gfortran.h (gfc_expr): Add element which holds a splay-tree
        for the exclusive purpose of quick access to a constructor by
        offset.
        * data.c (find_con_by_offset): Use the splay tree for the search.
        (gfc_assign_data_value): Use the splay tree.
        (gfc_assign_data_value_range): ditto.
        * expr.c (gfc_get_expr): Initialize new element to null.
        (gfc_free_expr): Delete splay tree when deleting gfc_expr.

From-SVN: r118844

4 files changed, 119 insertions, 45 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 501517a..3206979 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,15 @@
+2006-11-15  Bud Davis <bdavis9659@sbcglobal.net>
+
+	PR fortran/28974
+	* gfortran.h (gfc_expr): Add element which holds a splay-tree
+	for the exclusive purpose of quick access to a constructor by
+	offset.
+	* data.c (find_con_by_offset): Use the splay tree for the search.
+	(gfc_assign_data_value): Use the splay tree.
+	(gfc_assign_data_value_range): ditto.
+	* expr.c (gfc_get_expr): Initialize new element to null.
+	(gfc_free_expr): Delete splay tree when deleting gfc_expr.
+
 2006-11-14  Brooks Moses  <brooks.moses@codesourcery.com>
 
 	PR fortran/29702
diff --git a/gcc/fortran/data.c b/gcc/fortran/data.c
index b17d6b8..5af3bd77 100644
--- a/gcc/fortran/data.c
+++ b/gcc/fortran/data.c
@@ -80,41 +80,48 @@ get_array_index (gfc_array_ref * ar, mpz_t * offset)
 /* Find if there is a constructor which offset is equal to OFFSET.  */
 
 static gfc_constructor *
-find_con_by_offset (mpz_t offset, gfc_constructor *con)
+find_con_by_offset (splay_tree spt, mpz_t offset)
 {
   mpz_t tmp;
   gfc_constructor *ret = NULL;
+  gfc_constructor *con;
+  splay_tree_node sptn;
 
-  mpz_init (tmp);
+/* The complexity is due to needing quick access to the linked list of
+   constructors.  Both a linked list and a splay tree are used, and both are
+   kept up to date if they are array elements (which is the only time that
+   a specific constructor has to be found).  */  
 
-  for (; con; con = con->next)
-    {
-      int cmp = mpz_cmp (offset, con->n.offset);
-
-      /* We retain a sorted list, so if we're too large, we're done.  */
-      if (cmp < 0)
-	break;
+  gcc_assert (spt != NULL);
+  mpz_init (tmp);
 
-      /* Yaye for exact matches.  */
-      if (cmp == 0)
-	{
-          ret = con;
-	  break;
-	}
+  sptn = splay_tree_lookup (spt, (splay_tree_key) mpz_get_si(offset));
 
-      /* If the constructor element is a range, match any element.  */
-      if (mpz_cmp_ui (con->repeat, 1) > 0)
-	{
-	  mpz_add (tmp, con->n.offset, con->repeat);
-	  if (mpz_cmp (offset, tmp) < 0)
-	    {
-	      ret = con;
-	      break;
-	    }
-	}
+  if (sptn)
+    ret = (gfc_constructor*) sptn->value;  
+  else
+    {
+       /* Need to check and see if we match a range, so we will pull
+          the next lowest index and see if the range matches.  */
+       sptn = splay_tree_predecessor (spt, (splay_tree_key) mpz_get_si(offset));
+       if (sptn)
+         {
+            con = (gfc_constructor*) sptn->value;
+            if (mpz_cmp_ui (con->repeat, 1) > 0)
+              {
+                 mpz_init (tmp);
+                 mpz_add (tmp, con->n.offset, con->repeat);
+                 if (mpz_cmp (offset, tmp) < 0)
+                   ret = con;
+                 mpz_clear (tmp);
+              }
+            else 
+              ret = NULL; /* The range did not match.  */
+         }
+      else
+        ret = NULL; /* No pred, so no match.  */
     }
 
-  mpz_clear (tmp);
   return ret;
 }
 
@@ -230,9 +237,12 @@ gfc_assign_data_value (gfc_expr * lvalue, gfc_expr * rvalue, mpz_t index)
   gfc_expr *expr;
   gfc_constructor *con;
   gfc_constructor *last_con;
+  gfc_constructor *pred;
   gfc_symbol *symbol;
   gfc_typespec *last_ts;
   mpz_t offset;
+  splay_tree spt;
+  splay_tree_node sptn;
 
   symbol = lvalue->symtree->n.sym;
   init = symbol->value;
@@ -279,16 +289,38 @@ gfc_assign_data_value (gfc_expr * lvalue, gfc_expr * rvalue, mpz_t index)
 	  else
 	    mpz_set (offset, index);
 
-	  /* Find the same element in the existing constructor.  */
-	  con = expr->value.constructor;
-	  con = find_con_by_offset (offset, con);
+          /* Splay tree containing offset and gfc_constructor.  */
+          spt = expr->con_by_offset;
+
+          if (spt == NULL)
+            {
+               spt = splay_tree_new (splay_tree_compare_ints,NULL,NULL);
+               expr->con_by_offset = spt; 
+               con = NULL;
+            }
+         else
+	  con = find_con_by_offset (spt, offset);
 
 	  if (con == NULL)
 	    {
 	      /* Create a new constructor.  */
 	      con = gfc_get_constructor ();
 	      mpz_set (con->n.offset, offset);
-	      gfc_insert_constructor (expr, con);
+              sptn = splay_tree_insert (spt, (splay_tree_key) mpz_get_si(offset),
+                                       (splay_tree_value) con);
+              /* Fix up the linked list.  */
+              sptn = splay_tree_predecessor (spt, (splay_tree_key) mpz_get_si(offset));
+              if (sptn == NULL)
+                {  /* Insert at the head.  */
+                   con->next = expr->value.constructor;
+                   expr->value.constructor = con;
+                }
+              else
+                {  /* Insert in the chain.  */
+                   pred = (gfc_constructor*) sptn->value;
+                   con->next = pred->next;
+                   pred->next = con;
+                }
 	    }
 	  break;
 
@@ -379,9 +411,12 @@ gfc_assign_data_value_range (gfc_expr * lvalue, gfc_expr * rvalue,
   gfc_ref *ref;
   gfc_expr *init, *expr;
   gfc_constructor *con, *last_con;
+  gfc_constructor *pred;
   gfc_symbol *symbol;
   gfc_typespec *last_ts;
   mpz_t offset;
+  splay_tree spt;
+  splay_tree_node sptn;
 
   symbol = lvalue->symtree->n.sym;
   init = symbol->value;
@@ -435,19 +470,43 @@ gfc_assign_data_value_range (gfc_expr * lvalue, gfc_expr * rvalue,
 	    }
 
 	  /* Find the same element in the existing constructor.  */
-	  con = expr->value.constructor;
-	  con = find_con_by_offset (offset, con);
 
-	  /* Create a new constructor.  */
-	  if (con == NULL)
-	    {
-	      con = gfc_get_constructor ();
-	      mpz_set (con->n.offset, offset);
-	      if (ref->next == NULL)
-		mpz_set (con->repeat, repeat);
-	      gfc_insert_constructor (expr, con);
-	    }
-	  else
+          /* Splay tree containing offset and gfc_constructor.  */
+          spt = expr->con_by_offset;
+
+          if (spt == NULL)
+            {
+               spt = splay_tree_new (splay_tree_compare_ints,NULL,NULL);
+               expr->con_by_offset = spt;
+               con = NULL;
+            }
+          else 
+            con = find_con_by_offset (spt, offset);
+
+          if (con == NULL)
+            {
+              /* Create a new constructor.  */
+              con = gfc_get_constructor ();
+              mpz_set (con->n.offset, offset);
+              if (ref->next == NULL)
+                mpz_set (con->repeat, repeat);
+              sptn = splay_tree_insert (spt, (splay_tree_key) mpz_get_si(offset),
+                                       (splay_tree_value) con);
+              /* Fix up the linked list.  */
+              sptn = splay_tree_predecessor (spt, (splay_tree_key) mpz_get_si(offset));
+              if (sptn == NULL)
+                {  /* Insert at the head.  */
+                   con->next = expr->value.constructor;
+                   expr->value.constructor = con;
+                }
+              else
+                {  /* Insert in the chain.  */
+                   pred = (gfc_constructor*) sptn->value;
+                   con->next = pred->next;
+                   pred->next = con;
+                }
+            }
+          else
 	    gcc_assert (ref->next != NULL);
 	  break;
 
diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index 9c25e5a..96f39c8 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -39,7 +39,7 @@ gfc_get_expr (void)
   e->shape = NULL;
   e->ref = NULL;
   e->symtree = NULL;
-
+  e->con_by_offset = NULL;
   return e;
 }
 
@@ -226,7 +226,8 @@ gfc_free_expr (gfc_expr * e)
 
   if (e == NULL)
     return;
-
+  if (e->con_by_offset)
+    splay_tree_delete (e->con_by_offset); 
   free_expr0 (e);
   gfc_free (e);
 }
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index cf0dabf..dbba22e 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -33,7 +33,7 @@ Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA
 #include "intl.h"
 #include "coretypes.h"
 #include "input.h"
-
+#include "splay-tree.h"
 /* The following ifdefs are recommended by the autoconf documentation
    for any code using alloca.  */
 
@@ -1245,6 +1245,8 @@ typedef struct gfc_expr
   /* True if the expression is a call to a function that returns an array,
      and if we have decided not to allocate temporary data for that array.  */
   unsigned int inline_noncopying_intrinsic : 1;
+  /* Used to quickly find a given constructor by it's offset.  */
+  splay_tree con_by_offset;
 
   union
   {