From 21ea4922aceb3ffa50c3d00b8d26da6b41af92cf Mon Sep 17 00:00:00 2001 From: Jakub Jelinek Date: Thu, 30 Jun 2011 12:25:40 +0200 Subject: [PATCH] re PR fortran/49540 (Memory-hog with large DATA stmt) 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 --- gcc/fortran/ChangeLog | 21 ++++ gcc/fortran/array.c | 2 + gcc/fortran/constructor.c | 49 +++++++- gcc/fortran/constructor.h | 8 +- gcc/fortran/data.c | 160 +++++++++++++++++++----- gcc/fortran/data.h | 5 +- gcc/fortran/gfortran.h | 2 + gcc/fortran/resolve.c | 7 +- gcc/fortran/trans-array.c | 38 +++++- gcc/testsuite/ChangeLog | 6 + gcc/testsuite/gfortran.dg/pr49540-1.f90 | 6 + gcc/testsuite/gfortran.dg/pr49540-2.f90 | 17 +++ 12 files changed, 272 insertions(+), 49 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/pr49540-1.f90 create mode 100644 gcc/testsuite/gfortran.dg/pr49540-2.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index ed9c705691c..055c15d29e1 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,24 @@ +2011-06-30 Jakub Jelinek + + 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 PR fortran/49466 diff --git a/gcc/fortran/array.c b/gcc/fortran/array.c index 1394e17baf0..3074275a819 100644 --- a/gcc/fortran/array.c +++ b/gcc/fortran/array.c @@ -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; diff --git a/gcc/fortran/constructor.c b/gcc/fortran/constructor.c index 97399812d32..600488d640f 100644 --- a/gcc/fortran/constructor.c +++ b/gcc/fortran/constructor.c @@ -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; +} diff --git a/gcc/fortran/constructor.h b/gcc/fortran/constructor.h index 558de7f180a..6b4bab4dd8d 100644 --- a/gcc/fortran/constructor.h +++ b/gcc/fortran/constructor.h @@ -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 */ diff --git a/gcc/fortran/data.c b/gcc/fortran/data.c index 137a939d505..67da371ad54 100644 --- a/gcc/fortran/data.c +++ b/gcc/fortran/data.c @@ -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 @@ -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 diff --git a/gcc/fortran/data.h b/gcc/fortran/data.h index 955843cc59b..a9687c45488 100644 --- a/gcc/fortran/data.h +++ b/gcc/fortran/data.h @@ -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 *); diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 8b834abe095..2eb497a2062 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -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; diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index f484a223f9b..8418c216c83 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -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; diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 408b73a9a68..4c21389dcb3 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -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; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 870619a8fba..d2e9ee67875 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2011-06-30 Jakub Jelinek + + PR fortran/49540 + * gfortran.dg/pr49540-1.f90: New test. + * gfortran.dg/pr49540-2.f90: New test. + 2011-06-30 Rainer Orth PR ada/49511 diff --git a/gcc/testsuite/gfortran.dg/pr49540-1.f90 b/gcc/testsuite/gfortran.dg/pr49540-1.f90 new file mode 100644 index 00000000000..5a8218f0ffe --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pr49540-1.f90 @@ -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 diff --git a/gcc/testsuite/gfortran.dg/pr49540-2.f90 b/gcc/testsuite/gfortran.dg/pr49540-2.f90 new file mode 100644 index 00000000000..f9a3d6df68d --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pr49540-2.f90 @@ -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 -- 2.30.2