Hi!
As discussed in the PR and can be seen on the first testcase,
the removal of repeat field for ctors resulted in huge memory consumption
of the fortran FE on some real-world testcases (the first testcase
needs several GB of memory to compile).
This patch reintroduces the repeat field and handles the cases where
a range ctor is replacing some other ctors in that range or
some ctor is being replacing a part of a range ctor. It should result
in no change in the generated code, just use much less memory
in larger testcases.
Bootstrapped/regtested on x86_64-linux and i686-linux. Ok for trunk
and after a while for 4.6 too?
OT, the results before as well as after the patch for the second testcases are
unexpected, it seems the DATA stmts are processed in reverse order, so that
the first one wins instead of last one, unlike e.g. ifort or gfortran 4.1.
I guess we should change that, but independently of this patch.
2011-06-27 Jakub Jelinek <ja...@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.
* gfortran.dg/pr49540-1.f90: New test.
* gfortran.dg/pr49540-2.f90: New test.
--- gcc/fortran/gfortran.h.jj 2011-06-21 16:45:54.000000000 +0200
+++ gcc/fortran/gfortran.h 2011-06-27 18:37:45.000000000 +0200
@@ -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;
--- gcc/fortran/trans-array.c.jj 2011-06-17 11:02:01.000000000 +0200
+++ gcc/fortran/trans-array.c 2011-06-29 15:15:04.000000000 +0200
@@ -4555,7 +4555,7 @@ gfc_conv_array_initializer (tree type, g
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)
@@ -4608,29 +4608,56 @@ gfc_conv_array_initializer (tree type, g
index = gfc_conv_mpz_to_tree (c->offset, gfc_index_integer_kind);
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, integer_type_node, 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;
--- gcc/fortran/array.c.jj 2011-05-02 18:39:17.000000000 +0200
+++ gcc/fortran/array.c 2011-06-27 18:37:45.000000000 +0200
@@ -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
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;
--- gcc/fortran/constructor.c.jj 2011-05-02 18:39:17.000000000 +0200
+++ gcc/fortran/constructor.c 2011-06-29 18:31:44.000000000 +0200
@@ -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 *b
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_constru
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_
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 *c
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;
+}
--- gcc/fortran/data.h.jj 2011-01-06 10:21:41.000000000 +0100
+++ gcc/fortran/data.h 2011-06-29 15:19:31.000000000 +0200
@@ -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.
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 *);
--- gcc/fortran/constructor.h.jj 2010-05-25 11:27:34.000000000 +0200
+++ gcc/fortran/constructor.h 2011-06-29 15:46:17.000000000 +0200
@@ -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 (
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 */
--- gcc/fortran/data.c.jj 2011-05-02 18:39:17.000000000 +0200
+++ gcc/fortran/data.c 2011-06-29 18:28:24.000000000 +0200
@@ -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 <zlf...@hotmail.com>
@@ -189,10 +189,13 @@ create_character_initializer (gfc_expr *
/* 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,
&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,
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,
}
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
--- gcc/fortran/resolve.c.jj 2011-06-21 16:45:54.000000000 +0200
+++ gcc/fortran/resolve.c 2011-06-29 11:52:20.000000000 +0200
@@ -12752,8 +12752,8 @@ check_data_variable (gfc_data_variable *
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 *
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;
--- gcc/testsuite/gfortran.dg/pr49540-1.f90.jj 2011-06-29 18:35:36.000000000
+0200
+++ gcc/testsuite/gfortran.dg/pr49540-1.f90 2011-06-29 17:08:57.000000000
+0200
@@ -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
--- gcc/testsuite/gfortran.dg/pr49540-2.f90.jj 2011-06-29 18:35:48.000000000
+0200
+++ gcc/testsuite/gfortran.dg/pr49540-2.f90 2011-06-29 18:36:43.000000000
+0200
@@ -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
Jakub
