trans-array.c (outermost_loop): New function.
* trans-array.c (outermost_loop): New function. (gfc_trans_array_constructor, gfc_set_vector_loop_bounds, gfc_add_loop_ss_code): Put generated code out of the outermost loop. From-SVN: r180902
This commit is contained in:
parent
f03077b019
commit
d769d0df73
|
@ -1,3 +1,9 @@
|
||||||
|
2011-11-03 Mikael Morin <mikael@gcc.gnu.org>
|
||||||
|
|
||||||
|
* trans-array.c (outermost_loop): New function.
|
||||||
|
(gfc_trans_array_constructor, gfc_set_vector_loop_bounds,
|
||||||
|
gfc_add_loop_ss_code): Put generated code out of the outermost loop.
|
||||||
|
|
||||||
2011-11-03 Mikael Morin <mikael@gcc.gnu.org>
|
2011-11-03 Mikael Morin <mikael@gcc.gnu.org>
|
||||||
|
|
||||||
* trans-array.c (constant_array_constructor_loop_size):
|
* trans-array.c (constant_array_constructor_loop_size):
|
||||||
|
|
|
@ -2108,6 +2108,16 @@ get_loop_upper_bound_for_array (gfc_ss *array, int array_dim)
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
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
|
/* Array constructors are handled by constructing a temporary, then using that
|
||||||
within the scalarization loop. This is not optimal, but seems by far the
|
within the scalarization loop. This is not optimal, but seems by far the
|
||||||
simplest method. */
|
simplest method. */
|
||||||
|
@ -2125,7 +2135,7 @@ trans_array_constructor (gfc_ss * ss, locus * where)
|
||||||
bool dynamic;
|
bool dynamic;
|
||||||
bool old_first_len, old_typespec_chararray_ctor;
|
bool old_first_len, old_typespec_chararray_ctor;
|
||||||
tree old_first_len_val;
|
tree old_first_len_val;
|
||||||
gfc_loopinfo *loop;
|
gfc_loopinfo *loop, *outer_loop;
|
||||||
gfc_ss_info *ss_info;
|
gfc_ss_info *ss_info;
|
||||||
gfc_expr *expr;
|
gfc_expr *expr;
|
||||||
gfc_ss *s;
|
gfc_ss *s;
|
||||||
|
@ -2136,6 +2146,7 @@ trans_array_constructor (gfc_ss * ss, locus * where)
|
||||||
old_typespec_chararray_ctor = typespec_chararray_ctor;
|
old_typespec_chararray_ctor = typespec_chararray_ctor;
|
||||||
|
|
||||||
loop = ss->loop;
|
loop = ss->loop;
|
||||||
|
outer_loop = outermost_loop (loop);
|
||||||
ss_info = ss->info;
|
ss_info = ss->info;
|
||||||
expr = ss_info->expr;
|
expr = ss_info->expr;
|
||||||
|
|
||||||
|
@ -2171,11 +2182,11 @@ trans_array_constructor (gfc_ss * ss, locus * where)
|
||||||
gfc_conv_expr_type (&length_se, expr->ts.u.cl->length,
|
gfc_conv_expr_type (&length_se, expr->ts.u.cl->length,
|
||||||
gfc_charlen_type_node);
|
gfc_charlen_type_node);
|
||||||
ss_info->string_length = length_se.expr;
|
ss_info->string_length = length_se.expr;
|
||||||
gfc_add_block_to_block (&loop->pre, &length_se.pre);
|
gfc_add_block_to_block (&outer_loop->pre, &length_se.pre);
|
||||||
gfc_add_block_to_block (&loop->post, &length_se.post);
|
gfc_add_block_to_block (&outer_loop->post, &length_se.post);
|
||||||
}
|
}
|
||||||
else
|
else
|
||||||
const_string = get_array_ctor_strlen (&loop->pre, c,
|
const_string = get_array_ctor_strlen (&outer_loop->pre, c,
|
||||||
&ss_info->string_length);
|
&ss_info->string_length);
|
||||||
|
|
||||||
/* Complex character array constructors should have been taken care of
|
/* Complex character array constructors should have been taken care of
|
||||||
|
@ -2252,15 +2263,15 @@ trans_array_constructor (gfc_ss * ss, locus * where)
|
||||||
if (TREE_CODE (*loop_ubound0) == VAR_DECL)
|
if (TREE_CODE (*loop_ubound0) == VAR_DECL)
|
||||||
dynamic = true;
|
dynamic = true;
|
||||||
|
|
||||||
gfc_trans_create_temp_array (&loop->pre, &loop->post, ss, type, NULL_TREE,
|
gfc_trans_create_temp_array (&outer_loop->pre, &outer_loop->post, ss, type,
|
||||||
dynamic, true, false, where);
|
NULL_TREE, dynamic, true, false, where);
|
||||||
|
|
||||||
desc = ss_info->data.array.descriptor;
|
desc = ss_info->data.array.descriptor;
|
||||||
offset = gfc_index_zero_node;
|
offset = gfc_index_zero_node;
|
||||||
offsetvar = gfc_create_var_np (gfc_array_index_type, "offset");
|
offsetvar = gfc_create_var_np (gfc_array_index_type, "offset");
|
||||||
TREE_NO_WARNING (offsetvar) = 1;
|
TREE_NO_WARNING (offsetvar) = 1;
|
||||||
TREE_USED (offsetvar) = 0;
|
TREE_USED (offsetvar) = 0;
|
||||||
gfc_trans_array_constructor_value (&loop->pre, type, desc, c,
|
gfc_trans_array_constructor_value (&outer_loop->pre, type, desc, c,
|
||||||
&offset, &offsetvar, dynamic);
|
&offset, &offsetvar, dynamic);
|
||||||
|
|
||||||
/* If the array grows dynamically, the upper bound of the loop variable
|
/* If the array grows dynamically, the upper bound of the loop variable
|
||||||
|
@ -2270,10 +2281,10 @@ trans_array_constructor (gfc_ss * ss, locus * where)
|
||||||
tmp = fold_build2_loc (input_location, MINUS_EXPR,
|
tmp = fold_build2_loc (input_location, MINUS_EXPR,
|
||||||
gfc_array_index_type,
|
gfc_array_index_type,
|
||||||
offsetvar, gfc_index_one_node);
|
offsetvar, gfc_index_one_node);
|
||||||
tmp = gfc_evaluate_now (tmp, &loop->pre);
|
tmp = gfc_evaluate_now (tmp, &outer_loop->pre);
|
||||||
gfc_conv_descriptor_ubound_set (&loop->pre, desc, gfc_rank_cst[0], tmp);
|
gfc_conv_descriptor_ubound_set (&loop->pre, desc, gfc_rank_cst[0], tmp);
|
||||||
if (*loop_ubound0 && TREE_CODE (*loop_ubound0) == VAR_DECL)
|
if (*loop_ubound0 && TREE_CODE (*loop_ubound0) == VAR_DECL)
|
||||||
gfc_add_modify (&loop->pre, *loop_ubound0, tmp);
|
gfc_add_modify (&outer_loop->pre, *loop_ubound0, tmp);
|
||||||
else
|
else
|
||||||
*loop_ubound0 = tmp;
|
*loop_ubound0 = tmp;
|
||||||
}
|
}
|
||||||
|
@ -2307,7 +2318,7 @@ finish:
|
||||||
static void
|
static void
|
||||||
set_vector_loop_bounds (gfc_ss * ss)
|
set_vector_loop_bounds (gfc_ss * ss)
|
||||||
{
|
{
|
||||||
gfc_loopinfo *loop;
|
gfc_loopinfo *loop, *outer_loop;
|
||||||
gfc_array_info *info;
|
gfc_array_info *info;
|
||||||
gfc_se se;
|
gfc_se se;
|
||||||
tree tmp;
|
tree tmp;
|
||||||
|
@ -2316,6 +2327,8 @@ set_vector_loop_bounds (gfc_ss * ss)
|
||||||
int n;
|
int n;
|
||||||
int dim;
|
int dim;
|
||||||
|
|
||||||
|
outer_loop = outermost_loop (ss->loop);
|
||||||
|
|
||||||
info = &ss->info->data.array;
|
info = &ss->info->data.array;
|
||||||
|
|
||||||
for (; ss; ss = ss->parent)
|
for (; ss; ss = ss->parent)
|
||||||
|
@ -2343,7 +2356,7 @@ set_vector_loop_bounds (gfc_ss * ss)
|
||||||
gfc_array_index_type,
|
gfc_array_index_type,
|
||||||
gfc_conv_descriptor_ubound_get (desc, zero),
|
gfc_conv_descriptor_ubound_get (desc, zero),
|
||||||
gfc_conv_descriptor_lbound_get (desc, zero));
|
gfc_conv_descriptor_lbound_get (desc, zero));
|
||||||
tmp = gfc_evaluate_now (tmp, &loop->pre);
|
tmp = gfc_evaluate_now (tmp, &outer_loop->pre);
|
||||||
loop->to[n] = tmp;
|
loop->to[n] = tmp;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
@ -2358,7 +2371,7 @@ static void
|
||||||
gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript,
|
gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript,
|
||||||
locus * where)
|
locus * where)
|
||||||
{
|
{
|
||||||
gfc_loopinfo *nested_loop;
|
gfc_loopinfo *nested_loop, *outer_loop;
|
||||||
gfc_se se;
|
gfc_se se;
|
||||||
gfc_ss_info *ss_info;
|
gfc_ss_info *ss_info;
|
||||||
gfc_array_info *info;
|
gfc_array_info *info;
|
||||||
|
@ -2366,6 +2379,8 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript,
|
||||||
bool skip_nested = false;
|
bool skip_nested = false;
|
||||||
int n;
|
int n;
|
||||||
|
|
||||||
|
outer_loop = outermost_loop (loop);
|
||||||
|
|
||||||
/* TODO: This can generate bad code if there are ordering dependencies,
|
/* TODO: This can generate bad code if there are ordering dependencies,
|
||||||
e.g., a callee allocated function and an unknown size constructor. */
|
e.g., a callee allocated function and an unknown size constructor. */
|
||||||
gcc_assert (ss != NULL);
|
gcc_assert (ss != NULL);
|
||||||
|
@ -2389,7 +2404,7 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript,
|
||||||
dimension indices, but not array section bounds. */
|
dimension indices, but not array section bounds. */
|
||||||
gfc_init_se (&se, NULL);
|
gfc_init_se (&se, NULL);
|
||||||
gfc_conv_expr (&se, expr);
|
gfc_conv_expr (&se, expr);
|
||||||
gfc_add_block_to_block (&loop->pre, &se.pre);
|
gfc_add_block_to_block (&outer_loop->pre, &se.pre);
|
||||||
|
|
||||||
if (expr->ts.type != BT_CHARACTER)
|
if (expr->ts.type != BT_CHARACTER)
|
||||||
{
|
{
|
||||||
|
@ -2398,11 +2413,11 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript,
|
||||||
if (subscript)
|
if (subscript)
|
||||||
se.expr = convert(gfc_array_index_type, se.expr);
|
se.expr = convert(gfc_array_index_type, se.expr);
|
||||||
if (!ss_info->where)
|
if (!ss_info->where)
|
||||||
se.expr = gfc_evaluate_now (se.expr, &loop->pre);
|
se.expr = gfc_evaluate_now (se.expr, &outer_loop->pre);
|
||||||
gfc_add_block_to_block (&loop->pre, &se.post);
|
gfc_add_block_to_block (&outer_loop->pre, &se.post);
|
||||||
}
|
}
|
||||||
else
|
else
|
||||||
gfc_add_block_to_block (&loop->post, &se.post);
|
gfc_add_block_to_block (&outer_loop->post, &se.post);
|
||||||
|
|
||||||
ss_info->data.scalar.value = se.expr;
|
ss_info->data.scalar.value = se.expr;
|
||||||
ss_info->string_length = se.string_length;
|
ss_info->string_length = se.string_length;
|
||||||
|
@ -2413,10 +2428,11 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript,
|
||||||
now. */
|
now. */
|
||||||
gfc_init_se (&se, NULL);
|
gfc_init_se (&se, NULL);
|
||||||
gfc_conv_expr (&se, expr);
|
gfc_conv_expr (&se, expr);
|
||||||
gfc_add_block_to_block (&loop->pre, &se.pre);
|
gfc_add_block_to_block (&outer_loop->pre, &se.pre);
|
||||||
gfc_add_block_to_block (&loop->post, &se.post);
|
gfc_add_block_to_block (&outer_loop->post, &se.post);
|
||||||
|
|
||||||
ss_info->data.scalar.value = gfc_evaluate_now (se.expr, &loop->pre);
|
ss_info->data.scalar.value = gfc_evaluate_now (se.expr,
|
||||||
|
&outer_loop->pre);
|
||||||
ss_info->string_length = se.string_length;
|
ss_info->string_length = se.string_length;
|
||||||
break;
|
break;
|
||||||
|
|
||||||
|
@ -2438,8 +2454,8 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript,
|
||||||
/* Get the vector's descriptor and store it in SS. */
|
/* Get the vector's descriptor and store it in SS. */
|
||||||
gfc_init_se (&se, NULL);
|
gfc_init_se (&se, NULL);
|
||||||
gfc_conv_expr_descriptor (&se, expr, gfc_walk_expr (expr));
|
gfc_conv_expr_descriptor (&se, expr, gfc_walk_expr (expr));
|
||||||
gfc_add_block_to_block (&loop->pre, &se.pre);
|
gfc_add_block_to_block (&outer_loop->pre, &se.pre);
|
||||||
gfc_add_block_to_block (&loop->post, &se.post);
|
gfc_add_block_to_block (&outer_loop->post, &se.post);
|
||||||
info->descriptor = se.expr;
|
info->descriptor = se.expr;
|
||||||
break;
|
break;
|
||||||
|
|
||||||
|
@ -2454,8 +2470,8 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript,
|
||||||
se.loop = loop;
|
se.loop = loop;
|
||||||
se.ss = ss;
|
se.ss = ss;
|
||||||
gfc_conv_expr (&se, expr);
|
gfc_conv_expr (&se, expr);
|
||||||
gfc_add_block_to_block (&loop->pre, &se.pre);
|
gfc_add_block_to_block (&outer_loop->pre, &se.pre);
|
||||||
gfc_add_block_to_block (&loop->post, &se.post);
|
gfc_add_block_to_block (&outer_loop->post, &se.post);
|
||||||
ss_info->string_length = se.string_length;
|
ss_info->string_length = se.string_length;
|
||||||
break;
|
break;
|
||||||
|
|
||||||
|
@ -2469,8 +2485,8 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript,
|
||||||
gfc_conv_expr_type (&se, expr->ts.u.cl->length,
|
gfc_conv_expr_type (&se, expr->ts.u.cl->length,
|
||||||
gfc_charlen_type_node);
|
gfc_charlen_type_node);
|
||||||
ss_info->string_length = se.expr;
|
ss_info->string_length = se.expr;
|
||||||
gfc_add_block_to_block (&loop->pre, &se.pre);
|
gfc_add_block_to_block (&outer_loop->pre, &se.pre);
|
||||||
gfc_add_block_to_block (&loop->post, &se.post);
|
gfc_add_block_to_block (&outer_loop->post, &se.post);
|
||||||
}
|
}
|
||||||
trans_array_constructor (ss, where);
|
trans_array_constructor (ss, where);
|
||||||
break;
|
break;
|
||||||
|
|
Loading…
Reference in New Issue