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

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

gcc/fortran/ChangeLog

+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

gcc/fortran/trans-array.c

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

gcc/fortran/trans-array.h

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

gcc/fortran/trans-expr.c

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

gcc/fortran/trans-intrinsic.c

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

gcc/fortran/trans-io.c

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