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

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

@@ -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;

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;
-    }
+    /* 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);

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;
-        }
+	/* 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);
@@ -4064,13 +4059,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.  */
@@ -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);