gfortran patch for PR28974 Slow compilation of data statements.

[Bud Davis <bdavis9659 at sbcglobal dot net>]

The below patch uses a splay tree instead of a linked
list for accessing constructors by offset (index).

In order to keep from changing about 50% of the
routines in the front end, i kept the existing linked
list representation intact; so when needed a splay
tree is used in addition to the linked list.

tested on i686/gnu/linx FC6 with no additional
regressions.

no tests provided because it is a performance, not a
correctness change.

submitters example now compiles in about 3 seconds vs.
about 3.5 minutes previous.

--bud

2006-11-06  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): Delet splay tree when
deleting gfc_expr.
Index: gcc/gcc/fortran/gfortran.h
===================================================================
--- gcc/gcc/fortran/gfortran.h  (revision 118516)
+++ gcc/gcc/fortran/gfortran.h  (working copy)
@@ -33,7 +33,7 @@
 #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.  */
 
@@ -1246,6 +1246,8 @@
   /* 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
   {
Index: gcc/gcc/fortran/data.c
===================================================================
--- gcc/gcc/fortran/data.c      (revision 118516)
+++ gcc/gcc/fortran/data.c      (working copy)
@@ -79,41 +79,48 @@
 /* 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;
 
+/* 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 */  
+
+  gcc_assert (spt != NULL);
   mpz_init (tmp);
 
-  for (; con; con = con->next)
+  sptn = splay_tree_lookup (spt, (splay_tree_key)
mpz_get_si(offset));
+
+  if (sptn)
+    ret = (gfc_constructor*) sptn->value;  
+  else
     {
-      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;
-
-      /* Yaye for exact matches.  */
-      if (cmp == 0)
-       {
-          ret = con;
-         break;
-       }
-
-      /* 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;
-           }
-       }
+       /* 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;
 }
 
@@ -229,9 +236,12 @@
   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;
@@ -278,16 +288,38 @@
          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;
 
@@ -378,9 +410,12 @@
   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;
@@ -434,19 +469,43 @@
            }
 
          /* 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;
 
Index: gcc/gcc/fortran/expr.c
===================================================================
--- gcc/gcc/fortran/expr.c      (revision 118516)
+++ gcc/gcc/fortran/expr.c      (working copy)
@@ -39,7 +39,7 @@
   e->shape = NULL;
   e->ref = NULL;
   e->symtree = NULL;
-
+  e->con_by_offset = NULL;
   return e;
 }
 
@@ -226,7 +226,8 @@
 
   if (e == NULL)
     return;
-
+  if (e->con_by_offset)
+    splay_tree_delete (e->con_by_offset); 
   free_expr0 (e);
   gfc_free (e);
 }

Attachment: newpatch
Description: 2150712329-newpatch