This is the mail archive of the
fortran@gcc.gnu.org
mailing list for the GNU Fortran project.
[Patch, fortran] [31..53/66] inline sum and product: Update the scalarizer.
- From: Mikael Morin <mikael dot morin at sfr dot fr>
- To: gfortran <fortran at gcc dot gnu dot org> , GCC patches <gcc-patches at gcc dot gnu dot org>
- Date: Fri, 28 Oct 2011 01:31:44 +0200 (CEST)
- Subject: [Patch, fortran] [31..53/66] inline sum and product: Update the scalarizer.
- References: <20111027232818.18581.901@gimli.local>
This part of the serie takes care of updating the scalarizer code once its
core structures have changed.
There are basically two kinds of changes:
- for functions working on loops mostly one needs to take care of more than
one loop. This is done by attaching a list of nested loops to every
gfc_loopinfo struct and calling these functions recursively on every element
of the list. (See patches 31 and 47..52).
- for functions working mostly on arrays, one needs to take care of arrays
slices scattered in more than one gfc_ss struct. This is done by adding
nested_ss and parent pointers to walk upwards (towards outer loops) or
downwards (towards inner loops) in the chain. Then the function can walk
the chain to have a view of the whole array. See below for the
gfc_trans_create_temp_array case. (See patches 40..44).
- Hybrid functions. Of course most functions are not trivial enough to work
on loops without looking at the arrays, or conversely working on a single
array without using the loop information. For those hybrid functions, a
combination of the above is used. A loop field is added to the gfc_ss structs
so that there is no ambiguity (it's easy to make mistakes) to which loop the
array slice belongs.
The case of gfc_trans_create_temp_array deserves a comment of its own.
For the expression
some_func(sum(a(:,:), 1))
the temporary created needs to be of rank 2 (i.e. it should be of the same size
as `a(1,:)', while for the expression
sum(some_other_func(), 1)
it should have the same size as the full result of `some_other_func()'.
This shows that in the first case we want the temporary to be of the size of the
outer loop only, while for the second it should be of the combined size of
the outer and the inner loop. Thus, we can't guess temporary size by walking
loops downwards (from the outer to the inner loop), we have to walk upwards
(this is patch 46, with preliminaries 33 and 45).
The same convention has been used in all the functions requiring the same kind
of walk: walk from inner to outer.
Another important thing in gfc_trans_create_temp_array is the handling of
dimensions. In every gfc_ss struct, we have with the DIM array a mapping from
loop dimension to array dimension, but as we are setting temporary bounds with
loop bounds, we need to reverse that information (get the loop bounds from the
array dimension). If one wants to handle multiple loops one has to consider
every corresponding DIM array.
See patch 45 for details.
Sorry, this part is a big mess.
Patch 31 : Split gfc_conv_loop_setup.
Patch 32 : Clear specloop in gfc_trans_create_temp_array.
Patch 33 : Move condition out of loop in gfc_trans_create_temp_array.
Patch 34 : gfc_ss_info reference counting.
Patch 35..39: New gfc_ss::loop field.
Patch 40..43: New gfc_ss::parent field.
Patch 44 : New gfc_ss::nested_ss field.
Patch 45 : Update get_array_ref_dim.
Patch 46 : Update gfc_trans_create_temp_array.
Patch 47..48: New gfc_loopinfo::nested_loop field.
Patch 49..51: New gfc_loopinfo::parent field.
Patch 52 : Add preliminary code in outermost loop.
Patch 53 : Update gfc_trans_preloop_setup.
diff --git a/trans-array.c b/trans-array.c
index 045c426cab10dd934c92759f3ae4c6e29e1de99a..3c0c11038079cfcce3b47ce68f223869b30d93e4 100644
*** a/trans-array.c
--- b/trans-array.c
*************** gfc_free_ss_chain (gfc_ss * ss)
*** 489,494 ****
--- 489,499 ----
static void
free_ss_info (gfc_ss_info *ss_info)
{
+ ss_info->refcount--;
+ if (ss_info->refcount > 0)
+ return;
+
+ gcc_assert (ss_info->refcount == 0);
free (ss_info);
}
*************** gfc_get_array_ss (gfc_ss *next, gfc_expr
*** 532,537 ****
--- 537,543 ----
int i;
ss_info = gfc_get_ss_info ();
+ ss_info->refcount++;
ss_info->type = type;
ss_info->expr = expr;
*************** gfc_get_temp_ss (tree type, tree string_
*** 556,561 ****
--- 562,568 ----
int i;
ss_info = gfc_get_ss_info ();
+ ss_info->refcount++;
ss_info->type = GFC_SS_TEMP;
ss_info->string_length = string_length;
ss_info->data.temp.type = type;
*************** gfc_get_scalar_ss (gfc_ss *next, gfc_exp
*** 580,585 ****
--- 587,593 ----
gfc_ss_info *ss_info;
ss_info = gfc_get_ss_info ();
+ ss_info->refcount++;
ss_info->type = GFC_SS_SCALAR;
ss_info->expr = expr;
*************** gfc_get_scalar_ss (gfc_ss *next, gfc_exp
*** 596,601 ****
--- 604,610 ----
void
gfc_cleanup_loop (gfc_loopinfo * loop)
{
+ gfc_loopinfo *loop_next, **ploop;
gfc_ss *ss;
gfc_ss *next;
*************** gfc_cleanup_loop (gfc_loopinfo * loop)
*** 607,612 ****
--- 616,659 ----
gfc_free_ss (ss);
ss = next;
}
+
+ /* Remove reference to self in the parent loop. */
+ if (loop->parent)
+ for (ploop = &loop->parent->nested; *ploop; ploop = &(*ploop)->next)
+ if (*ploop == loop)
+ {
+ *ploop = loop->next;
+ break;
+ }
+
+ /* Free non-freed nested loops. */
+ for (loop = loop->nested; loop; loop = loop_next)
+ {
+ loop_next = loop->next;
+ gfc_cleanup_loop (loop);
+ free (loop);
+ }
+ }
+
+
+ static void
+ set_ss_loop (gfc_ss *ss, gfc_loopinfo *loop)
+ {
+ int n;
+
+ for (; ss != gfc_ss_terminator; ss = ss->next)
+ {
+ ss->loop = loop;
+
+ if (ss->info->type == GFC_SS_SCALAR
+ || ss->info->type == GFC_SS_REFERENCE
+ || ss->info->type == GFC_SS_TEMP)
+ continue;
+
+ for (n = 0; n < GFC_MAX_DIMENSIONS; n++)
+ if (ss->info->data.array.subscript[n] != NULL)
+ set_ss_loop (ss->info->data.array.subscript[n], loop);
+ }
}
*************** void
*** 616,628 ****
--- 663,698 ----
gfc_add_ss_to_loop (gfc_loopinfo * loop, gfc_ss * head)
{
gfc_ss *ss;
+ gfc_loopinfo *nested_loop;
if (head == gfc_ss_terminator)
return;
+ set_ss_loop (head, loop);
+
ss = head;
for (; ss && ss != gfc_ss_terminator; ss = ss->next)
{
+ if (ss->nested_ss)
+ {
+ nested_loop = ss->nested_ss->loop;
+
+ /* More than one ss can belong to the same loop. Hence, we add the
+ loop to the chain only if it is different from the previously
+ added one, to avoid duplicate nested loops. */
+ if (nested_loop != loop->nested)
+ {
+ gcc_assert (nested_loop->parent == NULL);
+ nested_loop->parent = loop;
+
+ gcc_assert (nested_loop->next == NULL);
+ nested_loop->next = loop->nested;
+ loop->nested = nested_loop;
+ }
+ else
+ gcc_assert (nested_loop->parent == loop);
+ }
+
if (ss->next == gfc_ss_terminator)
ss->loop_chain = loop->ss;
else
*************** void
*** 657,676 ****
gfc_set_loop_bounds_from_array_spec (gfc_interface_mapping * mapping,
gfc_se * se, gfc_array_spec * as)
{
! int n, dim;
gfc_se tmpse;
tree lower;
tree upper;
tree tmp;
! if (as && as->type == AS_EXPLICIT)
! for (n = 0; n < se->loop->dimen; n++)
{
! dim = se->ss->dim[n];
! gcc_assert (dim < as->rank);
! gcc_assert (se->loop->dimen == as->rank);
! if (se->loop->to[n] == NULL_TREE)
{
/* Evaluate the lower bound. */
gfc_init_se (&tmpse, NULL);
gfc_apply_interface_mapping (mapping, &tmpse, as->lower[dim]);
--- 727,757 ----
gfc_set_loop_bounds_from_array_spec (gfc_interface_mapping * mapping,
gfc_se * se, gfc_array_spec * as)
{
! int n, dim, total_dim;
gfc_se tmpse;
+ gfc_ss *ss;
tree lower;
tree upper;
tree tmp;
! total_dim = 0;
!
! if (!as || as->type != AS_EXPLICIT)
! return;
!
! for (ss = se->ss; ss; ss = ss->parent)
{
! total_dim += ss->loop->dimen;
! for (n = 0; n < ss->loop->dimen; n++)
{
+ /* The bound is known, nothing to do. */
+ if (ss->loop->to[n] != NULL_TREE)
+ continue;
+
+ dim = ss->dim[n];
+ gcc_assert (dim < as->rank);
+ gcc_assert (ss->loop->dimen <= as->rank);
+
/* Evaluate the lower bound. */
gfc_init_se (&tmpse, NULL);
gfc_apply_interface_mapping (mapping, &tmpse, as->lower[dim]);
*************** gfc_set_loop_bounds_from_array_spec (gfc
*** 689,697 ****
tmp = fold_build2_loc (input_location, MINUS_EXPR,
gfc_array_index_type, upper, lower);
tmp = gfc_evaluate_now (tmp, &se->pre);
! se->loop->to[n] = tmp;
}
}
}
--- 770,780 ----
tmp = fold_build2_loc (input_location, MINUS_EXPR,
gfc_array_index_type, upper, lower);
tmp = gfc_evaluate_now (tmp, &se->pre);
! ss->loop->to[n] = tmp;
}
}
+
+ gcc_assert (total_dim == as->rank);
}
*************** gfc_trans_allocate_array_storage (stmtbl
*** 824,843 ****
}
! /* Get the array reference dimension corresponding to the given loop dimension.
! It is different from the true array dimension given by the dim array in
! the case of a partial array reference
! It is different from the loop dimension in the case of a transposed array.
! */
static int
! get_array_ref_dim (gfc_ss *ss, int loop_dim)
{
! int n, array_dim, array_ref_dim;
array_ref_dim = 0;
- array_dim = ss->dim[loop_dim];
for (n = 0; n < ss->dimen; n++)
if (ss->dim[n] < array_dim)
array_ref_dim++;
--- 907,935 ----
}
! /* Get the scalarizer array dimension corresponding to actual array dimension
! given by ARRAY_DIM.
!
! For example, if SS represents the array ref a(1,:,:,1), it is a
! bidimensional scalarizer array, and the result would be 0 for ARRAY_DIM=1,
! and 1 for ARRAY_DIM=2.
! If SS represents transpose(a(:,1,1,:)), it is again a bidimensional
! scalarizer array, and the result would be 1 for ARRAY_DIM=0 and 0 for
! ARRAY_DIM=3.
! If SS represents sum(a(:,:,:,1), dim=1), it is a 2+1-dimensional scalarizer
! array. If called on the inner ss, the result would be respectively 0,1,2 for
! ARRAY_DIM=0,1,2. If called on the outer ss, the result would be 0,1
! for ARRAY_DIM=1,2. */
static int
! get_scalarizer_dim_for_array_dim (gfc_ss *ss, int array_dim)
{
! int array_ref_dim;
! int n;
array_ref_dim = 0;
+ for (; ss; ss = ss->parent)
for (n = 0; n < ss->dimen; n++)
if (ss->dim[n] < array_dim)
array_ref_dim++;
*************** get_array_ref_dim (gfc_ss *ss, int loop_
*** 846,851 ****
--- 938,968 ----
}
+ static gfc_ss *
+ innermost_ss (gfc_ss *ss)
+ {
+ while (ss->nested_ss != NULL)
+ ss = ss->nested_ss;
+
+ return ss;
+ }
+
+
+
+ /* Get the array reference dimension corresponding to the given loop dimension.
+ It is different from the true array dimension given by the dim array in
+ the case of a partial array reference (i.e. a(:,:,1,:) for example)
+ It is different from the loop dimension in the case of a transposed array.
+ */
+
+ static int
+ get_array_ref_dim_for_loop_dim (gfc_ss *ss, int loop_dim)
+ {
+ return get_scalarizer_dim_for_array_dim (innermost_ss (ss),
+ ss->dim[loop_dim]);
+ }
+
+
/* Generate code to create and initialize the descriptor for a temporary
array. This is used for both temporaries needed by the scalarizer, and
functions returning arrays. Adjusts the loop variables to be
*************** get_array_ref_dim (gfc_ss *ss, int loop_
*** 857,871 ****
callee allocated array.
PRE, POST, INITIAL, DYNAMIC and DEALLOC are as for
! gfc_trans_allocate_array_storage.
! */
tree
! gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post,
! gfc_loopinfo * loop, gfc_ss * ss,
tree eltype, tree initial, bool dynamic,
bool dealloc, bool callee_alloc, locus * where)
{
gfc_array_info *info;
tree from[GFC_MAX_DIMENSIONS], to[GFC_MAX_DIMENSIONS];
tree type;
--- 974,988 ----
callee allocated array.
PRE, POST, INITIAL, DYNAMIC and DEALLOC are as for
! gfc_trans_allocate_array_storage. */
tree
! gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, gfc_ss * ss,
tree eltype, tree initial, bool dynamic,
bool dealloc, bool callee_alloc, locus * where)
{
+ gfc_loopinfo *loop;
+ gfc_ss *s;
gfc_array_info *info;
tree from[GFC_MAX_DIMENSIONS], to[GFC_MAX_DIMENSIONS];
tree type;
*************** gfc_trans_create_temp_array (stmtblock_t
*** 876,881 ****
--- 993,999 ----
tree cond;
tree or_expr;
int n, dim, tmp_dim;
+ int total_dim = 0;
memset (from, 0, sizeof (from));
memset (to, 0, sizeof (to));
*************** gfc_trans_create_temp_array (stmtblock_t
*** 883,897 ****
info = &ss->info->data.array;
gcc_assert (ss->dimen > 0);
! gcc_assert (loop->dimen == ss->dimen);
if (gfc_option.warn_array_temp && where)
gfc_warning ("Creating array temporary at %L", where);
/* Set the lower bound to zero. */
for (n = 0; n < loop->dimen; n++)
{
! dim = ss->dim[n];
/* Callee allocated arrays may not have a known bound yet. */
if (loop->to[n])
--- 1001,1020 ----
info = &ss->info->data.array;
gcc_assert (ss->dimen > 0);
! gcc_assert (ss->loop->dimen == ss->dimen);
if (gfc_option.warn_array_temp && where)
gfc_warning ("Creating array temporary at %L", where);
/* Set the lower bound to zero. */
+ for (s = ss; s; s = s->parent)
+ {
+ loop = s->loop;
+
+ total_dim += loop->dimen;
for (n = 0; n < loop->dimen; n++)
{
! dim = s->dim[n];
/* Callee allocated arrays may not have a known bound yet. */
if (loop->to[n])
*************** gfc_trans_create_temp_array (stmtblock_t
*** 902,914 ****
pre);
loop->from[n] = gfc_index_zero_node;
/* We are constructing the temporary's descriptor based on the loop
dimensions. As the dimensions may be accessed in arbitrary order
(think of transpose) the size taken from the n'th loop may not map
! to the n'th dimension of the array. We need to reconstruct loop infos
! in the right order before using it to set the descriptor
bounds. */
! tmp_dim = get_array_ref_dim (ss, n);
from[tmp_dim] = loop->from[n];
to[tmp_dim] = loop->to[n];
--- 1025,1042 ----
pre);
loop->from[n] = gfc_index_zero_node;
+ /* We have just changed the loop bounds, we must clear the
+ corresponding specloop, so that delta calculation is not skipped
+ later in set_delta. */
+ loop->specloop[n] = NULL;
+
/* We are constructing the temporary's descriptor based on the loop
dimensions. As the dimensions may be accessed in arbitrary order
(think of transpose) the size taken from the n'th loop may not map
! to the n'th dimension of the array. We need to reconstruct loop
! infos in the right order before using it to set the descriptor
bounds. */
! tmp_dim = get_scalarizer_dim_for_array_dim (ss, dim);
from[tmp_dim] = loop->from[n];
to[tmp_dim] = loop->to[n];
*************** gfc_trans_create_temp_array (stmtblock_t
*** 917,926 ****
info->end[dim] = gfc_index_zero_node;
info->stride[dim] = gfc_index_one_node;
}
/* Initialize the descriptor. */
type =
! gfc_get_array_type_bounds (eltype, ss->dimen, 0, from, to, 1,
GFC_ARRAY_UNKNOWN, true);
desc = gfc_create_var (type, "atmp");
GFC_DECL_PACKED_ARRAY (desc) = 1;
--- 1045,1055 ----
info->end[dim] = gfc_index_zero_node;
info->stride[dim] = gfc_index_one_node;
}
+ }
/* Initialize the descriptor. */
type =
! gfc_get_array_type_bounds (eltype, total_dim, 0, from, to, 1,
GFC_ARRAY_UNKNOWN, true);
desc = gfc_create_var (type, "atmp");
GFC_DECL_PACKED_ARRAY (desc) = 1;
*************** gfc_trans_create_temp_array (stmtblock_t
*** 949,992 ****
/* If there is at least one null loop->to[n], it is a callee allocated
array. */
! for (n = 0; n < loop->dimen; n++)
! if (loop->to[n] == NULL_TREE)
{
size = NULL_TREE;
break;
}
- for (n = 0; n < loop->dimen; n++)
- {
- dim = ss->dim[n];
-
if (size == NULL_TREE)
{
/* For a callee allocated array express the loop bounds in terms
of the descriptor fields. */
tmp = fold_build2_loc (input_location,
MINUS_EXPR, gfc_array_index_type,
gfc_conv_descriptor_ubound_get (desc, gfc_rank_cst[dim]),
gfc_conv_descriptor_lbound_get (desc, gfc_rank_cst[dim]));
! loop->to[n] = tmp;
! continue;
}
!
/* Store the stride and bound components in the descriptor. */
gfc_conv_descriptor_stride_set (pre, desc, gfc_rank_cst[n], size);
gfc_conv_descriptor_lbound_set (pre, desc, gfc_rank_cst[n],
gfc_index_zero_node);
! gfc_conv_descriptor_ubound_set (pre, desc, gfc_rank_cst[n],
! to[n]);
! tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
to[n], gfc_index_one_node);
/* Check whether the size for this dimension is negative. */
! cond = fold_build2_loc (input_location, LE_EXPR, boolean_type_node, tmp,
! gfc_index_zero_node);
cond = gfc_evaluate_now (cond, pre);
if (n == 0)
--- 1078,1123 ----
/* If there is at least one null loop->to[n], it is a callee allocated
array. */
! for (n = 0; n < total_dim; n++)
! if (to[n] == NULL_TREE)
{
size = NULL_TREE;
break;
}
if (size == NULL_TREE)
+ for (s = ss; s; s = s->parent)
+ for (n = 0; n < s->loop->dimen; n++)
{
+ dim = get_scalarizer_dim_for_array_dim (ss, ss->dim[n]);
+
/* For a callee allocated array express the loop bounds in terms
of the descriptor fields. */
tmp = fold_build2_loc (input_location,
MINUS_EXPR, gfc_array_index_type,
gfc_conv_descriptor_ubound_get (desc, gfc_rank_cst[dim]),
gfc_conv_descriptor_lbound_get (desc, gfc_rank_cst[dim]));
! s->loop->to[n] = tmp;
}
! else
! {
! for (n = 0; n < total_dim; n++)
! {
/* Store the stride and bound components in the descriptor. */
gfc_conv_descriptor_stride_set (pre, desc, gfc_rank_cst[n], size);
gfc_conv_descriptor_lbound_set (pre, desc, gfc_rank_cst[n],
gfc_index_zero_node);
! gfc_conv_descriptor_ubound_set (pre, desc, gfc_rank_cst[n], to[n]);
! tmp = fold_build2_loc (input_location, PLUS_EXPR,
! gfc_array_index_type,
to[n], gfc_index_one_node);
/* Check whether the size for this dimension is negative. */
! cond = fold_build2_loc (input_location, LE_EXPR, boolean_type_node,
! tmp, gfc_index_zero_node);
cond = gfc_evaluate_now (cond, pre);
if (n == 0)
*************** gfc_trans_create_temp_array (stmtblock_t
*** 995,1007 ****
or_expr = fold_build2_loc (input_location, TRUTH_OR_EXPR,
boolean_type_node, or_expr, cond);
! size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
! size, tmp);
size = gfc_evaluate_now (size, pre);
}
/* Get the size of the array. */
-
if (size && !callee_alloc)
{
/* If or_expr is true, then the extent in at least one
--- 1126,1138 ----
or_expr = fold_build2_loc (input_location, TRUTH_OR_EXPR,
boolean_type_node, or_expr, cond);
! size = fold_build2_loc (input_location, MULT_EXPR,
! gfc_array_index_type, size, tmp);
size = gfc_evaluate_now (size, pre);
}
+ }
/* Get the size of the array. */
if (size && !callee_alloc)
{
/* If or_expr is true, then the extent in at least one
*************** gfc_trans_create_temp_array (stmtblock_t
*** 1024,1031 ****
gfc_trans_allocate_array_storage (pre, post, info, size, nelem, initial,
dynamic, dealloc);
! if (ss->dimen > loop->temp_dim)
! loop->temp_dim = ss->dimen;
return size;
}
--- 1155,1165 ----
gfc_trans_allocate_array_storage (pre, post, info, size, nelem, initial,
dynamic, dealloc);
! while (ss->parent)
! ss = ss->parent;
!
! if (ss->dimen > ss->loop->temp_dim)
! ss->loop->temp_dim = ss->dimen;
return size;
}
*************** trans_constant_array_constructor (gfc_ss
*** 1899,1916 ****
}
}
/* Helper routine of gfc_trans_array_constructor to determine if the
bounds of the loop specified by LOOP are constant and simple enough
to use with trans_constant_array_constructor. Returns the
iteration count of the loop if suitable, and NULL_TREE otherwise. */
static tree
! constant_array_constructor_loop_size (gfc_loopinfo * loop)
{
tree size = gfc_index_one_node;
tree tmp;
! int i;
for (i = 0; i < loop->dimen; i++)
{
/* If the bounds aren't constant, return NULL_TREE. */
--- 2033,2069 ----
}
}
+
+ static int
+ get_rank (gfc_loopinfo *loop)
+ {
+ int rank;
+
+ rank = 0;
+ for (; loop; loop = loop->parent)
+ rank += loop->dimen;
+
+ return rank;
+ }
+
+
/* Helper routine of gfc_trans_array_constructor to determine if the
bounds of the loop specified by LOOP are constant and simple enough
to use with trans_constant_array_constructor. Returns the
iteration count of the loop if suitable, and NULL_TREE otherwise. */
static tree
! constant_array_constructor_loop_size (gfc_loopinfo * l)
{
+ gfc_loopinfo *loop;
tree size = gfc_index_one_node;
tree tmp;
! int i, total_dim;
+ total_dim = get_rank (l);
+
+ for (loop = l; loop; loop = loop->parent)
+ {
for (i = 0; i < loop->dimen; i++)
{
/* If the bounds aren't constant, return NULL_TREE. */
*************** constant_array_constructor_loop_size (gf
*** 1919,1925 ****
if (!integer_zerop (loop->from[i]))
{
/* Only allow nonzero "from" in one-dimensional arrays. */
! if (loop->dimen != 1)
return NULL_TREE;
tmp = fold_build2_loc (input_location, MINUS_EXPR,
gfc_array_index_type,
--- 2072,2078 ----
if (!integer_zerop (loop->from[i]))
{
/* Only allow nonzero "from" in one-dimensional arrays. */
! if (total_dim != 1)
return NULL_TREE;
tmp = fold_build2_loc (input_location, MINUS_EXPR,
gfc_array_index_type,
*************** constant_array_constructor_loop_size (gf
*** 1927,1948 ****
}
else
tmp = loop->to[i];
! tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
! tmp, gfc_index_one_node);
! size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
! size, tmp);
}
return size;
}
/* Array constructors are handled by constructing a temporary, then using that
within the scalarization loop. This is not optimal, but seems by far the
simplest method. */
static void
! gfc_trans_array_constructor (gfc_loopinfo * loop, gfc_ss * ss, locus * where)
{
gfc_constructor_base c;
tree offset;
--- 2080,2129 ----
}
else
tmp = loop->to[i];
! tmp = fold_build2_loc (input_location, PLUS_EXPR,
! gfc_array_index_type, tmp, gfc_index_one_node);
! size = fold_build2_loc (input_location, MULT_EXPR,
! gfc_array_index_type, size, tmp);
! }
}
return size;
}
+ static tree *
+ get_loop_upper_bound_for_array (gfc_ss *array, int array_dim)
+ {
+ gfc_ss *ss;
+ int n;
+
+ gcc_assert (array->nested_ss == NULL);
+
+ for (ss = array; ss; ss = ss->parent)
+ for (n = 0; n < ss->loop->dimen; n++)
+ if (array_dim == get_array_ref_dim_for_loop_dim (ss, n))
+ return &(ss->loop->to[n]);
+
+ gcc_unreachable ();
+ }
+
+
+ static gfc_loopinfo *
+ outermost_loop (gfc_loopinfo * loop)
+ {
+ while (loop->parent != NULL)
+ loop = loop->parent;
+
+ return loop;
+ }
+
+
/* Array constructors are handled by constructing a temporary, then using that
within the scalarization loop. This is not optimal, but seems by far the
simplest method. */
static void
! trans_array_constructor (gfc_ss * ss, locus * where)
{
gfc_constructor_base c;
tree offset;
*************** gfc_trans_array_constructor (gfc_loopinf
*** 1950,1966 ****
--- 2131,2152 ----
tree desc;
tree type;
tree tmp;
+ tree *loop_ubound0;
bool dynamic;
bool old_first_len, old_typespec_chararray_ctor;
tree old_first_len_val;
+ gfc_loopinfo *loop, *outer_loop;
gfc_ss_info *ss_info;
gfc_expr *expr;
+ gfc_ss *s;
/* Save the old values for nested checking. */
old_first_len = first_len;
old_first_len_val = first_len_val;
old_typespec_chararray_ctor = typespec_chararray_ctor;
+ loop = ss->loop;
+ outer_loop = outermost_loop (loop);
ss_info = ss->info;
expr = ss_info->expr;
*************** gfc_trans_array_constructor (gfc_loopinf
*** 1976,1982 ****
first_len = true;
}
! gcc_assert (ss->dimen == loop->dimen);
c = expr->value.constructor;
if (expr->ts.type == BT_CHARACTER)
--- 2162,2168 ----
first_len = true;
}
! gcc_assert (ss->dimen == ss->loop->dimen);
c = expr->value.constructor;
if (expr->ts.type == BT_CHARACTER)
*************** gfc_trans_array_constructor (gfc_loopinf
*** 1996,2006 ****
gfc_conv_expr_type (&length_se, expr->ts.u.cl->length,
gfc_charlen_type_node);
ss_info->string_length = length_se.expr;
! gfc_add_block_to_block (&loop->pre, &length_se.pre);
! gfc_add_block_to_block (&loop->post, &length_se.post);
}
else
! const_string = get_array_ctor_strlen (&loop->pre, c,
&ss_info->string_length);
/* Complex character array constructors should have been taken care of
--- 2182,2192 ----
gfc_conv_expr_type (&length_se, expr->ts.u.cl->length,
gfc_charlen_type_node);
ss_info->string_length = length_se.expr;
! gfc_add_block_to_block (&outer_loop->pre, &length_se.pre);
! gfc_add_block_to_block (&outer_loop->post, &length_se.post);
}
else
! const_string = get_array_ctor_strlen (&outer_loop->pre, c,
&ss_info->string_length);
/* Complex character array constructors should have been taken care of
*************** gfc_trans_array_constructor (gfc_loopinf
*** 2019,2044 ****
/* See if the constructor determines the loop bounds. */
dynamic = false;
! if (expr->shape && loop->dimen > 1 && loop->to[0] == NULL_TREE)
{
/* We have a multidimensional parameter. */
int n;
! for (n = 0; n < expr->rank; n++)
{
! loop->from[n] = gfc_index_zero_node;
! loop->to[n] = gfc_conv_mpz_to_tree (expr->shape [n],
gfc_index_integer_kind);
! loop->to[n] = fold_build2_loc (input_location, MINUS_EXPR,
gfc_array_index_type,
! loop->to[n], gfc_index_one_node);
}
}
! if (loop->to[0] == NULL_TREE)
{
mpz_t size;
/* We should have a 1-dimensional, zero-based loop. */
gcc_assert (loop->dimen == 1);
gcc_assert (integer_zerop (loop->from[0]));
--- 2205,2237 ----
/* See if the constructor determines the loop bounds. */
dynamic = false;
! loop_ubound0 = get_loop_upper_bound_for_array (ss, 0);
!
! if (expr->shape && get_rank (loop) > 1 && *loop_ubound0 == NULL_TREE)
{
/* We have a multidimensional parameter. */
+ for (s = ss; s; s = s->parent)
+ {
int n;
! for (n = 0; n < s->loop->dimen; n++)
{
! s->loop->from[n] = gfc_index_zero_node;
! s->loop->to[n] = gfc_conv_mpz_to_tree (expr->shape[s->dim[n]],
gfc_index_integer_kind);
! s->loop->to[n] = fold_build2_loc (input_location, MINUS_EXPR,
gfc_array_index_type,
! s->loop->to[n],
! gfc_index_one_node);
! }
}
}
! if (*loop_ubound0 == NULL_TREE)
{
mpz_t size;
/* We should have a 1-dimensional, zero-based loop. */
+ gcc_assert (loop->parent == NULL && loop->nested == NULL);
gcc_assert (loop->dimen == 1);
gcc_assert (integer_zerop (loop->from[0]));
*************** gfc_trans_array_constructor (gfc_loopinf
*** 2067,2084 ****
}
}
! if (TREE_CODE (loop->to[0]) == VAR_DECL)
dynamic = true;
! gfc_trans_create_temp_array (&loop->pre, &loop->post, loop, ss,
! type, NULL_TREE, dynamic, true, false, where);
desc = ss_info->data.array.descriptor;
offset = gfc_index_zero_node;
offsetvar = gfc_create_var_np (gfc_array_index_type, "offset");
TREE_NO_WARNING (offsetvar) = 1;
TREE_USED (offsetvar) = 0;
! gfc_trans_array_constructor_value (&loop->pre, type, desc, c,
&offset, &offsetvar, dynamic);
/* If the array grows dynamically, the upper bound of the loop variable
--- 2260,2277 ----
}
}
! if (TREE_CODE (*loop_ubound0) == VAR_DECL)
dynamic = true;
! gfc_trans_create_temp_array (&outer_loop->pre, &outer_loop->post, ss, type,
! NULL_TREE, dynamic, true, false, where);
desc = ss_info->data.array.descriptor;
offset = gfc_index_zero_node;
offsetvar = gfc_create_var_np (gfc_array_index_type, "offset");
TREE_NO_WARNING (offsetvar) = 1;
TREE_USED (offsetvar) = 0;
! gfc_trans_array_constructor_value (&outer_loop->pre, type, desc, c,
&offset, &offsetvar, dynamic);
/* If the array grows dynamically, the upper bound of the loop variable
*************** gfc_trans_array_constructor (gfc_loopinf
*** 2088,2099 ****
tmp = fold_build2_loc (input_location, MINUS_EXPR,
gfc_array_index_type,
offsetvar, gfc_index_one_node);
! tmp = gfc_evaluate_now (tmp, &loop->pre);
gfc_conv_descriptor_ubound_set (&loop->pre, desc, gfc_rank_cst[0], tmp);
! if (loop->to[0] && TREE_CODE (loop->to[0]) == VAR_DECL)
! gfc_add_modify (&loop->pre, loop->to[0], tmp);
else
! loop->to[0] = tmp;
}
if (TREE_USED (offsetvar))
--- 2281,2292 ----
tmp = fold_build2_loc (input_location, MINUS_EXPR,
gfc_array_index_type,
offsetvar, gfc_index_one_node);
! tmp = gfc_evaluate_now (tmp, &outer_loop->pre);
gfc_conv_descriptor_ubound_set (&loop->pre, desc, gfc_rank_cst[0], tmp);
! if (*loop_ubound0 && TREE_CODE (*loop_ubound0) == VAR_DECL)
! gfc_add_modify (&outer_loop->pre, *loop_ubound0, tmp);
else
! *loop_ubound0 = tmp;
}
if (TREE_USED (offsetvar))
*************** finish:
*** 2123,2130 ****
loop bounds. */
static void
! set_vector_loop_bounds (gfc_loopinfo * loop, gfc_ss * ss)
{
gfc_array_info *info;
gfc_se se;
tree tmp;
--- 2316,2324 ----
loop bounds. */
static void
! set_vector_loop_bounds (gfc_ss * ss)
{
+ gfc_loopinfo *loop, *outer_loop;
gfc_array_info *info;
gfc_se se;
tree tmp;
*************** set_vector_loop_bounds (gfc_loopinfo * l
*** 2133,2146 ****
int n;
int dim;
info = &ss->info->data.array;
for (n = 0; n < loop->dimen; n++)
{
dim = ss->dim[n];
! if (info->ref->u.ar.dimen_type[dim] == DIMEN_VECTOR
! && loop->to[n] == NULL)
! {
/* Loop variable N indexes vector dimension DIM, and we don't
yet know the upper bound of loop variable N. Set it to the
difference between the vector's upper and lower bounds. */
--- 2327,2347 ----
int n;
int dim;
+ outer_loop = outermost_loop (ss->loop);
+
info = &ss->info->data.array;
+ for (; ss; ss = ss->parent)
+ {
+ loop = ss->loop;
+
for (n = 0; n < loop->dimen; n++)
{
dim = ss->dim[n];
! if (info->ref->u.ar.dimen_type[dim] != DIMEN_VECTOR
! || loop->to[n] != NULL)
! continue;
!
/* Loop variable N indexes vector dimension DIM, and we don't
yet know the upper bound of loop variable N. Set it to the
difference between the vector's upper and lower bounds. */
*************** set_vector_loop_bounds (gfc_loopinfo * l
*** 2155,2161 ****
gfc_array_index_type,
gfc_conv_descriptor_ubound_get (desc, zero),
gfc_conv_descriptor_lbound_get (desc, zero));
! tmp = gfc_evaluate_now (tmp, &loop->pre);
loop->to[n] = tmp;
}
}
--- 2356,2362 ----
gfc_array_index_type,
gfc_conv_descriptor_ubound_get (desc, zero),
gfc_conv_descriptor_lbound_get (desc, zero));
! tmp = gfc_evaluate_now (tmp, &outer_loop->pre);
loop->to[n] = tmp;
}
}
*************** static void
*** 2170,2181 ****
--- 2371,2386 ----
gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript,
locus * where)
{
+ gfc_loopinfo *nested_loop, *outer_loop;
gfc_se se;
gfc_ss_info *ss_info;
gfc_array_info *info;
gfc_expr *expr;
+ bool skip_nested = false;
int n;
+ outer_loop = outermost_loop (loop);
+
/* TODO: This can generate bad code if there are ordering dependencies,
e.g., a callee allocated function and an unknown size constructor. */
gcc_assert (ss != NULL);
*************** gfc_add_loop_ss_code (gfc_loopinfo * loo
*** 2184,2189 ****
--- 2389,2398 ----
{
gcc_assert (ss);
+ /* Cross loop arrays are handled from within the most nested loop. */
+ if (ss->nested_ss != NULL)
+ continue;
+
ss_info = ss->info;
expr = ss_info->expr;
info = &ss_info->data.array;
*************** gfc_add_loop_ss_code (gfc_loopinfo * loo
*** 2195,2201 ****
dimension indices, but not array section bounds. */
gfc_init_se (&se, NULL);
gfc_conv_expr (&se, expr);
! gfc_add_block_to_block (&loop->pre, &se.pre);
if (expr->ts.type != BT_CHARACTER)
{
--- 2404,2410 ----
dimension indices, but not array section bounds. */
gfc_init_se (&se, NULL);
gfc_conv_expr (&se, expr);
! gfc_add_block_to_block (&outer_loop->pre, &se.pre);
if (expr->ts.type != BT_CHARACTER)
{
*************** gfc_add_loop_ss_code (gfc_loopinfo * loo
*** 2204,2214 ****
if (subscript)
se.expr = convert(gfc_array_index_type, se.expr);
if (!ss_info->where)
! se.expr = gfc_evaluate_now (se.expr, &loop->pre);
! gfc_add_block_to_block (&loop->pre, &se.post);
}
else
! gfc_add_block_to_block (&loop->post, &se.post);
ss_info->data.scalar.value = se.expr;
ss_info->string_length = se.string_length;
--- 2413,2423 ----
if (subscript)
se.expr = convert(gfc_array_index_type, se.expr);
if (!ss_info->where)
! se.expr = gfc_evaluate_now (se.expr, &outer_loop->pre);
! gfc_add_block_to_block (&outer_loop->pre, &se.post);
}
else
! gfc_add_block_to_block (&outer_loop->post, &se.post);
ss_info->data.scalar.value = se.expr;
ss_info->string_length = se.string_length;
*************** gfc_add_loop_ss_code (gfc_loopinfo * loo
*** 2219,2228 ****
now. */
gfc_init_se (&se, NULL);
gfc_conv_expr (&se, expr);
! gfc_add_block_to_block (&loop->pre, &se.pre);
! gfc_add_block_to_block (&loop->post, &se.post);
! ss_info->data.scalar.value = gfc_evaluate_now (se.expr, &loop->pre);
ss_info->string_length = se.string_length;
break;
--- 2428,2438 ----
now. */
gfc_init_se (&se, NULL);
gfc_conv_expr (&se, expr);
! gfc_add_block_to_block (&outer_loop->pre, &se.pre);
! gfc_add_block_to_block (&outer_loop->post, &se.post);
! ss_info->data.scalar.value = gfc_evaluate_now (se.expr,
! &outer_loop->pre);
ss_info->string_length = se.string_length;
break;
*************** gfc_add_loop_ss_code (gfc_loopinfo * loo
*** 2230,2246 ****
/* Add the expressions for scalar and vector subscripts. */
for (n = 0; n < GFC_MAX_DIMENSIONS; n++)
if (info->subscript[n])
gfc_add_loop_ss_code (loop, info->subscript[n], true, where);
! set_vector_loop_bounds (loop, ss);
break;
case GFC_SS_VECTOR:
/* Get the vector's descriptor and store it in SS. */
gfc_init_se (&se, NULL);
gfc_conv_expr_descriptor (&se, expr, gfc_walk_expr (expr));
! gfc_add_block_to_block (&loop->pre, &se.pre);
! gfc_add_block_to_block (&loop->post, &se.post);
info->descriptor = se.expr;
break;
--- 2440,2461 ----
/* Add the expressions for scalar and vector subscripts. */
for (n = 0; n < GFC_MAX_DIMENSIONS; n++)
if (info->subscript[n])
+ {
gfc_add_loop_ss_code (loop, info->subscript[n], true, where);
+ /* The recursive call will have taken care of the nested loops.
+ No need to do it twice. */
+ skip_nested = true;
+ }
! set_vector_loop_bounds (ss);
break;
case GFC_SS_VECTOR:
/* Get the vector's descriptor and store it in SS. */
gfc_init_se (&se, NULL);
gfc_conv_expr_descriptor (&se, expr, gfc_walk_expr (expr));
! gfc_add_block_to_block (&outer_loop->pre, &se.pre);
! gfc_add_block_to_block (&outer_loop->post, &se.post);
info->descriptor = se.expr;
break;
*************** gfc_add_loop_ss_code (gfc_loopinfo * loo
*** 2255,2262 ****
se.loop = loop;
se.ss = ss;
gfc_conv_expr (&se, expr);
! gfc_add_block_to_block (&loop->pre, &se.pre);
! gfc_add_block_to_block (&loop->post, &se.post);
ss_info->string_length = se.string_length;
break;
--- 2470,2477 ----
se.loop = loop;
se.ss = ss;
gfc_conv_expr (&se, expr);
! gfc_add_block_to_block (&outer_loop->pre, &se.pre);
! gfc_add_block_to_block (&outer_loop->post, &se.post);
ss_info->string_length = se.string_length;
break;
*************** gfc_add_loop_ss_code (gfc_loopinfo * loo
*** 2270,2279 ****
gfc_conv_expr_type (&se, expr->ts.u.cl->length,
gfc_charlen_type_node);
ss_info->string_length = se.expr;
! gfc_add_block_to_block (&loop->pre, &se.pre);
! gfc_add_block_to_block (&loop->post, &se.post);
}
! gfc_trans_array_constructor (loop, ss, where);
break;
case GFC_SS_TEMP:
--- 2485,2494 ----
gfc_conv_expr_type (&se, expr->ts.u.cl->length,
gfc_charlen_type_node);
ss_info->string_length = se.expr;
! gfc_add_block_to_block (&outer_loop->pre, &se.pre);
! gfc_add_block_to_block (&outer_loop->post, &se.post);
}
! trans_array_constructor (ss, where);
break;
case GFC_SS_TEMP:
*************** gfc_add_loop_ss_code (gfc_loopinfo * loo
*** 2285,2290 ****
--- 2500,2510 ----
gcc_unreachable ();
}
}
+
+ if (!skip_nested)
+ for (nested_loop = loop->nested; nested_loop;
+ nested_loop = nested_loop->next)
+ gfc_add_loop_ss_code (nested_loop, nested_loop->ss, subscript, where);
}
*************** gfc_trans_preloop_setup (gfc_loopinfo *
*** 2896,2902 ****
gfc_ss_info *ss_info;
gfc_array_info *info;
gfc_ss_type ss_type;
! gfc_ss *ss;
gfc_array_ref *ar;
int i;
--- 3116,3123 ----
gfc_ss_info *ss_info;
gfc_array_info *info;
gfc_ss_type ss_type;
! gfc_ss *ss, *pss;
! gfc_loopinfo *ploop;
gfc_array_ref *ar;
int i;
*************** gfc_trans_preloop_setup (gfc_loopinfo *
*** 2926,2943 ****
else
ar = NULL;
if (dim == loop->dimen - 1)
i = 0;
else
i = dim + 1;
/* For the time being, there is no loop reordering. */
! gcc_assert (i == loop->order[i]);
! i = loop->order[i];
! if (dim == loop->dimen - 1)
{
! stride = gfc_conv_array_stride (info->descriptor, ss->dim[i]);
/* Calculate the stride of the innermost loop. Hopefully this will
allow the backend optimizers to do their stuff more effectively.
--- 3147,3183 ----
else
ar = NULL;
+ if (dim == loop->dimen - 1 && loop->parent != NULL)
+ {
+ /* If we are in the outermost dimension of this loop, the previous
+ dimension shall be in the parent loop. */
+ gcc_assert (ss->parent != NULL);
+
+ pss = ss->parent;
+ ploop = loop->parent;
+
+ /* ss and ss->parent are about the same array. */
+ gcc_assert (ss_info == pss->info);
+ }
+ else
+ {
+ ploop = loop;
+ pss = ss;
+ }
+
if (dim == loop->dimen - 1)
i = 0;
else
i = dim + 1;
/* For the time being, there is no loop reordering. */
! gcc_assert (i == ploop->order[i]);
! i = ploop->order[i];
! if (dim == loop->dimen - 1 && loop->parent == NULL)
{
! stride = gfc_conv_array_stride (info->descriptor,
! innermost_ss (ss)->dim[i]);
/* Calculate the stride of the innermost loop. Hopefully this will
allow the backend optimizers to do their stuff more effectively.
*************** gfc_trans_preloop_setup (gfc_loopinfo *
*** 2960,2969 ****
}
else
/* Add the offset for the previous loop dimension. */
! add_array_offset (pblock, loop, ss, ar, ss->dim[i], i);
/* Remember this offset for the second loop. */
! if (dim == loop->temp_dim - 1)
info->saved_offset = info->offset;
}
}
--- 3200,3209 ----
}
else
/* Add the offset for the previous loop dimension. */
! add_array_offset (pblock, ploop, ss, ar, pss->dim[i], i);
/* Remember this offset for the second loop. */
! if (dim == loop->temp_dim - 1 && loop->parent == NULL)
info->saved_offset = info->offset;
}
}
*************** gfc_trans_scalarizing_loops (gfc_loopinf
*** 3148,3153 ****
--- 3388,3394 ----
/* Clear all the used flags. */
for (ss = loop->ss; ss != gfc_ss_terminator; ss = ss->loop_chain)
+ if (ss->parent == NULL)
ss->info->useflags = 0;
}
*************** done:
*** 3369,3375 ****
switch (ss_info->type)
{
case GFC_SS_SECTION:
! /* Get the descriptor for the array. */
gfc_conv_ss_descriptor (&loop->pre, ss, !loop->array_parameter);
for (n = 0; n < ss->dimen; n++)
--- 3610,3618 ----
switch (ss_info->type)
{
case GFC_SS_SECTION:
! /* Get the descriptor for the array. If it is a cross loops array,
! we got the descriptor already in the outermost loop. */
! if (ss->parent == NULL)
gfc_conv_ss_descriptor (&loop->pre, ss, !loop->array_parameter);
for (n = 0; n < ss->dimen; n++)
*************** done:
*** 3659,3664 ****
--- 3902,3910 ----
tmp = gfc_finish_block (&block);
gfc_add_expr_to_block (&loop->pre, tmp);
}
+
+ for (loop = loop->nested; loop; loop = loop->next)
+ gfc_conv_ss_startstride (loop);
}
/* Return true if both symbols could refer to the same data object. Does
*************** temporary:
*** 3919,3943 ****
}
! /* Initialize the scalarization loop. Creates the loop variables. Determines
! the range of the loop variables. Creates a temporary if required.
! Calculates how to transform from loop variables to array indices for each
! expression. Also generates code for scalar expressions which have been
! moved outside the loop. */
! void
! gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where)
{
int n, dim, spec_dim;
gfc_array_info *info;
gfc_array_info *specinfo;
! gfc_ss *ss, *tmp_ss;
tree tmp;
! gfc_ss *loopspec[GFC_MAX_DIMENSIONS];
bool dynamic[GFC_MAX_DIMENSIONS];
mpz_t *cshape;
mpz_t i;
mpz_init (i);
for (n = 0; n < loop->dimen; n++)
{
--- 4165,4189 ----
}
! /* Browse through each array's information from the scalarizer and set the loop
! bounds according to the "best" one (per dimension), i.e. the one which
! provides the most information (constant bounds, shape, etc). */
! static void
! set_loop_bounds (gfc_loopinfo *loop)
{
int n, dim, spec_dim;
gfc_array_info *info;
gfc_array_info *specinfo;
! gfc_ss *ss;
tree tmp;
! gfc_ss **loopspec;
bool dynamic[GFC_MAX_DIMENSIONS];
mpz_t *cshape;
mpz_t i;
+ loopspec = loop->specloop;
+
mpz_init (i);
for (n = 0; n < loop->dimen; n++)
{
*************** gfc_conv_loop_setup (gfc_loopinfo * loop
*** 4057,4063 ****
&& INTEGER_CST_P (info->stride[dim]))
{
loop->from[n] = info->start[dim];
! mpz_set (i, cshape[get_array_ref_dim (loopspec[n], n)]);
mpz_sub_ui (i, i, 1);
/* To = from + (size - 1) * stride. */
tmp = gfc_conv_mpz_to_tree (i, gfc_index_integer_kind);
--- 4303,4309 ----
&& INTEGER_CST_P (info->stride[dim]))
{
loop->from[n] = info->start[dim];
! mpz_set (i, cshape[get_array_ref_dim_for_loop_dim (loopspec[n], n)]);
mpz_sub_ui (i, i, 1);
/* To = from + (size - 1) * stride. */
tmp = gfc_conv_mpz_to_tree (i, gfc_index_integer_kind);
*************** gfc_conv_loop_setup (gfc_loopinfo * loop
*** 4119,4124 ****
--- 4365,4392 ----
loop->from[n] = gfc_index_zero_node;
}
}
+ mpz_clear (i);
+
+ for (loop = loop->nested; loop; loop = loop->next)
+ set_loop_bounds (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
+ moved outside the loop. */
+
+ void
+ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where)
+ {
+ gfc_ss *tmp_ss;
+ tree tmp;
+
+ set_loop_bounds (loop);
/* Add all the scalar code that can be taken out of the loops.
This may include calculating the loop bounds, so do it before
*************** gfc_conv_loop_setup (gfc_loopinfo * loop
*** 4133,4138 ****
--- 4401,4407 ----
tmp_ss_info = tmp_ss->info;
gcc_assert (tmp_ss_info->type == GFC_SS_TEMP);
+ gcc_assert (loop->parent == NULL);
/* Make absolutely sure that this is a complete type. */
if (tmp_ss_info->string_length)
*************** gfc_conv_loop_setup (gfc_loopinfo * loop
*** 4147,4167 ****
gcc_assert (tmp_ss->dimen != 0);
! gfc_trans_create_temp_array (&loop->pre, &loop->post, loop,
! tmp_ss, tmp, NULL_TREE,
! false, true, false, where);
}
- for (n = 0; n < loop->temp_dim; n++)
- loopspec[loop->order[n]] = NULL;
-
- mpz_clear (i);
-
/* For array parameters we don't have loop variables, so don't calculate the
translations. */
if (loop->array_parameter)
return;
/* Calculate the translation from loop variables to array indices. */
for (ss = loop->ss; ss != gfc_ss_terminator; ss = ss->loop_chain)
{
--- 4416,4448 ----
gcc_assert (tmp_ss->dimen != 0);
! gfc_trans_create_temp_array (&loop->pre, &loop->post, tmp_ss, tmp,
! NULL_TREE, false, true, false, where);
}
/* For array parameters we don't have loop variables, so don't calculate the
translations. */
if (loop->array_parameter)
return;
+ set_delta (loop);
+ }
+
+
+ /* Calculates how to transform from loop variables to array indices for each
+ 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)
+ {
+ gfc_ss *ss, **loopspec;
+ gfc_array_info *info;
+ tree tmp;
+ int n, dim;
+
+ loopspec = loop->specloop;
+
/* Calculate the translation from loop variables to array indices. */
for (ss = loop->ss; ss != gfc_ss_terminator; ss = ss->loop_chain)
{
*************** gfc_conv_loop_setup (gfc_loopinfo * loop
*** 4199,4204 ****
--- 4480,4488 ----
}
}
}
+
+ for (loop = loop->nested; loop; loop = loop->next)
+ set_delta (loop);
}
diff --git a/trans-array.h b/trans-array.h
index 57805b6ac5cfb0dd06cdd029c2fcc2f0989ebfc7..aad8c47b6f13ea6ba5ab17c677d44e26ce0aee60 100644
*** a/trans-array.h
--- b/trans-array.h
*************** void gfc_set_loop_bounds_from_array_spec
*** 31,39 ****
gfc_se *, gfc_array_spec *);
/* Generate code to create a temporary array. */
! tree gfc_trans_create_temp_array (stmtblock_t *, stmtblock_t *, gfc_loopinfo *,
! gfc_ss *, tree, tree, bool, bool, bool,
! locus *);
/* Generate function entry code for allocation of compiler allocated array
variables. */
--- 31,38 ----
gfc_se *, gfc_array_spec *);
/* Generate code to create a temporary array. */
! tree gfc_trans_create_temp_array (stmtblock_t *, stmtblock_t *, gfc_ss *,
! tree, tree, bool, bool, bool, locus *);
/* Generate function entry code for allocation of compiler allocated array
variables. */
diff --git a/trans-expr.c b/trans-expr.c
index 01d4ca3885fece6c4840c7d59861967ffe979e0c..4cfdc3e09067a5d0ee715db0e5b87f6efed791c1 100644
*** a/trans-expr.c
--- b/trans-expr.c
*************** void
*** 83,88 ****
--- 83,89 ----
gfc_advance_se_ss_chain (gfc_se * se)
{
gfc_se *p;
+ gfc_ss *ss;
gcc_assert (se != NULL && se->ss != NULL && se->ss != gfc_ss_terminator);
*************** gfc_advance_se_ss_chain (gfc_se * se)
*** 91,99 ****
while (p != NULL)
{
/* Simple consistency check. */
! gcc_assert (p->parent == NULL || p->parent->ss == p->ss);
! p->ss = p->ss->next;
p = p->parent;
}
--- 92,109 ----
while (p != NULL)
{
/* Simple consistency check. */
! gcc_assert (p->parent == NULL || p->parent->ss == p->ss
! || p->parent->ss->nested_ss == p->ss);
!
! /* If we were in a nested loop, the next scalarized expression can be
! on the parent ss' next pointer. Thus we should not take the next
! pointer blindly, but rather go up one nest level as long as next
! is the end of chain. */
! ss = p->ss;
! while (ss->next == gfc_ss_terminator && ss->parent != NULL)
! ss = ss->parent;
! p->ss = ss->next;
p = p->parent;
}
*************** gfc_conv_procedure_call (gfc_se * se, gf
*** 3606,3612 ****
returns a pointer, the temporary will be a shallow copy and
mustn't be deallocated. */
callee_alloc = comp->attr.allocatable || comp->attr.pointer;
! gfc_trans_create_temp_array (&se->pre, &se->post, se->loop, se->ss,
tmp, NULL_TREE, false,
!comp->attr.pointer, callee_alloc,
&se->ss->info->expr->where);
--- 3616,3622 ----
returns a pointer, the temporary will be a shallow copy and
mustn't be deallocated. */
callee_alloc = comp->attr.allocatable || comp->attr.pointer;
! gfc_trans_create_temp_array (&se->pre, &se->post, se->ss,
tmp, NULL_TREE, false,
!comp->attr.pointer, callee_alloc,
&se->ss->info->expr->where);
*************** gfc_conv_procedure_call (gfc_se * se, gf
*** 3642,3648 ****
returns a pointer, the temporary will be a shallow copy and
mustn't be deallocated. */
callee_alloc = sym->attr.allocatable || sym->attr.pointer;
! gfc_trans_create_temp_array (&se->pre, &se->post, se->loop, se->ss,
tmp, NULL_TREE, false,
!sym->attr.pointer, callee_alloc,
&se->ss->info->expr->where);
--- 3652,3658 ----
returns a pointer, the temporary will be a shallow copy and
mustn't be deallocated. */
callee_alloc = sym->attr.allocatable || sym->attr.pointer;
! gfc_trans_create_temp_array (&se->pre, &se->post, se->ss,
tmp, NULL_TREE, false,
!sym->attr.pointer, callee_alloc,
&se->ss->info->expr->where);
diff --git a/trans-intrinsic.c b/trans-intrinsic.c
index fcc59d7086a684b66b9a3f19351e70c33b8c2dba..c3a414b789b1ffa9b65c4af99b734af11e88f67e 100644
*** a/trans-intrinsic.c
--- b/trans-intrinsic.c
*************** gfc_conv_intrinsic_transfer (gfc_se * se
*** 5501,5509 ****
/* Build a destination descriptor, using the pointer, source, as the
data field. */
! gfc_trans_create_temp_array (&se->pre, &se->post, se->loop,
! se->ss, mold_type, NULL_TREE, false, true, false,
! &expr->where);
/* Cast the pointer to the result. */
tmp = gfc_conv_descriptor_data_get (info->descriptor);
--- 5501,5508 ----
/* Build a destination descriptor, using the pointer, source, as the
data field. */
! gfc_trans_create_temp_array (&se->pre, &se->post, se->ss, mold_type,
! NULL_TREE, false, true, false, &expr->where);
/* Cast the pointer to the result. */
tmp = gfc_conv_descriptor_data_get (info->descriptor);
diff --git a/trans-stmt.c b/trans-stmt.c
index 86a56e8c19a40cae900b6f5d72cb3c0e6270e740..2e023207e0eede6cdcc0239c072dce85b9d5218a 100644
*** a/trans-stmt.c
--- b/trans-stmt.c
*************** gfc_conv_elemental_dependencies (gfc_se
*** 309,319 ****
size = gfc_create_var (gfc_array_index_type, NULL);
data = gfc_create_var (pvoid_type_node, NULL);
gfc_init_block (&temp_post);
! tmp = gfc_trans_create_temp_array (&se->pre, &temp_post,
! &tmp_loop, ss, temptype,
! initial,
! false, true, false,
! &arg->expr->where);
gfc_add_modify (&se->pre, size, tmp);
tmp = fold_convert (pvoid_type_node, info->data);
gfc_add_modify (&se->pre, data, tmp);
--- 309,318 ----
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,
! temptype, initial, false, true,
! false, &arg->expr->where);
gfc_add_modify (&se->pre, size, tmp);
tmp = fold_convert (pvoid_type_node, info->data);
gfc_add_modify (&se->pre, data, tmp);
diff --git a/trans.h b/trans.h
index c35b1ae0fdacbb3812588188f118dd760922cc3f..4d745f144ceb205db9c6aec76ad08c815a654e23 100644
*** a/trans.h
--- b/trans.h
*************** gfc_ss_type;
*** 185,190 ****
--- 185,191 ----
typedef struct gfc_ss_info
{
+ int refcount;
gfc_ss_type type;
gfc_expr *expr;
tree string_length;
*************** typedef struct gfc_ss
*** 245,250 ****
--- 246,262 ----
struct gfc_ss *loop_chain;
struct gfc_ss *next;
+ /* Non-null if the ss is part of a nested loop. */
+ struct gfc_ss *parent;
+
+ /* If the evaluation of an expression requires a nested loop (for example
+ if the sum intrinsic is evaluated inline), this points to the nested
+ loop's gfc_ss. */
+ struct gfc_ss *nested_ss;
+
+ /* The loop this gfc_ss is in. */
+ struct gfc_loopinfo *loop;
+
unsigned is_alloc_lhs:1;
}
gfc_ss;
*************** typedef struct gfc_loopinfo
*** 267,272 ****
--- 279,290 ----
/* The SS describing the temporary used in an assignment. */
gfc_ss *temp_ss;
+ /* Non-null if this loop is nested in another one. */
+ struct gfc_loopinfo *parent;
+
+ /* Chain of nested loops. */
+ struct gfc_loopinfo *nested, *next;
+
/* The scalarization loop index variables. */
tree loopvar[GFC_MAX_DIMENSIONS];
- Follow-Ups:
- [Patch, fortran] [31/66] inline sum and product: Update the scalarizer: Split gfc_conv_loop_setup.
- [Patch, fortran] [32/66] inline sum and product: Update the scalarizer: clear specloop in gfc_trans_create_temp_arrays.
- [Patch, fortran] [33/66] inline sum and product: Update the scalarizer.
- [Patch, fortran] [34/66] inline sum and product: Update the scalarizer: gfc_ss_info refcounting
- [Patch, fortran] [35..39/66] inline sum and product: Update the scalarizer: New gfc_ss::loop field.
- [Patch, fortran] [40..43/66] inline sum and product: Update the scalarizer: New gfc_ss::parent field.
- [Patch, fortran] [44/66] inline sum and product: Update the scalarizer: New gfc_ss::nested_ss field.
- [Patch, fortran] [45/66] inline sum and product: Update the scalarizer: Update dimension mapping inversion functions.
- [Patch, fortran] [46/66] inline sum and product: Update the scalarizer: Update gfc_trans_create_temp_array.
- [Patch, fortran] [47..48/66] inline sum and product: Update the scalarizer: New gfc_loopinfo::nested_loop field.
- [Patch, fortran] [49..51/66] inline sum and product: Update the scalarizer: New parent loop.
- [Patch, fortran] [52/66] inline sum and product: Update the scalarizer: New outermost_loop function.
- [Patch, fortran] [53/66] inline sum and product: Update the scalarizer: Update gfc_trans_preloop_setup.