[Patch, fortran] [55..56/66] inline sum and product: Prevent regressions: Fix gfc_conv_elemental_dependencies.

[Mikael Morin <mikael.morin@sfr.fr>]

[-- Attachment #1: Type: text/plain, Size: 698 bytes --]

gfc_conv_elemental_dependency had some ad-hoc fixes to replace one array by its
temporary in the scalarizer.
It was using a fake gfc_loopinfo struct so that gfc_trans_create_temp_array
doesn't overwrite the real one.  It was using fake array references and custom
delta calculation, so that scalarizer's partial offset calculation used the
right array index while accessing the temporary even if it believed it was
accessing the regular array.
Patch 56 removes those fixes, replaces the array gfc_ss struct with a new 
one for the temporary and calls gfc_set_delta to update arrays' delta after
calling gfc_trans_create_temp_array.
Patch 55 is a preliminary patch making some functions public.
OK?

[-- Attachment #2: pr43829-55.CL --]
[-- Type: text/plain, Size: 312 bytes --]

2011-10-19  Mikael Morin  <mikael@gcc.gnu.org>

	* trans-array.h (gfc_free_ss, gfc_set_delta): New prototypes.
	* trans-array.c (gfc_free_ss): Remove forward declaration.
	Make non-static.
	(set_delta, gfc_set_delta): Remove forward declaration.
	Make non-static and rename the former to the later. Update uses.

[-- Attachment #3: pr43829-55.patch --]
[-- Type: text/x-diff, Size: 3076 bytes --]

diff --git a/trans-array.c b/trans-array.c
index 3c0c110..acd9aec 100644
--- a/trans-array.c
+++ b/trans-array.c
@@ -466,8 +466,6 @@ gfc_mark_ss_chain_used (gfc_ss * ss, unsigned flags)
     ss->info->useflags = flags;
 }
 
-static void gfc_free_ss (gfc_ss *);
-
 
 /* Free a gfc_ss chain.  */
 
@@ -500,7 +498,7 @@ free_ss_info (gfc_ss_info *ss_info)
 
 /* Free a SS.  */
 
-static void
+void
 gfc_free_ss (gfc_ss * ss)
 {
   gfc_ss_info *ss_info;
@@ -1027,7 +1025,7 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, gfc_ss * ss,
 
 	  /* We have just changed the loop bounds, we must clear the
 	     corresponding specloop, so that delta calculation is not skipped
-	     later in set_delta.  */
+	     later in gfc_set_delta.  */
 	  loop->specloop[n] = NULL;
 
 	  /* We are constructing the temporary's descriptor based on the loop
@@ -4372,9 +4370,6 @@ set_loop_bounds (gfc_loopinfo *loop)
 }
 
 
-static void set_delta (gfc_loopinfo *loop);
-
-
 /* Initialize the scalarization loop.  Creates the loop variables.  Determines
    the range of the loop variables.  Creates a temporary if required.
    Also generates code for scalar expressions which have been
@@ -4422,10 +4417,8 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where)
 
   /* For array parameters we don't have loop variables, so don't calculate the
      translations.  */
-  if (loop->array_parameter)
-    return;
-
-  set_delta (loop);
+  if (!loop->array_parameter)
+    gfc_set_delta (loop);
 }
 
 
@@ -4433,8 +4426,8 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where)
    array: once loop bounds are chosen, sets the difference (DELTA field) between
    loop bounds and array reference bounds, for each array info.  */
 
-static void
-set_delta (gfc_loopinfo *loop)
+void
+gfc_set_delta (gfc_loopinfo *loop)
 {
   gfc_ss *ss, **loopspec;
   gfc_array_info *info;
@@ -4482,7 +4475,7 @@ set_delta (gfc_loopinfo *loop)
     }
 
   for (loop = loop->nested; loop; loop = loop->next)
-    set_delta (loop);
+    gfc_set_delta (loop);
 }
 
 
diff --git a/trans-array.h b/trans-array.h
index aad8c47..bd593bd 100644
--- a/trans-array.h
+++ b/trans-array.h
@@ -88,6 +88,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 *);
+/* Free a single gfc_ss element.  */
+void gfc_free_ss (gfc_ss *);
 /* Allocate a new array type ss.  */
 gfc_ss *gfc_get_array_ss (gfc_ss *, gfc_expr *, int, gfc_ss_type);
 /* Allocate a new temporary type ss.  */
@@ -111,6 +113,8 @@ void gfc_trans_scalarizing_loops (gfc_loopinfo *, stmtblock_t *);
 void gfc_trans_scalarized_loop_boundary (gfc_loopinfo *, stmtblock_t *);
 /* Initialize the scalarization loop parameters.  */
 void gfc_conv_loop_setup (gfc_loopinfo *, locus *);
+/* Set each array's delta.  */
+void gfc_set_delta (gfc_loopinfo *);
 /* Resolve array assignment dependencies.  */
 void gfc_conv_resolve_dependencies (gfc_loopinfo *, gfc_ss *, gfc_ss *);
 /* Build a null array descriptor constructor.  */

[-- Attachment #4: pr43829-56.CL --]
[-- Type: text/plain, Size: 386 bytes --]

2011-10-19  Mikael Morin  <mikael@gcc.gnu.org>

	* trans-expr.c (gfc_conv_procedure_call): Handle temporaries for
	arguments to elemental calls.
	* trans-stmt.c (replace_ss): New function.
	(gfc_conv_elemental_dependencies): Remove temporary loop handling.
	Create a new ss for the temporary and replace the original one with it.
	Remove fake array references. Recalculate all offsets.

[-- Attachment #5: pr43829-56.patch --]
[-- Type: text/x-diff, Size: 6291 bytes --]

diff --git a/trans-expr.c b/trans-expr.c
index 4cfdc3e..cf9f0f7 100644
--- a/trans-expr.c
+++ b/trans-expr.c
@@ -2997,8 +2997,19 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 	{
 	  /* An elemental function inside a scalarized loop.  */
 	  gfc_init_se (&parmse, se);
-	  gfc_conv_expr_reference (&parmse, e);
 	  parm_kind = ELEMENTAL;
+
+	  if (se->ss->dimen > 0
+	      && se->ss->info->data.array.ref == NULL)
+	    {
+	      gfc_conv_tmp_array_ref (&parmse);
+	      if (e->ts.type == BT_CHARACTER)
+		gfc_conv_string_parameter (&parmse);
+	      else
+		parmse.expr = gfc_build_addr_expr (NULL_TREE, parmse.expr);
+	    }
+	  else
+	    gfc_conv_expr_reference (&parmse, e);
 	}
       else
 	{
diff --git a/trans-stmt.c b/trans-stmt.c
index 2e02320..0d793f9 100644
--- a/trans-stmt.c
+++ b/trans-stmt.c
@@ -178,6 +178,41 @@ gfc_trans_entry (gfc_code * code)
 }
 
 
+/* Replace a gfc_ss structure by another both in the gfc_se struct
+   and the gfc_loopinfo struct.  This is used in gfc_conv_elemental_dependencies
+   to replace a variable ss by the corresponding temporary.  */
+
+static void
+replace_ss (gfc_se *se, gfc_ss *old_ss, gfc_ss *new_ss)
+{
+  gfc_ss **sess, **loopss;
+
+  /* The old_ss is a ss for a single variable.  */
+  gcc_assert (old_ss->info->type == GFC_SS_SECTION);
+
+  for (sess = &(se->ss); *sess != gfc_ss_terminator; sess = &((*sess)->next))
+    if (*sess == old_ss)
+      break;
+  gcc_assert (*sess != gfc_ss_terminator);
+
+  *sess = new_ss;
+  new_ss->next = old_ss->next;
+
+
+  for (loopss = &(se->loop->ss); *loopss != gfc_ss_terminator;
+       loopss = &((*loopss)->loop_chain))
+    if (*loopss == old_ss)
+      break;
+  gcc_assert (*loopss != gfc_ss_terminator);
+
+  *loopss = new_ss;
+  new_ss->loop_chain = old_ss->loop_chain;
+  new_ss->loop = old_ss->loop;
+
+  gfc_free_ss (old_ss);
+}
+
+
 /* Check for dependencies between INTENT(IN) and INTENT(OUT) arguments of
    elemental subroutines.  Make temporaries for output arguments if any such
    dependencies are found.  Output arguments are chosen because internal_unpack
@@ -190,15 +225,10 @@ gfc_conv_elemental_dependencies (gfc_se * se, gfc_se * loopse,
   gfc_actual_arglist *arg0;
   gfc_expr *e;
   gfc_formal_arglist *formal;
-  gfc_loopinfo tmp_loop;
   gfc_se parmse;
   gfc_ss *ss;
-  gfc_array_info *info;
   gfc_symbol *fsym;
-  gfc_ref *ref;
-  int n;
   tree data;
-  tree offset;
   tree size;
   tree tmp;
 
@@ -217,14 +247,9 @@ gfc_conv_elemental_dependencies (gfc_se * se, gfc_se * loopse,
 	continue;
 
       /* Obtain the info structure for the current argument.  */ 
-      info = NULL;
       for (ss = loopse->ss; ss && ss != gfc_ss_terminator; ss = ss->next)
-	{
-	  if (ss->info->expr != e)
-	    continue;
-	  info = &ss->info->data.array;
+	if (ss->info->expr == e)
 	  break;
-	}
 
       /* If there is a dependency, create a temporary and use it
 	 instead of the variable.  */
@@ -237,49 +262,17 @@ gfc_conv_elemental_dependencies (gfc_se * se, gfc_se * loopse,
 	{
 	  tree initial, temptype;
 	  stmtblock_t temp_post;
+	  gfc_ss *tmp_ss;
 
-	  /* Make a local loopinfo for the temporary creation, so that
-	     none of the other ss->info's have to be renormalized.  */
-	  gfc_init_loopinfo (&tmp_loop);
-	  tmp_loop.dimen = ss->dimen;
-	  for (n = 0; n < ss->dimen; n++)
-	    {
-	      tmp_loop.to[n] = loopse->loop->to[n];
-	      tmp_loop.from[n] = loopse->loop->from[n];
-	      tmp_loop.order[n] = loopse->loop->order[n];
-	    }
+	  tmp_ss = gfc_get_array_ss (gfc_ss_terminator, NULL, ss->dimen,
+				     GFC_SS_SECTION);
+	  gfc_mark_ss_chain_used (tmp_ss, 1);
+	  tmp_ss->info->expr = ss->info->expr;
+	  replace_ss (loopse, ss, tmp_ss);
 
 	  /* Obtain the argument descriptor for unpacking.  */
 	  gfc_init_se (&parmse, NULL);
 	  parmse.want_pointer = 1;
-
-	  /* The scalarizer introduces some specific peculiarities when
-	     handling elemental subroutines; the stride can be needed up to
-	     the dim_array - 1, rather than dim_loop - 1 to calculate
-	     offsets outside the loop.  For this reason, we make sure that
-	     the descriptor has the dimensionality of the array by converting
-	     trailing elements into ranges with end = start.  */
-	  for (ref = e->ref; ref; ref = ref->next)
-	    if (ref->type == REF_ARRAY && ref->u.ar.type == AR_SECTION)
-	      break;
-
-	  if (ref)
-	    {
-	      bool seen_range = false;
-	      for (n = 0; n < ref->u.ar.dimen; n++)
-		{
-		  if (ref->u.ar.dimen_type[n] == DIMEN_RANGE)
-		    seen_range = true;
-
-		  if (!seen_range
-			|| ref->u.ar.dimen_type[n] != DIMEN_ELEMENT)
-		    continue;
-
-		  ref->u.ar.end[n] = gfc_copy_expr (ref->u.ar.start[n]);
-		  ref->u.ar.dimen_type[n] = DIMEN_RANGE;
-		}
-	    }
-
 	  gfc_conv_expr_descriptor (&parmse, e, gfc_walk_expr (e));
 	  gfc_add_block_to_block (&se->pre, &parmse.pre);
 
@@ -309,28 +302,15 @@ gfc_conv_elemental_dependencies (gfc_se * se, gfc_se * loopse,
 	  size = gfc_create_var (gfc_array_index_type, NULL);
 	  data = gfc_create_var (pvoid_type_node, NULL);
 	  gfc_init_block (&temp_post);
-	  ss->loop = &tmp_loop;
-	  tmp = gfc_trans_create_temp_array (&se->pre, &temp_post, ss,
+	  tmp = gfc_trans_create_temp_array (&se->pre, &temp_post, tmp_ss,
 					     temptype, initial, false, true,
 					     false, &arg->expr->where);
 	  gfc_add_modify (&se->pre, size, tmp);
-	  tmp = fold_convert (pvoid_type_node, info->data);
+	  tmp = fold_convert (pvoid_type_node, tmp_ss->info->data.array.data);
 	  gfc_add_modify (&se->pre, data, tmp);
 
-	  /* Calculate the offset for the temporary.  */
-	  offset = gfc_index_zero_node;
-	  for (n = 0; n < ss->dimen; n++)
-	    {
-	      tmp = gfc_conv_descriptor_stride_get (info->descriptor,
-						    gfc_rank_cst[n]);
-	      tmp = fold_build2_loc (input_location, MULT_EXPR,
-				     gfc_array_index_type,
-				     loopse->loop->from[n], tmp);
-	      offset = fold_build2_loc (input_location, MINUS_EXPR,
-					gfc_array_index_type, offset, tmp);
-	    }
-	  info->offset = gfc_create_var (gfc_array_index_type, NULL);	  
-	  gfc_add_modify (&se->pre, info->offset, offset);
+	  /* Update other ss' delta.  */
+	  gfc_set_delta (loopse->loop);
 
 	  /* Copy the result back using unpack.  */
 	  tmp = build_call_expr_loc (input_location,