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

trans-array.h (gfc_get_array_ss): New prototype.

Browse Source 
2011-09-08  Mikael Morin  <mikael.morin@sfr.fr>

	* trans-array.h (gfc_get_array_ss): New prototype.
	* trans-array.c (gfc_get_array_ss): New function.
	(gfc_walk_variable_expr, gfc_walk_function_expr,
	gfc_walk_array_constructor): Re-use gfc_get_array_ss.
	* trans-expr.c (gfc_trans_subarray_assign): Ditto.
	* trans-intrinsic.c (gfc_walk_intrinsic_bound,
	gfc_walk_intrinsic_libfunc): Ditto.
	* trans-io.c (transfer_array_component): Ditto.

From-SVN: r178695
This commit is contained in:
Mikael Morin 2011-09-08 17:07:01 +02:00 committed by Mikael Morin
parent 2d49bd6e23
commit 6687727615
6 changed files with 49 additions and 76 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
gcc/fortran/ChangeLog
View File

@ -1,3 +1,14 @@
2011-09-08 Mikael Morin <mikael.morin@sfr.fr>
* trans-array.h (gfc_get_array_ss): New prototype.
* trans-array.c (gfc_get_array_ss): New function.
(gfc_walk_variable_expr, gfc_walk_function_expr,
gfc_walk_array_constructor): Re-use gfc_get_array_ss.
* trans-expr.c (gfc_trans_subarray_assign): Ditto.
* trans-intrinsic.c (gfc_walk_intrinsic_bound,
gfc_walk_intrinsic_libfunc): Ditto.
* trans-io.c (transfer_array_component): Ditto.
2011-09-08 Tobias Burnus <burnus@net-b.de>
PR fortran/44646

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

@ -511,6 +511,29 @@ gfc_free_ss (gfc_ss * ss)
}
/* Creates and initializes an array type gfc_ss struct. */
gfc_ss *
gfc_get_array_ss (gfc_ss *next, gfc_expr *expr, int dimen, gfc_ss_type type)
{
gfc_ss *ss;
gfc_ss_info *info;
int i;
ss = gfc_get_ss ();
ss->next = next;
ss->type = type;
ss->expr = expr;
info = &ss->data.info;
info->dimen = dimen;
info->codimen = 0;
for (i = 0; i < info->dimen; i++)
info->dim[i] = i;
return ss;
}
/* Free all the SS associated with a loop. */
void
@ -7605,12 +7628,7 @@ gfc_walk_variable_expr (gfc_ss * ss, gfc_expr * expr)
break;
case AR_FULL:
newss = gfc_get_ss ();
newss->type = GFC_SS_SECTION;
newss->expr = expr;
newss->next = ss;
newss->data.info.dimen = ar->as->rank;
newss->data.info.codimen = 0;
newss = gfc_get_array_ss (ss, expr, ar->as->rank, GFC_SS_SECTION);
newss->data.info.ref = ref;
/* Make sure array is the same as array(:,:), this way
@ -7619,7 +7637,6 @@ gfc_walk_variable_expr (gfc_ss * ss, gfc_expr * expr)
ar->codimen = 0;
for (n = 0; n < ar->dimen; n++)
{
newss->data.info.dim[n] = n;
ar->dimen_type[n] = DIMEN_RANGE;
gcc_assert (ar->start[n] == NULL);
@ -7638,15 +7655,10 @@ gfc_walk_variable_expr (gfc_ss * ss, gfc_expr * expr)
break;
case AR_SECTION:
newss = gfc_get_ss ();
newss->type = GFC_SS_SECTION;
newss->expr = expr;
newss->next = ss;
newss->data.info.dimen = 0;
newss->data.info.codimen = 0;
newss = gfc_get_array_ss (ss, expr, 0, GFC_SS_SECTION);
newss->data.info.ref = ref;
/* We add SS chains for all the subscripts in the section. */
/* We add SS chains for all the subscripts in the section. */
for (n = 0; n < ar->dimen + ar->codimen; n++)
{
gfc_ss *indexss;
@ -7678,10 +7690,8 @@ gfc_walk_variable_expr (gfc_ss * ss, gfc_expr * expr)
case DIMEN_VECTOR:
/* Create a GFC_SS_VECTOR index in which we can store
the vector's descriptor. */
indexss = gfc_get_ss ();
indexss->type = GFC_SS_VECTOR;
indexss->expr = ar->start[n];
indexss->next = gfc_ss_terminator;
indexss = gfc_get_array_ss (gfc_ss_terminator, ar->start[n],
1, GFC_SS_VECTOR);
indexss->loop_chain = gfc_ss_terminator;
newss->data.info.subscript[n] = indexss;
newss->data.info.dim[newss->data.info.dimen
@ -7852,11 +7862,9 @@ gfc_walk_elemental_function_args (gfc_ss * ss, gfc_actual_arglist *arg,
static gfc_ss *
gfc_walk_function_expr (gfc_ss * ss, gfc_expr * expr)
{
gfc_ss *newss;
gfc_intrinsic_sym *isym;
gfc_symbol *sym;
gfc_component *comp = NULL;
int n;
isym = expr->value.function.isym;
@ -7872,16 +7880,7 @@ gfc_walk_function_expr (gfc_ss * ss, gfc_expr * expr)
gfc_is_proc_ptr_comp (expr, &comp);
if ((!comp && gfc_return_by_reference (sym) && sym->result->attr.dimension)
|| (comp && comp->attr.dimension))
{
newss = gfc_get_ss ();
newss->type = GFC_SS_FUNCTION;
newss->expr = expr;
newss->next = ss;
newss->data.info.dimen = expr->rank;
for (n = 0; n < newss->data.info.dimen; n++)
newss->data.info.dim[n] = n;
return newss;
}
return gfc_get_array_ss (ss, expr, expr->rank, GFC_SS_FUNCTION);
/* Walk the parameters of an elemental function. For now we always pass
by reference. */
@ -7900,18 +7899,7 @@ gfc_walk_function_expr (gfc_ss * ss, gfc_expr * expr)
static gfc_ss *
gfc_walk_array_constructor (gfc_ss * ss, gfc_expr * expr)
{
gfc_ss *newss;
int n;
newss = gfc_get_ss ();
newss->type = GFC_SS_CONSTRUCTOR;
newss->expr = expr;
newss->next = ss;
newss->data.info.dimen = expr->rank;
for (n = 0; n < expr->rank; n++)
newss->data.info.dim[n] = n;
return newss;
return gfc_get_array_ss (ss, expr, expr->rank, GFC_SS_CONSTRUCTOR);
}

2
gcc/fortran/trans-array.h
View File

@ -87,6 +87,8 @@ void gfc_add_ss_to_loop (gfc_loopinfo *, gfc_ss *);
void gfc_mark_ss_chain_used (gfc_ss *, unsigned);
/* Free a gfc_ss chain. */
void gfc_free_ss_chain (gfc_ss *);
/* Allocate a new array type ss. */
gfc_ss *gfc_get_array_ss (gfc_ss *, gfc_expr *, int, gfc_ss_type);
/* Calculates the lower bound and stride of array sections. */
void gfc_conv_ss_startstride (gfc_loopinfo *);

8
gcc/fortran/trans-expr.c
View File

@ -4367,18 +4367,14 @@ gfc_trans_subarray_assign (tree dest, gfc_component * cm, gfc_expr * expr)
}
/* Create a SS for the destination. */
lss = gfc_get_ss ();
lss->type = GFC_SS_COMPONENT;
lss->expr = NULL;
lss = gfc_get_array_ss (gfc_ss_terminator, NULL, cm->as->rank,
GFC_SS_COMPONENT);
lss->shape = gfc_get_shape (cm->as->rank);
lss->next = gfc_ss_terminator;
lss->data.info.dimen = cm->as->rank;
lss->data.info.descriptor = dest;
lss->data.info.data = gfc_conv_array_data (dest);
lss->data.info.offset = gfc_conv_array_offset (dest);
for (n = 0; n < cm->as->rank; n++)
{
lss->data.info.dim[n] = n;
lss->data.info.start[n] = gfc_conv_array_lbound (dest, n);
lss->data.info.stride[n] = gfc_index_one_node;

24
gcc/fortran/trans-intrinsic.c
View File

@ -6801,19 +6801,11 @@ gfc_add_intrinsic_ss_code (gfc_loopinfo * loop ATTRIBUTE_UNUSED, gfc_ss * ss)
static gfc_ss *
gfc_walk_intrinsic_bound (gfc_ss * ss, gfc_expr * expr)
{
gfc_ss *newss;
/* The two argument version returns a scalar. */
if (expr->value.function.actual->next->expr)
return ss;
newss = gfc_get_ss ();
newss->type = GFC_SS_INTRINSIC;
newss->expr = expr;
newss->next = ss;
newss->data.info.dimen = 1;
return newss;
return gfc_get_array_ss (ss, expr, 1, GFC_SS_INTRINSIC);
}
@ -6822,20 +6814,8 @@ gfc_walk_intrinsic_bound (gfc_ss * ss, gfc_expr * expr)
static gfc_ss *
gfc_walk_intrinsic_libfunc (gfc_ss * ss, gfc_expr * expr)
{
gfc_ss *newss;
int n;
gcc_assert (expr->rank > 0);
newss = gfc_get_ss ();
newss->type = GFC_SS_FUNCTION;
newss->expr = expr;
newss->next = ss;
newss->data.info.dimen = expr->rank;
for (n = 0; n < newss->data.info.dimen; n++)
newss->data.info.dim[n] = n;
return newss;
return gfc_get_array_ss (ss, expr, expr->rank, GFC_SS_FUNCTION);
}

8
gcc/fortran/trans-io.c
View File

@ -1946,18 +1946,14 @@ transfer_array_component (tree expr, gfc_component * cm, locus * where)
care of this task, because we don't have a gfc_expr at hand.
Build one manually, as in gfc_trans_subarray_assign. */
ss = gfc_get_ss ();
ss->type = GFC_SS_COMPONENT;
ss->expr = NULL;
ss = gfc_get_array_ss (gfc_ss_terminator, NULL, cm->as->rank,
GFC_SS_COMPONENT);
ss->shape = gfc_get_shape (cm->as->rank);
ss->next = gfc_ss_terminator;
ss->data.info.dimen = cm->as->rank;
ss->data.info.descriptor = expr;
ss->data.info.data = gfc_conv_array_data (expr);
ss->data.info.offset = gfc_conv_array_offset (expr);
for (n = 0; n < cm->as->rank; n++)
{
ss->data.info.dim[n] = n;
ss->data.info.start[n] = gfc_conv_array_lbound (expr, n);
ss->data.info.stride[n] = gfc_index_one_node;