diff options
-rw-r--r-- | gcc/fortran/ChangeLog | 12 | ||||
-rw-r--r-- | gcc/fortran/data.c | 143 | ||||
-rw-r--r-- | gcc/fortran/expr.c | 5 | ||||
-rw-r--r-- | gcc/fortran/gfortran.h | 4 |
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 { |