This is the mail archive of the gcc-patches@gcc.gnu.org mailing list for the GCC project.
| Index Nav: | [Date Index] [Subject Index] [Author Index] [Thread Index] | |
|---|---|---|
| Message Nav: | [Date Prev] [Date Next] | [Thread Prev] [Thread Next] |
| Other format: | [Raw text] | |
The attached patch tidies up and fixes several bugs in the implementation of the DATA statement. It doesn't address PR13465 yet, that might come later. Paul 2004-01-01 Paul Brook <paul@codesourcery.com> * array.c (gfc_append_constructor): Take constructor, not expression. * data.c (struct gfc_expr_stack): Remove. (expr_stack): Remove. (find_con_by_offset): Rename from find_expr_in_con. (find_con_by_component): Rename from find_component_in_con. (gfc_get_expr_stack): Remove. (gfc_assign_data_value): Rewrite. (gfc_expr_push): Remove. (gfc_expr_pop): Remove. (gfc_advance_section): Rename from gfc_modify_index_and_calculate_offset. Handle unbounded sections. (gfc_get_section_index): Handle unbounded sections. * gfortran.h: Update prototypes. * resolve.c (check_data_variable): Array section maight not be the last ref. testsuite * gfortran.fortran-torture/execute/data_2.f90: New test.
? gcc/testsuite/gfortran.fortran-torture/execute/assign.f90
? gcc/testsuite/gfortran.fortran-torture/execute/data_2.f90
Index: gcc/fortran/array.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/Attic/array.c,v
retrieving revision 1.1.2.5
diff -c -p -r1.1.2.5 array.c
*** gcc/fortran/array.c 24 Nov 2003 13:52:34 -0000 1.1.2.5
--- gcc/fortran/array.c 1 Jan 2004 21:32:34 -0000
*************** gfc_append_constructor (gfc_expr * base,
*** 598,612 ****
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
--- 598,610 ----
constructor onto the base's one according to the offset. */
void
! gfc_insert_constructor (gfc_expr * base, gfc_constructor * c1)
{
! gfc_constructor *c, *pre;
expr_t type;
type = base->expr_type;
if (base->value.constructor == NULL)
base->value.constructor = c1;
else
Index: gcc/fortran/data.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/Attic/data.c,v
retrieving revision 1.1.2.1
diff -c -p -r1.1.2.1 data.c
*** gcc/fortran/data.c 21 Sep 2003 14:34:09 -0000 1.1.2.1
--- gcc/fortran/data.c 1 Jan 2004 21:32:34 -0000
*************** Boston, MA 02111-1307, USA. */
*** 41,60 ****
#include "assert.h"
#include "trans.h"
- /* Stack to push the current expr when we descend to a nested constructor
- of struct arrays. */
-
- typedef struct gfc_expr_stack
- {
- gfc_expr *expr;
- struct gfc_expr_stack *next;
- }
- gfc_expr_stack;
-
- /* For array of struct. */
-
- gfc_expr_stack *expr_stack = NULL;
-
static void formalize_init_expr (gfc_expr *);
/* Calculate the array element offset. */
--- 41,46 ----
*************** get_array_index (gfc_array_ref * ar, mpz
*** 97,111 ****
/* Find if there is a constructor which offset is equal to OFFSET. */
! static gfc_expr *
! find_exp_in_con (mpz_t offset, gfc_constructor *con)
{
! gfc_constructor *con1;
!
! for (con1 = con; con1; con1 = con1->next)
{
! if (mpz_cmp (offset, con1->n.offset) == 0)
! return con1->expr;
}
return NULL;
}
--- 83,95 ----
/* 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)
{
! for (; con; con = con->next)
{
! if (mpz_cmp (offset, con->n.offset) == 0)
! return con;
}
return NULL;
}
*************** find_exp_in_con (mpz_t offset, gfc_const
*** 114,415 ****
/* Find if there is a constructor which component is equal to COM. */
static gfc_constructor *
! find_component_in_con (gfc_component *com, gfc_constructor *con)
{
! gfc_constructor *con1;
!
! for (con1 = con; con1; con1 = con1->next)
{
! if (com == con1->n.component)
! return con1;
}
return NULL;
}
! /* Allocate space for expr stack. */
!
! static gfc_expr_stack *
! gfc_get_expr_stack (void)
! {
! gfc_expr_stack *tmp;
!
! tmp = gfc_getmem (sizeof (gfc_expr_stack));
!
! return tmp;
! }
!
!
! /* Push EXP to expr stack. */
!
! static void
! gfc_expr_push (gfc_expr *exp)
{
! gfc_expr_stack *tmp;
! tmp = gfc_get_expr_stack ();
! tmp->expr = exp;
! tmp->next = expr_stack;
! expr_stack = tmp;
! }
! /* Pop expr stack. */
! static gfc_expr_stack *
! gfc_expr_pop (void)
! {
! gfc_expr_stack *tmp;
! tmp = expr_stack;
! if (tmp)
! expr_stack = expr_stack->next;
! return tmp;
! }
! /* Assign the initial value RVALUE to LVALUE's symbol->value. */
! void
! gfc_assign_data_value (gfc_expr * lvalue, gfc_expr * rvalue, int mark,
! mpz_t index)
! {
! gfc_symbol *symbol;
! gfc_expr *value;
! gfc_ref *ref;
! ref_type type;
! gfc_expr *exp;
! gfc_constructor *con, *con1, *con2;
! gfc_typespec ts;
! mpz_t offset;
! gfc_expr_stack *exp1, *exp2;
! int result;
! mpz_init_set_si (offset, 0);
! symbol = lvalue->symtree->n.sym;
! value = symbol->value;
! ref = lvalue->ref;
! ts = lvalue->ts;
! if (ts.type != rvalue->ts.type)
! gfc_convert_type (rvalue, &ts, 0);
!
! /* If the symbol already has partial init value, Find the correct position to
! insert the current init expression. */
! if (value == NULL)
! {
! while (ref != NULL)
! {
! type = ref->type;
! exp = gfc_get_expr ();
! con = gfc_get_constructor();
! switch (type)
! {
! /* Array reference. */
! case REF_ARRAY:
! exp->expr_type = EXPR_ARRAY;
! /* Array of struct. */
! if (ref->next)
! get_array_index (&ref->u.ar, &offset);
! else /* Scalar array. */
! {
! /* Full array or array section. */
! if (mark )
! mpz_set (offset, index);
! else /* Array element. */
! get_array_index (&ref->u.ar, &offset);
! }
! mpz_set (con->n.offset, offset);
! result = mpz_get_si (con->n.offset);
! break;
!
! /* Struct component reference. */
! case REF_COMPONENT:
! exp->expr_type = EXPR_STRUCTURE;
! exp->ts.type = BT_DERIVED;
! exp->ts.derived = ref->u.c.sym;
! con->n.component = ref->u.c.component;
! break;
!
! default:
! gfc_todo_error ("substring reference in DATA statement");
! break;
! }
! /* Generate the current expression and push it to the stack. */
! exp->value.constructor = con;
! gfc_expr_push (exp);
! /* Goto the next reference level. */
! ref = ref->next;
! }
! }
else
{
! /* Generate the first partial init value. */
! while (ref != NULL)
! {
! type = ref->type;
! /* Array reference. */
! if (type == REF_ARRAY)
! {
! assert (value->expr_type == EXPR_ARRAY);
! con1 = value->value.constructor;
! /* Array of struct. */
! if (ref->next)
! get_array_index (&ref->u.ar, &offset);
! else /* Scalar array. */
! {
! /* Full array or array section. */
! if (mark)
! mpz_set (offset, index);
! else /* Array element. */
! get_array_index (&ref->u.ar, &offset);
! }
! /* Find the same value in constructor CON1. */
! exp = find_exp_in_con (offset, con1);
! /* If find the value, Record it in value. */
! if (exp)
! value = exp;
! else /* Generate a new expression to store the current value. */
! {
! exp = gfc_get_expr ();
! exp->expr_type = EXPR_ARRAY;
! con = gfc_get_constructor();
! mpz_set (con->n.offset, offset);
! exp->value.constructor = con;
! /* Push to expr stack. */
! gfc_expr_push (exp);
! ref = ref->next;
! break;
! }
! }
! else if (type == REF_COMPONENT) /* Struct component reference. */
! {
! assert (value->expr_type == EXPR_STRUCTURE);
! con1 = value->value.constructor;
! con2 = find_component_in_con (ref->u.c.component, con1);
! /* If already exists, records it in VALUE. */
! if (con2)
! value = con2->expr;
! else /* Generate a new expression to store the value and push to
! the expr stack. */
! {
! exp = gfc_get_expr ();
! exp->expr_type = EXPR_STRUCTURE;
! exp->ts.type = BT_DERIVED;
! exp->ts.derived = ref->u.c.sym;
! con = gfc_get_constructor();
! con->n.component = ref->u.c.component;
! exp->value.constructor = con;
! gfc_expr_push (exp);
! ref = ref->next;
! break;
! }
! }
! else
! {
! gfc_todo_error ("substring reference in DATA statement");
! break;
! }
! ref = ref->next;
! }
!
! /* dealing with the rest reference expressions. */
! while (ref != NULL)
! {
! type = ref->type;
! exp = gfc_get_expr ();
! con = gfc_get_constructor();
! switch (type)
! {
! case REF_ARRAY:
! exp->expr_type = EXPR_ARRAY;
! if (ref->next)
! get_array_index (&ref->u.ar, &offset);
! else
! {
! if (mark)
! mpz_set (offset, index);
! else
! get_array_index (&ref->u.ar, &offset);
! }
! mpz_set (con->n.offset, offset);
! break;
!
! case REF_COMPONENT:
! exp->expr_type = EXPR_STRUCTURE;
! exp->ts.type = BT_DERIVED;
! exp->ts.derived = ref->u.c.sym;
! con->n.component = ref->u.c.component;
! break;
!
! default:
! gfc_todo_error ("substring reference in DATA statement");
! break;
! }
! exp->value.constructor = con;
! gfc_expr_push (exp);
! ref = ref->next;
! }
! }
!
! mpz_clear (offset);
! /* Pop the expr stack and form the final expression. */
! exp1 = gfc_expr_pop ();
! if (exp1 != NULL)
! {
! exp1->expr->value.constructor->expr = gfc_copy_expr (rvalue);
! exp2 = gfc_expr_pop ();
! while (exp2)
! {
! exp2->expr->value.constructor->expr = exp1->expr;
! exp1 = exp2;
! exp2 = gfc_expr_pop ();
! }
!
! if (value)
! gfc_insert_constructor (value, exp1->expr);
! else
! value = exp1->expr;
}
- else
- value = gfc_copy_expr (rvalue);
-
- if (symbol->value == NULL)
- symbol->value = value;
}
/* Modify the index of array section and re-calculate the array offset. */
void
! gfc_modify_index_and_calculate_offset (mpz_t *section_index, gfc_array_ref *ar,
! mpz_t *offset_ret)
{
int i;
mpz_t delta;
mpz_t tmp;
for (i = 0; i < ar->dimen; i++)
{
! mpz_add (section_index[i], section_index[i],
! ar->stride[i]->value.integer);
! if (mpz_cmp_si (ar->stride[i]->value.integer, 0) >= 0)
! {
! /* End the current loop and reset index to start. */
! if (mpz_cmp (section_index[i], ar->end[i]->value.integer) > 0)
! mpz_set (section_index[i], ar->start[i]->value.integer);
! else
! break;
! }
else
! {
! if (mpz_cmp (section_index[i], ar->end[i]->value.integer) < 0)
! mpz_set (section_index[i], ar->start[i]->value.integer);
! else
! break;
! }
}
mpz_set_si (*offset_ret, 0);
--- 98,285 ----
/* Find if there is a constructor which component is equal to COM. */
static gfc_constructor *
! find_con_by_component (gfc_component *com, gfc_constructor *con)
{
! for (; con; con = con->next)
{
! if (com == con->n.component)
! return con;
}
return NULL;
}
! /* Assign the initial value RVALUE to LVALUE's symbol->value. */
! void
! gfc_assign_data_value (gfc_expr * lvalue, gfc_expr * rvalue, mpz_t index)
{
! gfc_ref *ref;
! gfc_expr *init;
! gfc_expr *expr;
! gfc_constructor *con;
! gfc_constructor *last_con;
! gfc_symbol *symbol;
! mpz_t offset;
! ref = lvalue->ref;
! symbol = lvalue->symtree->n.sym;
! init = symbol->value;
! last_con = NULL;
! mpz_init_set_si (offset, 0);
! for (ref = lvalue->ref; ref; ref = ref->next)
! {
! /* Use the existing initializer expression if it exists. Otherwise
! create a new one. */
! if (init == NULL)
! expr = gfc_get_expr ();
! else
! expr = init;
+ /* Find or create this element. */
+ switch (ref->type)
+ {
+ case REF_ARRAY:
+ if (init == NULL)
+ {
+ /* Setup the expression to hold the constructor. */
+ expr->expr_type = EXPR_ARRAY;
+ if (ref->next)
+ {
+ assert (ref->next->type == REF_COMPONENT);
+ expr->ts.type = BT_DERIVED;
+ }
+ else
+ expr->ts = rvalue->ts;
+ expr->rank = ref->u.ar.as->rank;
+ }
+ else
+ assert (expr->expr_type == EXPR_ARRAY);
! if (ref->u.ar.type == AR_ELEMENT)
! get_array_index (&ref->u.ar, &offset);
! else
! mpz_set (offset, index);
! /* Find the same element in the existing constructor. */
! con = expr->value.constructor;
! con = find_con_by_offset (offset, con);
!
! if (con == NULL)
! {
! /* Create a new constructor. */
! con = gfc_get_constructor();
! mpz_set (con->n.offset, offset);
! gfc_insert_constructor (expr, con);
! }
! break;
!
! case REF_COMPONENT:
! if (init == NULL)
! {
! /* Setup the expression to hold the constructor. */
! expr->expr_type = EXPR_STRUCTURE;
! expr->ts.type = BT_DERIVED;
! expr->ts.derived = ref->u.c.sym;
! }
! else
! assert (expr->expr_type == EXPR_STRUCTURE);
! /* Find the same element in the existing constructor. */
! con = expr->value.constructor;
! con = find_con_by_component (ref->u.c.component, con);
!
! if (con == NULL)
! {
! /* Create a new constructor. */
! con = gfc_get_constructor ();
! con->n.component = ref->u.c.component;
! con->next = expr->value.constructor;
! expr->value.constructor = con;
! }
! break;
+ case REF_SUBSTRING:
+ gfc_todo_error ("Substring reference in DATA statement");
! default:
! abort ();
! }
! if (init == NULL)
! {
! /* Point the container at the new expression. */
! if (last_con == NULL)
! symbol->value = expr;
! else
! last_con->expr = expr;
! }
! init = con->expr;
! last_con = con;
! }
! expr = gfc_copy_expr (rvalue);
! if (!gfc_compare_types (&lvalue->ts, &expr->ts))
! gfc_convert_type (expr, &lvalue->ts, 0);
! if (last_con == NULL)
! symbol->value = expr;
else
{
! assert (!last_con->expr);
! last_con->expr = expr;
}
}
/* Modify the index of array section and re-calculate the array offset. */
void
! gfc_advance_section (mpz_t *section_index, gfc_array_ref *ar,
! mpz_t *offset_ret)
{
int i;
mpz_t delta;
mpz_t tmp;
+ bool forwards;
+ int cmp;
for (i = 0; i < ar->dimen; i++)
{
! if (ar->dimen_type[i] != DIMEN_RANGE)
! continue;
!
! if (ar->stride[i])
! {
! mpz_add (section_index[i], section_index[i],
! ar->stride[i]->value.integer);
! if (mpz_cmp_si (ar->stride[i]->value.integer, 0) >= 0)
! forwards = true;
! else
! forwards = false;
! }
! else
! {
! mpz_add_ui (section_index[i], section_index[i], 1);
! forwards = true;
! }
! if (ar->end[i])
! cmp = mpz_cmp (section_index[i], ar->end[i]->value.integer);
! else
! cmp = mpz_cmp (section_index[i], ar->as->upper[i]->value.integer);
!
! if ((cmp > 0 && forwards)
! || (cmp < 0 && ! forwards))
! {
! /* Reset index to start, then loop to advance the next index. */
! if (ar->start[i])
! mpz_set (section_index[i], ar->start[i]->value.integer);
! else
! mpz_set (section_index[i], ar->as->lower[i]->value.integer);
! }
else
! break;
}
mpz_set_si (*offset_ret, 0);
*************** gfc_get_section_index (gfc_array_ref *ar
*** 552,571 ****
for (i = 0; i < ar->dimen; i++)
{
mpz_init (section_index[i]);
! mpz_sub (tmp, ar->start[i]->value.integer,
! ar->as->lower[i]->value.integer);
! mpz_mul (tmp, tmp, delta);
! mpz_add (*offset, tmp, *offset);
mpz_sub (tmp, ar->as->upper[i]->value.integer,
ar->as->lower[i]->value.integer);
mpz_add_ui (tmp, tmp, 1);
mpz_mul (delta, tmp, delta);
-
- if (mpz_cmp_si (ar->start[i]->value.integer, 0) == 0)
- mpz_set (section_index[i], ar->as->lower[i]->value.integer);
- else
- mpz_set (section_index[i], ar->start[i]->value.integer);
}
mpz_clear (tmp);
--- 422,454 ----
for (i = 0; i < ar->dimen; i++)
{
mpz_init (section_index[i]);
! switch (ar->dimen_type[i])
! {
! case DIMEN_ELEMENT:
! case DIMEN_RANGE:
! if (ar->start[i])
! {
! mpz_sub (tmp, ar->start[i]->value.integer,
! ar->as->lower[i]->value.integer);
! mpz_mul (tmp, tmp, delta);
! mpz_add (*offset, tmp, *offset);
! mpz_set (section_index[i], ar->start[i]->value.integer);
! }
! else
! mpz_set (section_index[i], ar->as->lower[i]->value.integer);
! break;
!
! case DIMEN_VECTOR:
! gfc_todo_error ("Vectors sections in data statements");
!
! default:
! abort ();
! }
mpz_sub (tmp, ar->as->upper[i]->value.integer,
ar->as->lower[i]->value.integer);
mpz_add_ui (tmp, tmp, 1);
mpz_mul (delta, tmp, delta);
}
mpz_clear (tmp);
Index: gcc/fortran/gfortran.h
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/Attic/gfortran.h,v
retrieving revision 1.1.2.7
diff -c -p -r1.1.2.7 gfortran.h
*** gcc/fortran/gfortran.h 1 Jan 2004 12:09:12 -0000 1.1.2.7
--- gcc/fortran/gfortran.h 1 Jan 2004 21:32:34 -0000
*************** extern iterator_stack *iter_stack;
*** 1268,1275 ****
/* 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);
--- 1268,1275 ----
/* 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 *, mpz_t);
! void gfc_advance_section (mpz_t *, gfc_array_ref *, mpz_t *);
/* scanner.c */
void gfc_scanner_done_1 (void);
*************** try gfc_array_size (gfc_expr *, mpz_t *)
*** 1581,1587 ****
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 *);
--- 1581,1587 ----
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_constructor *);
gfc_constructor *gfc_get_constructor (void);
tree gfc_conv_array_initializer (tree type, gfc_expr * expr);
try spec_size (gfc_array_spec *, mpz_t *);
Index: gcc/fortran/resolve.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/Attic/resolve.c,v
retrieving revision 1.1.2.13
diff -c -p -r1.1.2.13 resolve.c
*** gcc/fortran/resolve.c 1 Jan 2004 15:20:28 -0000 1.1.2.13
--- gcc/fortran/resolve.c 1 Jan 2004 21:32:35 -0000
*************** check_data_variable (gfc_data_variable *
*** 3918,3939 ****
{
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)
{
--- 3918,3951 ----
{
ref = e->ref;
! /* Find the array section reference. */
! for (ref = e->ref; ref; ref = ref->next)
! {
! if (ref->type != REF_ARRAY)
! continue;
! if (ref->u.ar.type == AR_ELEMENT)
! continue;
! break;
! }
! assert (ref);
/* Set marks asscording to the reference pattern. */
! switch (ref->u.ar.type)
! {
! case AR_FULL:
! mark = 1;
! break;
!
! case AR_SECTION:
ar = &ref->u.ar;
/* Get the start position of array section. */
gfc_get_section_index (ar, section_index, &offset);
mark = 2;
! break;
!
! default:
! abort();
! }
if (gfc_array_size (e, &size) == FAILURE)
{
*************** check_data_variable (gfc_data_variable *
*** 3961,3967 ****
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);
--- 3973,3979 ----
break;
/* Assign initial value to symbol. */
! gfc_assign_data_value (var->expr, values.vnode->expr, offset);
if (mark == 1)
mpz_add_ui (offset, offset, 1);
*************** check_data_variable (gfc_data_variable *
*** 3969,3975 ****
/* 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);
}
--- 3981,3987 ----
/* Modify the array section indexes and recalculate the offset for
next element. */
else if (mark == 2)
! gfc_advance_section (section_index, ar, &offset);
mpz_sub_ui (size, size, 1);
}
Attachment:
data_2.f90
Description: Text document
| Index Nav: | [Date Index] [Subject Index] [Author Index] [Thread Index] | |
|---|---|---|
| Message Nav: | [Date Prev] [Date Next] | [Thread Prev] [Thread Next] |