void
gfc_cleanup_loop (gfc_loopinfo * loop)
{
+ gfc_loopinfo *loop_next, **ploop;
gfc_ss *ss;
gfc_ss *next;
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);
+ }
}
gfc_add_ss_to_loop (gfc_loopinfo * loop, gfc_ss * head)
{
gfc_ss *ss;
+ gfc_loopinfo *nested_loop;
if (head == gfc_ss_terminator)
return;
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
}
-/* 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.
- */
+/* 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_array_ref_dim (gfc_ss *ss, int loop_dim)
+get_scalarizer_dim_for_array_dim (gfc_ss *ss, int array_dim)
{
- int n, array_dim, array_ref_dim;
+ int array_ref_dim;
+ int n;
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++;
+ for (; ss; ss = ss->parent)
+ for (n = 0; n < ss->dimen; n++)
+ if (ss->dim[n] < array_dim)
+ array_ref_dim++;
return array_ref_dim;
}
+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
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;
if (gfc_option.warn_array_temp && where)
gfc_warning ("Creating array temporary at %L", where);
- loop = ss->loop;
- total_dim = loop->dimen;
/* Set the lower bound to zero. */
- for (n = 0; n < loop->dimen; n++)
+ for (s = ss; s; s = s->parent)
{
- dim = ss->dim[n];
+ loop = s->loop;
- /* Callee allocated arrays may not have a known bound yet. */
- if (loop->to[n])
- loop->to[n] = gfc_evaluate_now (
+ 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])
+ loop->to[n] = gfc_evaluate_now (
fold_build2_loc (input_location, MINUS_EXPR,
gfc_array_index_type,
loop->to[n], loop->from[n]),
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_array_ref_dim (ss, n);
- from[tmp_dim] = loop->from[n];
- to[tmp_dim] = loop->to[n];
-
- info->delta[dim] = gfc_index_zero_node;
- info->start[dim] = gfc_index_zero_node;
- info->end[dim] = gfc_index_zero_node;
- info->stride[dim] = gfc_index_one_node;
+ 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];
+
+ info->delta[dim] = gfc_index_zero_node;
+ info->start[dim] = gfc_index_zero_node;
+ info->end[dim] = gfc_index_zero_node;
+ info->stride[dim] = gfc_index_one_node;
+ }
}
/* Initialize the descriptor. */
}
if (size == NULL_TREE)
- {
- for (n = 0; n < loop->dimen; n++)
+ for (s = ss; s; s = s->parent)
+ for (n = 0; n < s->loop->dimen; n++)
{
- dim = ss->dim[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. */
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;
+ s->loop->to[n] = tmp;
}
- }
else
{
for (n = 0; n < total_dim; n++)
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;
}
}
+
+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
}
+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 ();
+}
+
+
/* 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. */
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;
gfc_ss_info *ss_info;
gfc_expr *expr;
+ gfc_ss *s;
/* Save the old values for nested checking. */
old_first_len = first_len;
first_len = true;
}
- gcc_assert (ss->dimen == loop->dimen);
+ gcc_assert (ss->dimen == ss->loop->dimen);
c = expr->value.constructor;
if (expr->ts.type == BT_CHARACTER)
/* See if the constructor determines the loop bounds. */
dynamic = false;
- if (expr->shape && loop->dimen > 1 && loop->to[0] == NULL_TREE)
+ 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. */
- 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);
- }
+ 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->to[0] == NULL_TREE)
+ 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]));
}
}
- if (TREE_CODE (loop->to[0]) == VAR_DECL)
+ if (TREE_CODE (*loop_ubound0) == VAR_DECL)
dynamic = true;
gfc_trans_create_temp_array (&loop->pre, &loop->post, ss, type, NULL_TREE,
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);
+ if (*loop_ubound0 && TREE_CODE (*loop_ubound0) == VAR_DECL)
+ gfc_add_modify (&loop->pre, *loop_ubound0, tmp);
else
- loop->to[0] = tmp;
+ *loop_ubound0 = tmp;
}
if (TREE_USED (offsetvar))
int dim;
info = &ss->info->data.array;
- loop = ss->loop;
- for (n = 0; n < loop->dimen; n++)
+ for (; ss; ss = ss->parent)
{
- dim = ss->dim[n];
- if (info->ref->u.ar.dimen_type[dim] == DIMEN_VECTOR
- && loop->to[n] == NULL)
+ 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. */
gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript,
locus * where)
{
+ gfc_loopinfo *nested_loop;
gfc_se se;
gfc_ss_info *ss_info;
gfc_array_info *info;
gfc_expr *expr;
+ bool skip_nested = false;
int n;
/* TODO: This can generate bad code if there are ordering dependencies,
{
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;
/* 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);
+ {
+ 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;
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);
}
switch (ss_info->type)
{
case GFC_SS_SECTION:
- /* Get the descriptor for the array. */
- gfc_conv_ss_descriptor (&loop->pre, ss, !loop->array_parameter);
+ /* 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++)
gfc_conv_section_startstride (loop, ss, ss->dim[n]);
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
&& INTEGER_CST_P (info->stride[dim]))
{
loop->from[n] = info->start[dim];
- mpz_set (i, cshape[get_array_ref_dim (loopspec[n], n)]);
+ 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);
}
}
mpz_clear (i);
+
+ for (loop = loop->nested; loop; loop = loop->next)
+ set_loop_bounds (loop);
}
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)
}
}
}
+
+ for (loop = loop->nested; loop; loop = loop->next)
+ set_delta (loop);
}
OSDN Git Service
