This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[gfortran] DATA statements
- From: Paul Brook <paul at nowt dot org>
- To: "gcc-g95 List" <gcc-g95-devel at lists dot sourceforge dot net>,"gcc-patches at gcc dot gnu dot org" <gcc-patches at gcc dot gnu dot org>
- Date: Sun, 21 Sep 2003 15:33:38 +0100
- Subject: [gfortran] DATA statements
The attached patch implements the DATA construct.
Applied to tree-ssa branch.
Paul
2003-09-21 Lifang Zeng <zlf605@hotmail.com>
Paul Brook <paul@nowt.org>
* Make-lang.in (F95_OBJS): Add fortran/data.o.
* array.c (gfc_inser_constructor): New function.
(gfc_get_constructor): New function.
(gfc_free_constructor): Initialize offset and repeat.
(iterator_stack): Remove.
(expand_info): Add offset, component and repeat fields.
(expand_constructor): Set them.
(expand): Set new fields.
(gfc_copy_constructor): Ditto. Avoid recursion.
* gfortran.h: Add prototypes for new functions.
(gfc_constructor): Add offset, component and repeat.
(iteratio_stack): Move to here.
* resolve.c (check_data_variable): Convert data values into variable
initializers.
(traverse_data_list): Build implicit loop chain.
(gfc_resolve): Ditto.
* trans-array.c (gfc_conv_array_intializer): Handle repeat count.
* trans-decl.c (gfc_get_symbol_decl): Use gfc_conv_structure.
* trans-expr.c (gfc_conv_structure): Handle array initializers.
(gfc_conv_expr): Update to match.
* trans.h (gfc_conv_structure): Declare.
* gfortran.fortran-torture/execute/data.f90: New test.
diff -urpxCVS clean/tree-ssa/gcc/fortran/Make-lang.in gcc/gcc/fortran/Make-lang.in
--- clean/tree-ssa/gcc/fortran/Make-lang.in 2003-08-22 23:39:34.000000000 +0100
+++ gcc/gcc/fortran/Make-lang.in 2003-09-21 11:34:29.000000000 +0100
@@ -75,7 +75,7 @@ F95_OBJS = $(F95_PARSER_OBJS) \
fortran/trans-types.o fortran/trans-const.o fortran/trans-expr.o \
fortran/trans-stmt.o fortran/trans-io.o fortran/trans-array.o \
fortran/trans-intrinsic.o fortran/dependency.o fortran/trans-common.o \
- fortran/trans-equivalence.o
+ fortran/trans-equivalence.o fortran/data.o
# FIXME:
# We rely on c-semantics to expand from GIMPLE to RTL.
@@ -275,4 +275,5 @@ fortran/trans-intrinsic.o: $(GFORTRAN_TR
fortran/dependency.o: fortran/gfortran.h fortran/dependency.h
fortran/trans-common.o: $(GFORTRAN_TRANS_DEPS) fortran/gfortran.h
fortran/trans-equivalence.o: $(GFORTRAN_TRANS_DEPS) fortran/gfortran.h
+fortran/data.c: $(GFORTRAN_TRANS_DEPS)
diff -urpxCVS clean/tree-ssa/gcc/fortran/array.c gcc/gcc/fortran/array.c
--- clean/tree-ssa/gcc/fortran/array.c 2003-09-16 22:14:52.000000000 +0100
+++ gcc/gcc/fortran/array.c 2003-09-21 14:48:55.000000000 +0100
@@ -24,7 +24,7 @@ Boston, MA 02111-1307, USA. */
#include "match.h"
#include <string.h>
-
+#include <assert.h>
/* This parameter is the size of the largest array constructor that we
will expand to an array constructor without iterators.
@@ -563,7 +563,6 @@ gfc_start_constructor (bt type, int kind
result->ts.type = type;
result->ts.kind = kind;
result->where = *where;
-
return result;
}
@@ -595,6 +594,79 @@ gfc_append_constructor (gfc_expr * base,
}
+/* Given an array constructor expression, insert the new expression's
+ constructor onto the base's one according to the offset. */
+
+void
+gfc_insert_constructor (gfc_expr * base, gfc_expr * new)
+{
+ gfc_constructor *c, *c1, *pre;
+ expr_t type;
+
+ assert (base->expr_type == new->expr_type);
+ type = base->expr_type;
+
+ c1 = new->value.constructor;
+ if (base->value.constructor == NULL)
+ base->value.constructor = c1;
+ else
+ {
+ c = pre = base->value.constructor;
+ while (c)
+ {
+ if (type == EXPR_ARRAY)
+ {
+ if (mpz_cmp (c->n.offset, c1->n.offset) < 0)
+ {
+ pre = c;
+ c = c->next;
+ }
+ else if (mpz_cmp (c->n.offset, c1->n.offset) == 0)
+ {
+ gfc_error ("duplicated initializer");
+ break;
+ }
+ else
+ break;
+ }
+ else
+ {
+ pre = c;
+ c = c->next;
+ }
+ }
+
+ if (pre != c)
+ {
+ pre->next = c1;
+ c1->next = c;
+ }
+ else
+ {
+ c1->next = c;
+ base->value.constructor = c1;
+ }
+ }
+}
+
+
+/* Get a new constructor. */
+
+gfc_constructor *
+gfc_get_constructor (void)
+{
+ gfc_constructor *c;
+
+ c = gfc_getmem (sizeof(gfc_constructor));
+ c->expr = NULL;
+ c->iterator = NULL;
+ c->next = NULL;
+ mpz_init_set_si (c->n.offset, 0);
+ mpz_init_set_si (c->repeat, 0);
+ return c;
+}
+
+
/* Free chains of gfc_constructor structures. */
void
@@ -613,6 +685,8 @@ gfc_free_constructor (gfc_constructor *
gfc_free_expr (p->expr);
if (p->iterator != NULL)
gfc_free_iterator (p->iterator, 1);
+ mpz_clear (p->n.offset);
+ mpz_clear (p->repeat);
gfc_free (p);
}
}
@@ -1031,15 +1105,7 @@ gfc_check_constructor (gfc_expr * expr,
/**************** Simplification of array constructors ****************/
-typedef struct iterator_stack
-{
- gfc_symtree *variable;
- mpz_t value;
- struct iterator_stack *prev;
-}
-iterator_stack;
-
-static iterator_stack *iter_stack;
+iterator_stack *iter_stack;
typedef struct
{
@@ -1048,7 +1114,11 @@ typedef struct
gfc_expr *extracted;
mpz_t *count;
- try (*expand_work_function) (gfc_expr *);
+ mpz_t *offset;
+ gfc_component *component;
+ mpz_t *repeat;
+
+ try (*expand_work_function) (gfc_expr *);
}
expand_info;
@@ -1126,6 +1196,9 @@ expand (gfc_expr * e)
current_expand.new_tail->where = e->where;
current_expand.new_tail->expr = e;
+ mpz_set (current_expand.new_tail->n.offset, *current_expand.offset);
+ current_expand.new_tail->n.component = current_expand.component;
+ mpz_set (current_expand.new_tail->repeat, *current_expand.repeat);
return SUCCESS;
}
@@ -1288,11 +1361,12 @@ expand_constructor (gfc_constructor * c)
gfc_free_expr (e);
return FAILURE;
}
-
+ current_expand.offset = &c->n.offset;
+ current_expand.component = c->n.component;
+ current_expand.repeat = &c->repeat;
if (current_expand.expand_work_function (e) == FAILURE)
return FAILURE;
}
-
return SUCCESS;
}
@@ -1468,16 +1542,29 @@ gfc_constructor *
gfc_copy_constructor (gfc_constructor * src)
{
gfc_constructor *dest;
+ gfc_constructor *tail;
if (src == NULL)
return NULL;
- dest = gfc_get_constructor ();
- dest->where = src->where;
- dest->expr = gfc_copy_expr (src->expr);
- dest->iterator = copy_iterator (src->iterator);
-
- dest->next = gfc_copy_constructor (src->next);
+ dest = tail = NULL;
+ while (src)
+ {
+ if (dest == NULL)
+ dest = tail = gfc_get_constructor ();
+ else
+ {
+ tail->next = gfc_get_constructor ();
+ tail = tail->next;
+ }
+ tail->where = src->where;
+ tail->expr = gfc_copy_expr (src->expr);
+ tail->iterator = copy_iterator (src->iterator);
+ mpz_set (tail->n.offset, src->n.offset);
+ tail->n.component = src->n.component;
+ mpz_set (tail->repeat, src->repeat);
+ src = src->next;
+ }
return dest;
}
@@ -1552,7 +1639,7 @@ spec_dimen_size (gfc_array_spec * as, in
}
-static try
+try
spec_size (gfc_array_spec * as, mpz_t * result)
{
mpz_t size;
diff -urpxCVS clean/tree-ssa/gcc/fortran/gfortran.h gcc/gcc/fortran/gfortran.h
--- clean/tree-ssa/gcc/fortran/gfortran.h 2003-08-10 14:51:17.000000000 +0100
+++ gcc/gcc/fortran/gfortran.h 2003-09-21 15:18:30.000000000 +0100
@@ -1250,14 +1250,36 @@ typedef struct gfc_constructor
gfc_iterator *iterator;
locus where;
struct gfc_constructor *next;
+ struct
+ {
+ mpz_t offset; /* Record the offset of array element which appears in
+ data statement like "data a(5)/4/". */
+ 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;
-#define gfc_get_constructor() gfc_getmem(sizeof(gfc_constructor))
+typedef struct iterator_stack
+{
+ gfc_symtree *variable;
+ mpz_t value;
+ struct iterator_stack *prev;
+}
+iterator_stack;
+extern iterator_stack *iter_stack;
/************************ Function prototypes *************************/
+/* data.c */
+void gfc_formalize_init_value (gfc_symbol *);
+void gfc_get_section_index (gfc_array_ref *, mpz_t *, mpz_t *);
+void gfc_assign_data_value (gfc_expr *, gfc_expr *, int, mpz_t);
+void gfc_modify_index_and_calculate_offset (mpz_t *, gfc_array_ref *, mpz_t *);
+
/* scanner.c */
void gfc_scanner_done_1 (void);
void gfc_scanner_init_1 (void);
@@ -1567,6 +1589,10 @@ try gfc_array_size (gfc_expr *, mpz_t *)
try gfc_array_dimen_size (gfc_expr *, int, mpz_t *);
try gfc_array_ref_shape (gfc_array_ref *, mpz_t *);
gfc_array_ref *gfc_find_array_ref (gfc_expr *);
+void gfc_insert_constructor (gfc_expr *, gfc_expr *);
+gfc_constructor *gfc_get_constructor (void);
+tree gfc_conv_array_initializer (tree type, gfc_expr * expr);
+try spec_size (gfc_array_spec *, mpz_t *);
/* interface.c -- FIXME: some of these should be in symbol.c */
void gfc_free_interface (gfc_interface *);
diff -urpxCVS clean/tree-ssa/gcc/fortran/resolve.c gcc/gcc/fortran/resolve.c
--- clean/tree-ssa/gcc/fortran/resolve.c 2003-08-14 23:10:13.000000000 +0100
+++ gcc/gcc/fortran/resolve.c 2003-09-21 15:27:00.000000000 +0100
@@ -42,7 +42,6 @@ static code_stack *cs_base = NULL;
static int forall_flag;
-
/* Resolve types of formal argument lists. These have to be done early so that
the formal argument lists of module procedures can be copied to the
containing module before the individual procedures are resolved
@@ -3855,11 +3854,19 @@ check_data_variable (gfc_data_variable *
{
gfc_expr *e;
mpz_t size;
+ mpz_t offset;
try t;
+ int mark = 0;
+ int i;
+ mpz_t section_index[GFC_MAX_DIMENSIONS];
+ gfc_ref *ref;
+ gfc_array_ref *ar;
if (gfc_resolve_expr (var->expr) == FAILURE)
return FAILURE;
+ ar = NULL;
+ mpz_init_set_si (offset, 0);
e = var->expr;
if (e->expr_type != EXPR_VARIABLE)
@@ -3869,10 +3876,30 @@ check_data_variable (gfc_data_variable *
mpz_init_set_ui (size, 1);
else
{
+ ref = e->ref;
+
+ /* Find the inner most reference. */
+ while (ref->next)
+ ref = ref->next;
+
+ /* Set marks asscording to the reference pattern. */
+ if (ref->u.ar.type == AR_FULL)
+ mark = 1;
+ else if (ref->u.ar.type == AR_SECTION)
+ {
+ ar = &ref->u.ar;
+ /* Get the start position of array section. */
+ gfc_get_section_index (ar, section_index, &offset);
+ mark = 2;
+ }
+ else
+ mark = 3;
+
if (gfc_array_size (e, &size) == FAILURE)
{
gfc_error ("Nonconstant array section at %L in DATA statement",
&e->where);
+ mpz_clear (offset);
return FAILURE;
}
}
@@ -3893,10 +3920,27 @@ check_data_variable (gfc_data_variable *
if (t == FAILURE)
break;
+ /* Assign initial value to symbol. */
+ gfc_assign_data_value (var->expr, values.vnode->expr, mark, offset);
+
+ if (mark == 1)
+ mpz_add_ui (offset, offset, 1);
+
+ /* Modify the array section indexes and recalculate the offset for
+ next element. */
+ else if (mark == 2)
+ gfc_modify_index_and_calculate_offset (section_index, ar, &offset);
+
mpz_sub_ui (size, size, 1);
}
+ if (mark == 2)
+ {
+ for (i = 0; i < ar->dimen; i++)
+ mpz_clear (section_index[i]);
+ }
mpz_clear (size);
+ mpz_clear (offset);
return t;
}
@@ -3910,6 +3954,10 @@ static try
traverse_data_list (gfc_data_variable * var, locus * where)
{
mpz_t trip;
+ iterator_stack frame;
+ gfc_expr *e;
+
+ mpz_init (frame.value);
mpz_init_set (trip, var->iter.end->value.integer);
mpz_sub (trip, trip, var->iter.start->value.integer);
@@ -3917,6 +3965,12 @@ traverse_data_list (gfc_data_variable *
mpz_div (trip, trip, var->iter.step->value.integer);
+ mpz_set (frame.value, var->iter.start->value.integer);
+
+ frame.prev = iter_stack;
+ frame.variable = var->iter.var->symtree;
+ iter_stack = &frame;
+
while (mpz_cmp_ui (trip, 0) > 0)
{
if (traverse_data_var (var->list, where) == FAILURE)
@@ -3925,11 +3979,22 @@ traverse_data_list (gfc_data_variable *
return FAILURE;
}
+ e = gfc_copy_expr (var->expr);
+ if (gfc_simplify_expr (e, 1) == FAILURE)
+ {
+ gfc_free_expr (e);
+ return FAILURE;
+ }
+
+ mpz_add (frame.value, frame.value, var->iter.step->value.integer);
+
mpz_sub_ui (trip, trip, 1);
}
mpz_clear (trip);
+ mpz_clear (frame.value);
+ iter_stack = frame.prev;
return SUCCESS;
}
@@ -4158,9 +4223,13 @@ gfc_resolve (gfc_namespace * ns)
if (ns->save_all)
gfc_save_all (ns);
+ iter_stack = NULL;
for (d = ns->data; d; d = d->next)
resolve_data (d);
+ iter_stack = NULL;
+ gfc_traverse_ns (ns, gfc_formalize_init_value);
+
cs_base = NULL;
resolve_code (ns->code, ns);
diff -urpxCVS clean/tree-ssa/gcc/fortran/trans-array.c gcc/gcc/fortran/trans-array.c
--- clean/tree-ssa/gcc/fortran/trans-array.c 2003-09-14 13:22:42.000000000 +0100
+++ gcc/gcc/fortran/trans-array.c 2003-09-21 14:42:36.000000000 +0100
@@ -2666,15 +2666,17 @@ gfc_array_deallocate (tree descriptor)
/* Create an array constructor from an initialization expression.
We assume the frontend already did any expansions and conversions. */
-static tree
+tree
gfc_conv_array_initializer (tree type, gfc_expr * expr)
{
gfc_constructor *c;
tree list;
tree tmp;
+ mpz_t maxval;
gfc_se se;
HOST_WIDE_INT hi;
unsigned HOST_WIDE_INT lo;
+ tree index, range;
list = NULL_TREE;
switch (expr->expr_type)
@@ -2714,23 +2716,57 @@ gfc_conv_array_initializer (tree type, g
/* TODO: Unexpanded array initializers. */
internal_error
("Possible frontend bug: array constructor not expanded");
+ }
+ if (mpz_cmp_si (c->n.offset, 0) != 0)
+ index = gfc_conv_mpz_to_tree (c->n.offset, gfc_index_integer_kind);
+ else
+ index = NULL_TREE;
+ mpz_init (maxval);
+ if (mpz_cmp_si (c->repeat, 0) != 0)
+ {
+ tree tmp1, tmp2;
+
+ mpz_set (maxval, c->repeat);
+ mpz_add (maxval, c->n.offset, maxval);
+ mpz_sub_ui (maxval, maxval, 1);
+ tmp2 = gfc_conv_mpz_to_tree (maxval, gfc_index_integer_kind);
+ if (mpz_cmp_si (c->n.offset, 0) != 0)
+ {
+ mpz_add_ui (maxval, c->n.offset, 1);
+ tmp1 = gfc_conv_mpz_to_tree (maxval, gfc_index_integer_kind);
+ }
+ else
+ tmp1 = gfc_conv_mpz_to_tree (c->n.offset, gfc_index_integer_kind);
+
+ range = build (RANGE_EXPR, integer_type_node, tmp1, tmp2);
}
+ else
+ range = NULL;
+ mpz_clear (maxval);
gfc_init_se (&se, NULL);
switch (c->expr->expr_type)
{
case EXPR_CONSTANT:
gfc_conv_constant (&se, c->expr);
+ if (range == NULL_TREE)
+ list = tree_cons (index, se.expr, list);
+ else
+ {
+ if (index != NULL_TREE)
+ list = tree_cons (index, se.expr, list);
+ list = tree_cons (range, se.expr, list);
+ }
break;
case EXPR_STRUCTURE:
- gfc_conv_expr (&se, c->expr);
+ gfc_conv_structure (&se, c->expr, 1);
+ list = tree_cons (index, se.expr, list);
break;
default:
abort();
}
- list = tree_cons (NULL_TREE, se.expr, list);
}
/* We created the list in reverse order. */
list = nreverse (list);
diff -urpxCVS clean/tree-ssa/gcc/fortran/trans-decl.c gcc/gcc/fortran/trans-decl.c
--- clean/tree-ssa/gcc/fortran/trans-decl.c 2003-09-20 13:37:09.000000000 +0100
+++ gcc/gcc/fortran/trans-decl.c 2003-09-21 11:34:29.000000000 +0100
@@ -802,7 +802,7 @@ gfc_get_symbol_decl (gfc_symbol * sym)
if (sym->value && ! (sym->attr.use_assoc || sym->attr.dimension))
{
gfc_init_se (&se, NULL);
- gfc_conv_expr (&se, sym->value);
+ gfc_conv_structure (&se, sym->value, 1);
DECL_INITIAL (decl) = se.expr;
}
break;
diff -urpxCVS clean/tree-ssa/gcc/fortran/trans-expr.c gcc/gcc/fortran/trans-expr.c
--- clean/tree-ssa/gcc/fortran/trans-expr.c 2003-09-14 19:56:24.000000000 +0100
+++ gcc/gcc/fortran/trans-expr.c 2003-09-21 15:27:01.000000000 +0100
@@ -1306,8 +1306,12 @@ gfc_conv_array_constructor_expr (gfc_se
}
-static void
-gfc_conv_structure (gfc_se * se, gfc_expr * expr)
+
+/* Build an expression for a constructor. If init is nonzero then
+ this is part of a static variable initializer. */
+
+void
+gfc_conv_structure (gfc_se * se, gfc_expr * expr, int init)
{
gfc_constructor *c;
gfc_component *cm;
@@ -1316,6 +1320,7 @@ gfc_conv_structure (gfc_se * se, gfc_exp
tree val;
gfc_se cse;
tree type;
+ tree arraytype;
assert (expr->expr_type == EXPR_STRUCTURE);
type = gfc_typenode_for_spec (&expr->ts);
@@ -1331,9 +1336,29 @@ gfc_conv_structure (gfc_se * se, gfc_exp
gfc_init_se (&cse, se);
/* Evaluate the expression for this component. */
- gfc_conv_expr (&cse, c->expr);
- gfc_add_block_to_block (&se->pre, &cse.pre);
- gfc_add_block_to_block (&se->post, &cse.post);
+ if (init)
+ {
+ switch (c->expr->expr_type)
+ {
+ case EXPR_ARRAY:
+ arraytype = TREE_TYPE (cm->backend_decl);
+ cse.expr = gfc_conv_array_initializer (arraytype, c->expr);
+ break;
+
+ case EXPR_STRUCTURE:
+ gfc_conv_structure (&cse, c->expr, 1);
+ break;
+
+ default:
+ gfc_conv_expr (&cse, c->expr);
+ }
+ }
+ else
+ {
+ gfc_conv_expr (&cse, c->expr);
+ gfc_add_block_to_block (&se->pre, &cse.pre);
+ gfc_add_block_to_block (&se->post, &cse.post);
+ }
/* Build a TREE_CHAIN to hold it. */
val = tree_cons (cm->backend_decl, cse.expr, NULL_TREE);
@@ -1414,7 +1439,7 @@ gfc_conv_expr (gfc_se * se, gfc_expr * e
break;
case EXPR_STRUCTURE:
- gfc_conv_structure (se, expr);
+ gfc_conv_structure (se, expr, 0);
break;
case EXPR_ARRAY:
diff -urpxCVS clean/tree-ssa/gcc/fortran/trans.h gcc/gcc/fortran/trans.h
--- clean/tree-ssa/gcc/fortran/trans.h 2003-09-20 13:37:09.000000000 +0100
+++ gcc/gcc/fortran/trans.h 2003-09-21 11:34:29.000000000 +0100
@@ -299,6 +299,9 @@ void gfc_trans_equivalence (gfc_namespac
/* Translate COMMON blocks. */
void gfc_trans_common (gfc_namespace *);
+/* Translate a derived type constructor. */
+void gfc_conv_structure (gfc_se *, gfc_expr *, int);
+
/* Return an expression which determines if a dummy parameter is present. */
tree gfc_conv_expr_present (gfc_symbol *);