Skip to content

R
riscv-gcc-1
Commit 26f77530 by Mikael Morin Committed by Mikael Morin
Options

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

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

	* trans-array.h (gfc_get_scalar_ss): New prototype.
	* trans-array.c (gfc_get_scalar_ss): New function.
	(gfc_walk_variable_expr, gfc_walk_op_expr,
	gfc_walk_elemental_function_args): Re-use gfc_get_scalar_ss.
	* trans-expr.c (gfc_trans_subarray_assign): Ditto.
	(gfc_trans_assignment_1): Ditto.
	* trans-stmt.c (compute_inner_temp_size, gfc_trans_where_assign,
	gfc_trans_where_3): Ditto.

From-SVN: r178697
parent a1ae4f43
Showing with 44 additions and 64 deletions
gcc/fortran/ChangeLog
2011-09-08 Mikael Morin <mikael.morin@sfr.fr>
* trans-array.h (gfc_get_scalar_ss): New prototype.
* trans-array.c (gfc_get_scalar_ss): New function.
(gfc_walk_variable_expr, gfc_walk_op_expr,
gfc_walk_elemental_function_args): Re-use gfc_get_scalar_ss.
* trans-expr.c (gfc_trans_subarray_assign): Ditto.
(gfc_trans_assignment_1): Ditto.
* trans-stmt.c (compute_inner_temp_size, gfc_trans_where_assign,
gfc_trans_where_3): Ditto.
2011-09-08 Mikael Morin <mikael.morin@sfr.fr>
* trans-array.h (gfc_get_temp_ss): New prototype.
* trans-array.c (gfc_get_temp_ss): New function.
(gfc_conv_resolve_dependencies): Re-use gfc_get_temp_ss.
......
gcc/fortran/trans-array.c
......@@ -552,6 +552,22 @@ gfc_get_temp_ss (tree type, tree string_length, int dimen)
}
/* Creates and initializes a scalar type gfc_ss struct. */
gfc_ss *
gfc_get_scalar_ss (gfc_ss *next, gfc_expr *expr)
{
gfc_ss *ss;
ss = gfc_get_ss ();
ss->next = next;
ss->type = GFC_SS_SCALAR;
ss->expr = expr;
return ss;
}
/* Free all the SS associated with a loop. */
void
......@@ -7597,17 +7613,8 @@ gfc_walk_variable_expr (gfc_ss * ss, gfc_expr * expr)
{
if (ref->type == REF_SUBSTRING)
{
newss = gfc_get_ss ();
newss->type = GFC_SS_SCALAR;
newss->expr = ref->u.ss.start;
newss->next = ss;
ss = newss;
newss = gfc_get_ss ();
newss->type = GFC_SS_SCALAR;
newss->expr = ref->u.ss.end;
newss->next = ss;
ss = newss;
ss = gfc_get_scalar_ss (ss, ref->u.ss.start);
ss = gfc_get_scalar_ss (ss, ref->u.ss.end);
}
/* We're only interested in array sections from now on. */
......@@ -7626,13 +7633,7 @@ gfc_walk_variable_expr (gfc_ss * ss, gfc_expr * expr)
{
case AR_ELEMENT:
for (n = ar->dimen + ar->codimen - 1; n >= 0; n--)
{
newss = gfc_get_ss ();
newss->type = GFC_SS_SCALAR;
newss->expr = ar->start[n];
newss->next = ss;
ss = newss;
}
ss = gfc_get_scalar_ss (ss, ar->start[n]);
break;
case AR_FULL:
......@@ -7678,10 +7679,7 @@ gfc_walk_variable_expr (gfc_ss * ss, gfc_expr * expr)
case DIMEN_ELEMENT:
/* Add SS for elemental (scalar) subscripts. */
gcc_assert (ar->start[n]);
indexss = gfc_get_ss ();
indexss->type = GFC_SS_SCALAR;
indexss->expr = ar->start[n];
indexss->next = gfc_ss_terminator;
indexss = gfc_get_scalar_ss (gfc_ss_terminator, ar->start[n]);
indexss->loop_chain = gfc_ss_terminator;
newss->data.info.subscript[n] = indexss;
break;
......@@ -7736,7 +7734,6 @@ gfc_walk_op_expr (gfc_ss * ss, gfc_expr * expr)
{
gfc_ss *head;
gfc_ss *head2;
gfc_ss *newss;
head = gfc_walk_subexpr (ss, expr->value.op.op1);
if (expr->value.op.op2 == NULL)
......@@ -7754,8 +7751,6 @@ gfc_walk_op_expr (gfc_ss * ss, gfc_expr * expr)
/* One of the operands needs scalarization, the other is scalar.
Create a gfc_ss for the scalar expression. */
newss = gfc_get_ss ();
newss->type = GFC_SS_SCALAR;
if (head == ss)
{
/* First operand is scalar. We build the chain in reverse order, so
......@@ -7765,17 +7760,13 @@ gfc_walk_op_expr (gfc_ss * ss, gfc_expr * expr)
head = head->next;
/* Check we haven't somehow broken the chain. */
gcc_assert (head);
newss->next = ss;
head->next = newss;
newss->expr = expr->value.op.op1;
head->next = gfc_get_scalar_ss (ss, expr->value.op.op1);
}
else /* head2 == head */
{
gcc_assert (head2 == head);
/* Second operand is scalar. */
newss->next = head2;
head2 = newss;
newss->expr = expr->value.op.op2;
head2 = gfc_get_scalar_ss (head2, expr->value.op.op2);
}
return head2;
......@@ -7830,10 +7821,9 @@ gfc_walk_elemental_function_args (gfc_ss * ss, gfc_actual_arglist *arg,
if (newss == head)
{
/* Scalar argument. */
newss = gfc_get_ss ();
gcc_assert (type == GFC_SS_SCALAR || type == GFC_SS_REFERENCE);
newss = gfc_get_scalar_ss (head, arg->expr);
newss->type = type;
newss->expr = arg->expr;
newss->next = head;
}
else
scalar = 0;
......
gcc/fortran/trans-array.h
......@@ -91,6 +91,8 @@ void gfc_free_ss_chain (gfc_ss *);
gfc_ss *gfc_get_array_ss (gfc_ss *, gfc_expr *, int, gfc_ss_type);
/* Allocate a new temporary type ss. */
gfc_ss *gfc_get_temp_ss (tree, tree, int);
/* Allocate a new scalar type ss. */
gfc_ss *gfc_get_scalar_ss (gfc_ss *, gfc_expr *);
/* Calculates the lower bound and stride of array sections. */
void gfc_conv_ss_startstride (gfc_loopinfo *);
......
gcc/fortran/trans-expr.c
......@@ -4352,13 +4352,8 @@ gfc_trans_subarray_assign (tree dest, gfc_component * cm, gfc_expr * expr)
/* Walk the rhs. */
rss = gfc_walk_expr (expr);
if (rss == gfc_ss_terminator)
{
/* The rhs is scalar. Add a ss for the expression. */
rss = gfc_get_ss ();
rss->next = gfc_ss_terminator;
rss->type = GFC_SS_SCALAR;
rss->expr = expr;
}
rss = gfc_get_scalar_ss (gfc_ss_terminator, expr);
/* Create a SS for the destination. */
lss = gfc_get_array_ss (gfc_ss_terminator, NULL, cm->as->rank,
......@@ -6158,13 +6153,9 @@ gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag,
/* Walk the rhs. */
rss = gfc_walk_expr (expr2);
if (rss == gfc_ss_terminator)
{
/* The rhs is scalar. Add a ss for the expression. */
rss = gfc_get_ss ();
rss->next = gfc_ss_terminator;
rss->type = GFC_SS_SCALAR;
rss->expr = expr2;
}
rss = gfc_get_scalar_ss (gfc_ss_terminator, expr2);
/* Associate the SS with the loop. */
gfc_add_ss_to_loop (&loop, lss);
gfc_add_ss_to_loop (&loop, rss);
......
gcc/fortran/trans-stmt.c
......@@ -3023,13 +3023,8 @@ compute_inner_temp_size (gfc_expr *expr1, gfc_expr *expr2,
/* Walk the RHS of the expression. */
*rss = gfc_walk_expr (expr2);
if (*rss == gfc_ss_terminator)
{
/* The rhs is scalar. Add a ss for the expression. */
*rss = gfc_get_ss ();
(*rss)->next = gfc_ss_terminator;
(*rss)->type = GFC_SS_SCALAR;
(*rss)->expr = expr2;
}
*rss = gfc_get_scalar_ss (gfc_ss_terminator, expr2);
/* Associate the SS with the loop. */
gfc_add_ss_to_loop (&loop, *lss);
......@@ -4066,11 +4061,8 @@ gfc_trans_where_assign (gfc_expr *expr1, gfc_expr *expr2,
if (rss == gfc_ss_terminator)
{
/* The rhs is scalar. Add a ss for the expression. */
rss = gfc_get_ss ();
rss = gfc_get_scalar_ss (gfc_ss_terminator, expr2);
rss->where = 1;
rss->next = gfc_ss_terminator;
rss->type = GFC_SS_SCALAR;
rss->expr = expr2;
}
/* Associate the SS with the loop. */
......@@ -4508,11 +4500,8 @@ gfc_trans_where_3 (gfc_code * cblock, gfc_code * eblock)
tsss = gfc_walk_expr (tsrc);
if (tsss == gfc_ss_terminator)
{
tsss = gfc_get_ss ();
tsss = gfc_get_scalar_ss (gfc_ss_terminator, tsrc);
tsss->where = 1;
tsss->next = gfc_ss_terminator;
tsss->type = GFC_SS_SCALAR;
tsss->expr = tsrc;
}
gfc_add_ss_to_loop (&loop, tdss);
gfc_add_ss_to_loop (&loop, tsss);
......@@ -4526,11 +4515,8 @@ gfc_trans_where_3 (gfc_code * cblock, gfc_code * eblock)
esss = gfc_walk_expr (esrc);
if (esss == gfc_ss_terminator)
{
esss = gfc_get_ss ();
esss = gfc_get_scalar_ss (gfc_ss_terminator, esrc);
esss->where = 1;
esss->next = gfc_ss_terminator;
esss->type = GFC_SS_SCALAR;
esss->expr = esrc;
}
gfc_add_ss_to_loop (&loop, edss);
gfc_add_ss_to_loop (&loop, esss);
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment