*************** gfc_free_ss_chain (gfc_ss * ss)
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
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_
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
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
void
gfc_cleanup_loop (gfc_loopinfo * loop)
{
+ gfc_loopinfo *loop_next, **ploop;
gfc_ss *ss;
gfc_ss *next;
*************** gfc_cleanup_loop (gfc_loopinfo * loop)
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
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
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]);
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
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;
}
}
}
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
}
! /* 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++;
}
! /* 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_
}
+ 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_
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;
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
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
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])
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
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];
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
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;
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
/* 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)
/* 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
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
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
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;
}
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
}
}
/* 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. */
}
}
+
+ 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
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,
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
}
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;
}
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
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
first_len = true;
}
! gcc_assert (ss->dimen == loop->dimen);
c = expr->value.constructor;
if (expr->ts.type == BT_CHARACTER)
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
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
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
/* 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]));
/* 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
}
}
! 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
}
}
! 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
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))
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:
loop bounds. */
static void
! set_vector_loop_bounds (gfc_loopinfo * loop, gfc_ss * ss)
{
gfc_array_info *info;
gfc_se se;
tree tmp;
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
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. */
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
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;
}
}
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
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
{
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
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)
{
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
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;
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
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;
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
/* 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;
/* 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
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;
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
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:
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
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 *
gfc_ss_info *ss_info;
gfc_array_info *info;
gfc_ss_type ss_type;
! gfc_ss *ss;
gfc_array_ref *ar;
int i;
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 *
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.
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 *
}
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;
}
}
}
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
/* 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:
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++)
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:
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:
}
! /* 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++)
{
}
! /* 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
&& 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);
&& 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
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
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
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)
{
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
}
}
}
+
+ for (loop = loop->nested; loop; loop = loop->next)
+ set_delta (loop);
}
*************** void gfc_set_loop_bounds_from_array_spec
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. */
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. */
*************** void
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)
while (p != NULL)
{
/* Simple consistency check. */
! gcc_assert (p->parent == NULL || p->parent->ss == p->ss);
! p->ss = p->ss->next;
p = p->parent;
}
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
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);
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
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);
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);
*************** gfc_conv_intrinsic_transfer (gfc_se * se
/* 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);
/* 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);
*************** gfc_conv_elemental_dependencies (gfc_se
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);
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);
*************** gfc_ss_type;
typedef struct gfc_ss_info
{
+ int refcount;
gfc_ss_type type;
gfc_expr *expr;
tree string_length;
*************** typedef struct gfc_ss
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
/* 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];