OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

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
This commit is contained in:
Bud Davis 2006-11-15 05:10:22 +00:00 committed by Bud Davis
parent 12c7896669
commit 5868cbf992
4 changed files with 119 additions and 45 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
gcc/fortran/ChangeLog
View File

@ -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

143
gcc/fortran/data.c
View File

@ -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;
/* 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;
}
@ -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;

5
gcc/fortran/expr.c
View File

@ -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);
}

4
gcc/fortran/gfortran.h
View File

@ -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
{