[Patch, fortran] [3/4] gfc_ss structs initialization small refactoring: scalars
Mikael Morin
mikael.morin@sfr.fr
Wed Aug 31 20:37:00 GMT 2011
gfc_ss structs of type GFC_SS_SCALAR (and GFC_SS_REFERENCE) are not uncommon.
Let's share their initialization.
There is one single case of GFC_SS_REFERENCE, everything else is GFC_SS_SCALAR,
so I have decided to always set GFC_SS_SCALAR in the initialisation, and reset
it to the right value afterwards in the one case it is needed (in gfc_walk_elemental_function_args).
OK?
-------------- next part --------------
2011-08-30 Mikael Morin <mikael.morin@gcc.gnu.org>
* 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.
-------------- next part --------------
commit 3856ff8a856a3e651e666651361bcf8fc260671b
Author: Mikael Morin <mik@gimli.local>
Date: Tue Jun 28 18:05:02 2011 +0200
Factorisation gfc_get_scalar_ss
diff --git a/trans-array.c b/trans-array.c
index 5f02c87..80a6fe6 100644
--- a/trans-array.c
+++ b/trans-array.c
@@ -550,6 +550,22 @@ gfc_get_temp_ss (tree type, tree string_length, int dimen)
return ss;
}
+
+
+/* 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. */
@@ -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;
diff --git a/trans-array.h b/trans-array.h
index e2718b2..73d8c40 100644
--- a/trans-array.h
+++ b/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 *);
diff --git a/trans-expr.c b/trans-expr.c
index 0e85060..6a33719 100644
--- a/trans-expr.c
+++ b/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;
- }
+ /* The rhs is scalar. Add a ss for the expression. */
+ 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;
- }
+ /* The rhs is scalar. Add a ss for the expression. */
+ 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);
diff --git a/trans-stmt.c b/trans-stmt.c
index 7d8b4e0..5d7d6b2 100644
--- a/trans-stmt.c
+++ b/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;
- }
+ /* The rhs is scalar. Add a ss for the expression. */
+ *rss = gfc_get_scalar_ss (gfc_ss_terminator, expr2);
/* Associate the SS with the loop. */
gfc_add_ss_to_loop (&loop, *lss);
@@ -4034,13 +4029,10 @@ gfc_trans_where_assign (gfc_expr *expr1, gfc_expr *expr2,
/* 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->where = 1;
- rss->next = gfc_ss_terminator;
- rss->type = GFC_SS_SCALAR;
- rss->expr = expr2;
+ {
+ /* The rhs is scalar. Add a ss for the expression. */
+ rss = gfc_get_scalar_ss (gfc_ss_terminator, expr2);
+ rss->where = 1;
}
/* Associate the SS with the loop. */
@@ -4478,11 +4470,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);
@@ -4496,11 +4485,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);
More information about the Fortran
mailing list