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

re PR fortran/49540 (Memory-hog with large DATA stmt)

Browse Source 
PR fortran/49540
	* gfortran.h (gfc_constructor): Add repeat field.
	* trans-array.c (gfc_conv_array_initializer): Handle repeat > 1.
	* array.c (current_expand): Add repeat field.
	(expand_constructor): Copy repeat.
	* constructor.c (node_free, node_copy, gfc_constructor_get,
	gfc_constructor_lookup): Handle repeat field.
	(gfc_constructor_lookup_next, gfc_constructor_remove): New functions.
	* data.h (gfc_assign_data_value): Add mpz_t * argument.
	(gfc_assign_data_value_range): Removed.
	* constructor.h (gfc_constructor_advance): Removed.
	(gfc_constructor_lookup_next, gfc_constructor_remove): New prototypes.
	* data.c (gfc_assign_data_value): Add REPEAT argument, handle it and
	also handle overwriting a range with a single entry.
	(gfc_assign_data_value_range): Removed.
	* resolve.c (check_data_variable): Adjust gfc_assign_data_value
	call.  Use gfc_assign_data_value instead of
	gfc_assign_data_value_expr.

	* gfortran.dg/pr49540-1.f90: New test.
	* gfortran.dg/pr49540-2.f90: New test.

From-SVN: r175693
This commit is contained in:
Jakub Jelinek 2011-06-30 12:25:40 +02:00 committed by Jakub Jelinek
parent f7069d58f6
commit 21ea4922ac
12 changed files with 272 additions and 49 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
gcc/fortran/ChangeLog
View File

@ -1,3 +1,24 @@
2011-06-30 Jakub Jelinek <jakub@redhat.com>
PR fortran/49540
* gfortran.h (gfc_constructor): Add repeat field.
* trans-array.c (gfc_conv_array_initializer): Handle repeat > 1.
* array.c (current_expand): Add repeat field.
(expand_constructor): Copy repeat.
* constructor.c (node_free, node_copy, gfc_constructor_get,
gfc_constructor_lookup): Handle repeat field.
(gfc_constructor_lookup_next, gfc_constructor_remove): New functions.
* data.h (gfc_assign_data_value): Add mpz_t * argument.
(gfc_assign_data_value_range): Removed.
* constructor.h (gfc_constructor_advance): Removed.
(gfc_constructor_lookup_next, gfc_constructor_remove): New prototypes.
* data.c (gfc_assign_data_value): Add REPEAT argument, handle it and
also handle overwriting a range with a single entry.
(gfc_assign_data_value_range): Removed.
* resolve.c (check_data_variable): Adjust gfc_assign_data_value
call. Use gfc_assign_data_value instead of
gfc_assign_data_value_expr.
2011-06-27 Janus Weil <janus@gcc.gnu.org>
PR fortran/49466

2
gcc/fortran/array.c
View File

@ -1322,6 +1322,7 @@ typedef struct
mpz_t *offset;
gfc_component *component;
mpz_t *repeat;
gfc_try (*expand_work_function) (gfc_expr *);
}
@ -1556,6 +1557,7 @@ expand_constructor (gfc_constructor_base base)
return FAILURE;
}
current_expand.offset = &c->offset;
current_expand.repeat = &c->repeat;
current_expand.component = c->n.component;
if (current_expand.expand_work_function (e) == FAILURE)
return FAILURE;

49
gcc/fortran/constructor.c
View File

@ -1,5 +1,5 @@
/* Array and structure constructors
Copyright (C) 2009, 2010
Copyright (C) 2009, 2010, 2011
Free Software Foundation, Inc.
This file is part of GCC.
@ -36,6 +36,7 @@ node_free (splay_tree_value value)
gfc_free_iterator (c->iterator, 1);
mpz_clear (c->offset);
mpz_clear (c->repeat);
free (c);
}
@ -54,6 +55,7 @@ node_copy (splay_tree_node node, void *base)
c->n.component = src->n.component;
mpz_init_set (c->offset, src->offset);
mpz_init_set (c->repeat, src->repeat);
return c;
}
@ -78,6 +80,7 @@ gfc_constructor_get (void)
c->iterator = NULL;
mpz_init_set_si (c->offset, 0);
mpz_init_set_si (c->repeat, 1);
return c;
}
@ -169,6 +172,7 @@ gfc_constructor_insert_expr (gfc_constructor_base *base,
gfc_constructor *
gfc_constructor_lookup (gfc_constructor_base base, int offset)
{
gfc_constructor *c;
splay_tree_node node;
if (!base)
@ -176,9 +180,24 @@ gfc_constructor_lookup (gfc_constructor_base base, int offset)
node = splay_tree_lookup (base, (splay_tree_key) offset);
if (node)
return (gfc_constructor*) node->value;
return (gfc_constructor *) node->value;
return NULL;
/* Check if the previous node has a repeat count big enough to
cover the offset looked for. */
node = splay_tree_predecessor (base, (splay_tree_key) offset);
if (!node)
return NULL;
c = (gfc_constructor *) node->value;
if (mpz_cmp_si (c->repeat, 1) > 0)
{
if (mpz_get_si (c->offset) + mpz_get_si (c->repeat) <= offset)
c = NULL;
}
else
c = NULL;
return c;
}
@ -232,3 +251,27 @@ gfc_constructor_next (gfc_constructor *ctor)
else
return NULL;
}
void
gfc_constructor_remove (gfc_constructor *ctor)
{
if (ctor)
splay_tree_remove (ctor->base, mpz_get_si (ctor->offset));
}
gfc_constructor *
gfc_constructor_lookup_next (gfc_constructor_base base, int offset)
{
splay_tree_node node;
if (!base)
return NULL;
node = splay_tree_successor (base, (splay_tree_key) offset);
if (!node)
return NULL;
return (gfc_constructor *) node->value;
}

8
gcc/fortran/constructor.h
View File

@ -1,5 +1,5 @@
/* Array and structure constructors
Copyright (C) 2009, 2010
Copyright (C) 2009, 2010, 2011
Free Software Foundation, Inc.
This file is part of GCC.
@ -81,6 +81,10 @@ gfc_constructor *gfc_constructor_first (gfc_constructor_base base);
Returns NULL if there is no next expression. */
gfc_constructor *gfc_constructor_next (gfc_constructor *ctor);
gfc_constructor *gfc_constructor_advance (gfc_constructor *ctor, int n);
/* Remove the gfc_constructor node from the splay tree. */
void gfc_constructor_remove (gfc_constructor *);
/* Return first constructor node after offset. */
gfc_constructor *gfc_constructor_lookup_next (gfc_constructor_base, int);
#endif /* GFC_CONSTRUCTOR_H */

160
gcc/fortran/data.c
View File

@ -1,5 +1,5 @@
/* Supporting functions for resolving DATA statement.
Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011
Free Software Foundation, Inc.
Contributed by Lifang Zeng <zlf605@hotmail.com>
@ -189,10 +189,13 @@ create_character_initializer (gfc_expr *init, gfc_typespec *ts,
/* Assign the initial value RVALUE to LVALUE's symbol->value. If the
LVALUE already has an initialization, we extend this, otherwise we
create a new one. */
create a new one. If REPEAT is non-NULL, initialize *REPEAT
consecutive values in LVALUE the same value in RVALUE. In that case,
LVALUE must refer to a full array, not an array section. */
gfc_try
gfc_assign_data_value (gfc_expr *lvalue, gfc_expr *rvalue, mpz_t index)
gfc_assign_data_value (gfc_expr *lvalue, gfc_expr *rvalue, mpz_t index,
mpz_t *repeat)
{
gfc_ref *ref;
gfc_expr *init;
@ -269,6 +272,100 @@ gfc_assign_data_value (gfc_expr *lvalue, gfc_expr *rvalue, mpz_t index)
&lvalue->where);
goto abort;
}
else if (repeat != NULL
&& ref->u.ar.type != AR_ELEMENT)
{
mpz_t size, end;
gcc_assert (ref->u.ar.type == AR_FULL
&& ref->next == NULL);
mpz_init_set (end, offset);
mpz_add (end, end, *repeat);
if (spec_size (ref->u.ar.as, &size) == SUCCESS)
{
if (mpz_cmp (end, size) > 0)
{
mpz_clear (size);
gfc_error ("Data element above array upper bound at %L",
&lvalue->where);
goto abort;
}
mpz_clear (size);
}
con = gfc_constructor_lookup (expr->value.constructor,
mpz_get_si (offset));
if (!con)
{
con = gfc_constructor_lookup_next (expr->value.constructor,
mpz_get_si (offset));
if (con != NULL && mpz_cmp (con->offset, end) >= 0)
con = NULL;
}
/* Overwriting an existing initializer is non-standard but
usually only provokes a warning from other compilers. */
if (con != NULL && con->expr != NULL)
{
/* Order in which the expressions arrive here depends on
whether they are from data statements or F95 style
declarations. Therefore, check which is the most
recent. */
gfc_expr *exprd;
exprd = (LOCATION_LINE (con->expr->where.lb->location)
> LOCATION_LINE (rvalue->where.lb->location))
? con->expr : rvalue;
if (gfc_notify_std (GFC_STD_GNU,"Extension: "
"re-initialization of '%s' at %L",
symbol->name, &exprd->where) == FAILURE)
return FAILURE;
}
while (con != NULL)
{
gfc_constructor *next_con = gfc_constructor_next (con);
if (mpz_cmp (con->offset, end) >= 0)
break;
if (mpz_cmp (con->offset, offset) < 0)
{
gcc_assert (mpz_cmp_si (con->repeat, 1) > 0);
mpz_sub (con->repeat, offset, con->offset);
}
else if (mpz_cmp_si (con->repeat, 1) > 0
&& mpz_get_si (con->offset)
+ mpz_get_si (con->repeat) > mpz_get_si (end))
{
int endi;
splay_tree_node node
= splay_tree_lookup (con->base,
mpz_get_si (con->offset));
gcc_assert (node
&& con == (gfc_constructor *) node->value
&& node->key == (splay_tree_key)
mpz_get_si (con->offset));
endi = mpz_get_si (con->offset)
+ mpz_get_si (con->repeat);
if (endi > mpz_get_si (end) + 1)
mpz_set_si (con->repeat, endi - mpz_get_si (end));
else
mpz_set_si (con->repeat, 1);
mpz_set (con->offset, end);
node->key = (splay_tree_key) mpz_get_si (end);
break;
}
else
gfc_constructor_remove (con);
con = next_con;
}
con = gfc_constructor_insert_expr (&expr->value.constructor,
NULL, &rvalue->where,
mpz_get_si (offset));
mpz_set (con->repeat, *repeat);
repeat = NULL;
mpz_clear (end);
break;
}
else
{
mpz_t size;
@ -293,6 +390,32 @@ gfc_assign_data_value (gfc_expr *lvalue, gfc_expr *rvalue, mpz_t index)
NULL, &rvalue->where,
mpz_get_si (offset));
}
else if (mpz_cmp_si (con->repeat, 1) > 0)
{
/* Need to split a range. */
if (mpz_cmp (con->offset, offset) < 0)
{
gfc_constructor *pred_con = con;
con = gfc_constructor_insert_expr (&expr->value.constructor,
NULL, &con->where,
mpz_get_si (offset));
con->expr = gfc_copy_expr (pred_con->expr);
mpz_add (con->repeat, pred_con->offset, pred_con->repeat);
mpz_sub (con->repeat, con->repeat, offset);
mpz_sub (pred_con->repeat, offset, pred_con->offset);
}
if (mpz_cmp_si (con->repeat, 1) > 0)
{
gfc_constructor *succ_con;
succ_con
= gfc_constructor_insert_expr (&expr->value.constructor,
NULL, &con->where,
mpz_get_si (offset) + 1);
succ_con->expr = gfc_copy_expr (con->expr);
mpz_sub_ui (succ_con->repeat, con->repeat, 1);
mpz_set_si (con->repeat, 1);
}
}
break;
case REF_COMPONENT:
@ -337,6 +460,7 @@ gfc_assign_data_value (gfc_expr *lvalue, gfc_expr *rvalue, mpz_t index)
}
mpz_clear (offset);
gcc_assert (repeat == NULL);
if (ref || last_ts->type == BT_CHARACTER)
{
@ -380,36 +504,6 @@ abort:
}
/* Similarly, but initialize REPEAT consecutive values in LVALUE the same
value in RVALUE. */
gfc_try
gfc_assign_data_value_range (gfc_expr *lvalue, gfc_expr *rvalue,
mpz_t index, mpz_t repeat)
{
mpz_t offset, last_offset;
gfc_try t;
mpz_init (offset);
mpz_init (last_offset);
mpz_add (last_offset, index, repeat);
t = SUCCESS;
for (mpz_set(offset, index) ; mpz_cmp(offset, last_offset) < 0;
mpz_add_ui (offset, offset, 1))
if (gfc_assign_data_value (lvalue, rvalue, offset) == FAILURE)
{
t = FAILURE;
break;
}
mpz_clear (offset);
mpz_clear (last_offset);
return t;
}
/* Modify the index of array section and re-calculate the array offset. */
void

5
gcc/fortran/data.h
View File

@ -1,5 +1,5 @@
/* Header for functions resolving DATA statements.
Copyright (C) 2007, 2008, 2010 Free Software Foundation, Inc.
Copyright (C) 2007, 2008, 2010, 2011 Free Software Foundation, Inc.
This file is part of GCC.
@ -19,6 +19,5 @@ along with GCC; see the file COPYING3. If not see
void gfc_formalize_init_value (gfc_symbol *);
void gfc_get_section_index (gfc_array_ref *, mpz_t *, mpz_t *);
gfc_try gfc_assign_data_value (gfc_expr *, gfc_expr *, mpz_t);
gfc_try gfc_assign_data_value_range (gfc_expr *, gfc_expr *, mpz_t, mpz_t);
gfc_try gfc_assign_data_value (gfc_expr *, gfc_expr *, mpz_t, mpz_t *);
void gfc_advance_section (mpz_t *, gfc_array_ref *, mpz_t *);

2
gcc/fortran/gfortran.h
View File

@ -2271,6 +2271,8 @@ typedef struct gfc_constructor
gfc_component *component; /* Record the component being initialized. */
}
n;
mpz_t repeat; /* Record the repeat number of initial values in data
statement like "data a/5*10/". */
}
gfc_constructor;

7
gcc/fortran/resolve.c
View File

@ -12752,8 +12752,8 @@ check_data_variable (gfc_data_variable *var, locus *where)
mpz_set_ui (size, 0);
}
t = gfc_assign_data_value_range (var->expr, values.vnode->expr,
offset, range);
t = gfc_assign_data_value (var->expr, values.vnode->expr,
offset, &range);
mpz_add (offset, offset, range);
mpz_clear (range);
@ -12768,7 +12768,8 @@ check_data_variable (gfc_data_variable *var, locus *where)
mpz_sub_ui (values.left, values.left, 1);
mpz_sub_ui (size, size, 1);
t = gfc_assign_data_value (var->expr, values.vnode->expr, offset);
t = gfc_assign_data_value (var->expr, values.vnode->expr,
offset, NULL);
if (t == FAILURE)
break;

38
gcc/fortran/trans-array.c
View File

@ -4555,7 +4555,7 @@ gfc_conv_array_initializer (tree type, gfc_expr * expr)
gfc_se se;
HOST_WIDE_INT hi;
unsigned HOST_WIDE_INT lo;
tree index;
tree index, range;
VEC(constructor_elt,gc) *v = NULL;
switch (expr->expr_type)
@ -4609,28 +4609,56 @@ gfc_conv_array_initializer (tree type, gfc_expr * expr)
else
index = NULL_TREE;
if (mpz_cmp_si (c->repeat, 1) > 0)
{
tree tmp1, tmp2;
mpz_t maxval;
mpz_init (maxval);
mpz_add (maxval, c->offset, c->repeat);
mpz_sub_ui (maxval, maxval, 1);
tmp2 = gfc_conv_mpz_to_tree (maxval, gfc_index_integer_kind);
if (mpz_cmp_si (c->offset, 0) != 0)
{
mpz_add_ui (maxval, c->offset, 1);
tmp1 = gfc_conv_mpz_to_tree (maxval, gfc_index_integer_kind);
}
else
tmp1 = gfc_conv_mpz_to_tree (c->offset, gfc_index_integer_kind);
range = fold_build2 (RANGE_EXPR, gfc_array_index_type, tmp1, tmp2);
mpz_clear (maxval);
}
else
range = NULL;
gfc_init_se (&se, NULL);
switch (c->expr->expr_type)
{
case EXPR_CONSTANT:
gfc_conv_constant (&se, c->expr);
CONSTRUCTOR_APPEND_ELT (v, index, se.expr);
break;
case EXPR_STRUCTURE:
gfc_conv_structure (&se, c->expr, 1);
CONSTRUCTOR_APPEND_ELT (v, index, se.expr);
break;
default:
/* Catch those occasional beasts that do not simplify
for one reason or another, assuming that if they are
standard defying the frontend will catch them. */
gfc_conv_expr (&se, c->expr);
CONSTRUCTOR_APPEND_ELT (v, index, se.expr);
break;
}
if (range == NULL_TREE)
CONSTRUCTOR_APPEND_ELT (v, index, se.expr);
else
{
if (index != NULL_TREE)
CONSTRUCTOR_APPEND_ELT (v, index, se.expr);
CONSTRUCTOR_APPEND_ELT (v, range, se.expr);
}
}
break;

6
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,9 @@
2011-06-30 Jakub Jelinek <jakub@redhat.com>
PR fortran/49540
* gfortran.dg/pr49540-1.f90: New test.
* gfortran.dg/pr49540-2.f90: New test.
2011-06-30 Rainer Orth <ro@CeBiTec.Uni-Bielefeld.DE>
PR ada/49511

6
gcc/testsuite/gfortran.dg/pr49540-1.f90 Normal file
View File

@ -0,0 +1,6 @@
! PR fortran/49540
! { dg-do compile }
block data
common /a/ b(100000,100)
data b /10000000 * 0.0/
end block data

17
gcc/testsuite/gfortran.dg/pr49540-2.f90 Normal file
View File

@ -0,0 +1,17 @@
! PR fortran/49540
! { dg-do compile }
! { dg-options "" }
block data
common /a/ i(5,5)
data i /4, 23 * 5, 6/
data i(:,2) /1, 3 * 2, 3/
common /b/ j(5,5)
data j(2,:) /1, 3 * 2, 3/
data j /4, 23 * 5, 6/
common /c/ k(5,5)
data k(:,2) /1, 3 * 2, 3/
data k /4, 23 * 5, 6/
common /d/ l(5,5)
data l /4, 23 * 5, 6/
data l(2,:) /1, 3 * 2, 3/
end block data