FreeChainXenon/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Make sure types in assignments are compatible.

Browse source 
2004-06-29  Steven Bosscher  <stevenb@suse.de>

	Make sure types in assignments are compatible.  Mostly mechanical.
	* trans-const.h (gfc_index_one_node): New define.
	* trans-array.c (gfc_trans_allocate_array_storage,
	gfc_trans_allocate_temp_array, gfc_trans_array_constructor_subarray,
	gfc_trans_array_constructor_value, gfc_trans_array_constructor,
	gfc_conv_array_ubound, gfc_conv_array_ref,
	gfc_trans_scalarized_loop_end, gfc_conv_section_startstride,
	gfc_conv_ss_startstride, gfc_conv_loop_setup, gfc_array_init_size,
	gfc_trans_array_bounds, gfc_trans_dummy_array_bias,
	gfc_conv_expr_descriptor, gfc_trans_deferred_array): Use the correct
	types in assignments, conversions and conditionals for expressions.
	* trans-expr.c (gfc_conv_expr_present, gfc_conv_substring,
	gfc_conv_unary_op, gfc_conv_cst_int_power, gfc_conv_string_tmp,
	gfc_conv_function_call, gfc_trans_pointer_assignment,
	gfc_trans_scalar_assign): Likewise.
	* trans-intrinsic.c (build_fixbound_expr, gfc_conv_intrinsic_bound,
	gfc_conv_intrinsic_anyall, gfc_conv_intrinsic_count,
	gfc_conv_intrinsic_minmaxloc, gfc_conv_intrinsic_btest,
	gfc_conv_intrinsic_singlebitop, gfc_conv_intrinsic_ishft,
	gfc_conv_intrinsic_ishftc, gfc_conv_intrinsic_strcmp,
	gfc_conv_allocated, gfc_conv_associated,
	gfc_conv_intrinsic_rrspacing, gfc_conv_intrinsic_trim): Likewise.
	* trans-io.c (set_string): Likewise.
	* trans-stmt.c (gfc_trans_do, gfc_trans_forall_loop,
	gfc_do_allocate, generate_loop_for_temp_to_lhs,
	generate_loop_for_rhs_to_temp, compute_inner_temp_size,
	compute_overall_iter_number, gfc_trans_assign_need_temp,
	gfc_trans_pointer_assign_need_temp, gfc_trans_forall_1,
	gfc_evaluate_where_mask, gfc_trans_where_assign,
	gfc_trans_where_2): Likewise.
	* trans-types.c (gfc_get_character_type, gfc_build_array_type,
	gfc_get_nodesc_array_type, gfc_get_array_type_bounds): Likewise.

	* trans.c (gfc_add_modify_expr): Add sanity check that types
	for the lhs and rhs are the same for scalar assignments.

From-SVN: r83877
This commit is contained in:
Steven Bosscher 2004-06-29 22:01:35 +00:00 • committed by Steven Bosscher
parent e23667c608
commit 7ab9258466
9 changed files with 264 additions and 176 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

38
gcc/fortran/ChangeLog
View file

@ -1,3 +1,41 @@
2004-06-29 Steven Bosscher <stevenb@suse.de>
Make sure types in assignments are compatible. Mostly mechanical.
* trans-const.h (gfc_index_one_node): New define.
* trans-array.c (gfc_trans_allocate_array_storage,
gfc_trans_allocate_temp_array, gfc_trans_array_constructor_subarray,
gfc_trans_array_constructor_value, gfc_trans_array_constructor,
gfc_conv_array_ubound, gfc_conv_array_ref,
gfc_trans_scalarized_loop_end, gfc_conv_section_startstride,
gfc_conv_ss_startstride, gfc_conv_loop_setup, gfc_array_init_size,
gfc_trans_array_bounds, gfc_trans_dummy_array_bias,
gfc_conv_expr_descriptor, gfc_trans_deferred_array): Use the correct
types in assignments, conversions and conditionals for expressions.
* trans-expr.c (gfc_conv_expr_present, gfc_conv_substring,
gfc_conv_unary_op, gfc_conv_cst_int_power, gfc_conv_string_tmp,
gfc_conv_function_call, gfc_trans_pointer_assignment,
gfc_trans_scalar_assign): Likewise.
* trans-intrinsic.c (build_fixbound_expr, gfc_conv_intrinsic_bound,
gfc_conv_intrinsic_anyall, gfc_conv_intrinsic_count,
gfc_conv_intrinsic_minmaxloc, gfc_conv_intrinsic_btest,
gfc_conv_intrinsic_singlebitop, gfc_conv_intrinsic_ishft,
gfc_conv_intrinsic_ishftc, gfc_conv_intrinsic_strcmp,
gfc_conv_allocated, gfc_conv_associated,
gfc_conv_intrinsic_rrspacing, gfc_conv_intrinsic_trim): Likewise.
* trans-io.c (set_string): Likewise.
* trans-stmt.c (gfc_trans_do, gfc_trans_forall_loop,
gfc_do_allocate, generate_loop_for_temp_to_lhs,
generate_loop_for_rhs_to_temp, compute_inner_temp_size,
compute_overall_iter_number, gfc_trans_assign_need_temp,
gfc_trans_pointer_assign_need_temp, gfc_trans_forall_1,
gfc_evaluate_where_mask, gfc_trans_where_assign,
gfc_trans_where_2): Likewise.
* trans-types.c (gfc_get_character_type, gfc_build_array_type,
gfc_get_nodesc_array_type, gfc_get_array_type_bounds): Likewise.
* trans.c (gfc_add_modify_expr): Add sanity check that types
for the lhs and rhs are the same for scalar assignments.
2004-06-29 Tobias Schlueter <tobias.schlueter@physik.uni-muenchen.de>
* dump-parse-tree.c (show_common): New function.

115
gcc/fortran/trans-array.c
View file

@ -443,7 +443,7 @@ gfc_trans_allocate_array_storage (gfc_loopinfo * loop, gfc_ss_info * info,
/* Make a temporary variable to hold the data. */
tmp = fold (build (MINUS_EXPR, TREE_TYPE (nelem), nelem,
integer_one_node));
tmp = build_range_type (gfc_array_index_type, integer_zero_node, tmp);
tmp = build_range_type (gfc_array_index_type, gfc_index_zero_node, tmp);
tmp = build_array_type (gfc_get_element_type (TREE_TYPE (desc)), tmp);
tmp = gfc_create_var (tmp, "A");
tmp = gfc_build_addr_expr (TREE_TYPE (data), tmp);
@ -515,12 +515,12 @@ gfc_trans_allocate_temp_array (gfc_loopinfo * loop, gfc_ss_info * info,
{
loop->to[n] = fold (build (MINUS_EXPR, gfc_array_index_type,
loop->to[n], loop->from[n]));
loop->from[n] = integer_zero_node;
loop->from[n] = gfc_index_zero_node;
}
info->delta[dim] = integer_zero_node;
info->start[dim] = integer_zero_node;
info->stride[dim] = integer_one_node;
info->delta[dim] = gfc_index_zero_node;
info->start[dim] = gfc_index_zero_node;
info->stride[dim] = gfc_index_one_node;
info->dim[dim] = dim;
}
@ -531,22 +531,26 @@ gfc_trans_allocate_temp_array (gfc_loopinfo * loop, gfc_ss_info * info,
GFC_DECL_PACKED_ARRAY (desc) = 1;
info->descriptor = desc;
size = integer_one_node;
size = gfc_index_one_node;
/* Fill in the array dtype. */
tmp = gfc_conv_descriptor_dtype (desc);
gfc_add_modify_expr (&loop->pre, tmp,
GFC_TYPE_ARRAY_DTYPE (TREE_TYPE (desc)));
/* Fill in the bounds and stride. This is a packed array, so:
/*
Fill in the bounds and stride. This is a packed array, so:
size = 1;
for (n = 0; n < rank; n++)
{
stride[n] = size
delta = ubound[n] + 1 - lbound[n];
size = size * delta;
}
size = size * sizeof(element); */
{
stride[n] = size
delta = ubound[n] + 1 - lbound[n];
size = size * delta;
}
size = size * sizeof(element);
*/
for (n = 0; n < info->dimen; n++)
{
/* Store the stride and bound components in the descriptor. */
@ -554,13 +558,13 @@ gfc_trans_allocate_temp_array (gfc_loopinfo * loop, gfc_ss_info * info,
gfc_add_modify_expr (&loop->pre, tmp, size);
tmp = gfc_conv_descriptor_lbound (desc, gfc_rank_cst[n]);
gfc_add_modify_expr (&loop->pre, tmp, integer_zero_node);
gfc_add_modify_expr (&loop->pre, tmp, gfc_index_zero_node);
tmp = gfc_conv_descriptor_ubound (desc, gfc_rank_cst[n]);
gfc_add_modify_expr (&loop->pre, tmp, loop->to[n]);
tmp = fold (build (PLUS_EXPR, gfc_array_index_type,
loop->to[n], integer_one_node));
loop->to[n], gfc_index_one_node));
size = fold (build (MULT_EXPR, gfc_array_index_type, size, tmp));
size = gfc_evaluate_now (size, &loop->pre);
@ -645,7 +649,7 @@ gfc_trans_array_constructor_subarray (stmtblock_t * pblock,
gfc_add_modify_expr (&body, tmp, se.expr);
/* Increment the offset. */
tmp = build (PLUS_EXPR, gfc_array_index_type, *poffset, integer_one_node);
tmp = build (PLUS_EXPR, gfc_array_index_type, *poffset, gfc_index_one_node);
gfc_add_modify_expr (&body, *poffset, tmp);
/* Finish the loop. */
@ -716,11 +720,12 @@ gfc_trans_array_constructor_value (stmtblock_t * pblock, tree type,
ref = gfc_build_indirect_ref (pointer);
ref = gfc_build_array_ref (ref, *poffset);
gfc_add_modify_expr (&body, ref, se.expr);
gfc_add_modify_expr (&body, ref,
fold_convert (TREE_TYPE (ref), se.expr));
gfc_add_block_to_block (&body, &se.post);
*poffset = fold (build (PLUS_EXPR, gfc_array_index_type,
*poffset, integer_one_node));
*poffset, gfc_index_one_node));
}
else
{
@ -746,7 +751,7 @@ gfc_trans_array_constructor_value (stmtblock_t * pblock, tree type,
bound = build_int_2 (n - 1, 0);
/* Create an array type to hold them. */
tmptype = build_range_type (gfc_array_index_type,
integer_zero_node, bound);
gfc_index_zero_node, bound);
tmptype = build_array_type (type, tmptype);
init = build1 (CONSTRUCTOR, tmptype, nreverse (list));
@ -942,7 +947,7 @@ gfc_trans_array_constructor (gfc_loopinfo * loop, gfc_ss * ss)
gfc_trans_allocate_temp_array (loop, &ss->data.info, type, NULL_TREE);
desc = ss->data.info.descriptor;
offset = integer_zero_node;
offset = gfc_index_zero_node;
offsetvar = gfc_create_var_np (gfc_array_index_type, "offset");
TREE_USED (offsetvar) = 0;
gfc_trans_array_constructor_value (&loop->pre, type,
@ -1214,7 +1219,7 @@ gfc_conv_array_ubound (tree descriptor, int dim)
/* This should only ever happen when passing an assumed shape array
as an actual parameter. The value will never be used. */
if (GFC_ARRAY_TYPE_P (TREE_TYPE (descriptor)))
return integer_zero_node;
return gfc_index_zero_node;
tmp = gfc_conv_descriptor_ubound (descriptor, gfc_rank_cst[dim]);
return tmp;
@ -1466,9 +1471,9 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar)
return;
}
index = integer_zero_node;
index = gfc_index_zero_node;
fault = integer_zero_node;
fault = gfc_index_zero_node;
/* Calculate the offsets from all the dimensions. */
for (n = 0; n < ar->dimen; n++)
@ -1687,7 +1692,7 @@ gfc_trans_scalarized_loop_end (gfc_loopinfo * loop, int n,
/* Increment the loopvar. */
tmp = build (PLUS_EXPR, gfc_array_index_type,
loop->loopvar[n], integer_one_node);
loop->loopvar[n], gfc_index_one_node);
gfc_add_modify_expr (&block, loop->loopvar[n], tmp);
/* Build the loop. */
@ -1885,7 +1890,7 @@ gfc_conv_section_startstride (gfc_loopinfo * loop, gfc_ss * ss, int n)
/* Calculate the stride. */
if (stride == NULL)
info->stride[n] = integer_one_node;
info->stride[n] = gfc_index_one_node;
else
{
gfc_init_se (&se, NULL);
@ -1948,8 +1953,8 @@ gfc_conv_ss_startstride (gfc_loopinfo * loop)
case GFC_SS_FUNCTION:
for (n = 0; n < ss->data.info.dimen; n++)
{
ss->data.info.start[n] = integer_zero_node;
ss->data.info.stride[n] = integer_one_node;
ss->data.info.start[n] = gfc_index_zero_node;
ss->data.info.stride[n] = gfc_index_one_node;
}
break;
@ -2322,7 +2327,7 @@ gfc_conv_loop_setup (gfc_loopinfo * loop)
/* Transform everything so we have a simple incrementing variable. */
if (integer_onep (info->stride[n]))
info->delta[n] = integer_zero_node;
info->delta[n] = gfc_index_zero_node;
else
{
/* Set the delta for this section. */
@ -2337,7 +2342,7 @@ gfc_conv_loop_setup (gfc_loopinfo * loop)
info->stride[n]));
loop->to[n] = gfc_evaluate_now (tmp, &loop->pre);
/* Make the loop variable start at 0. */
loop->from[n] = integer_zero_node;
loop->from[n] = gfc_index_zero_node;
}
}
@ -2435,8 +2440,8 @@ gfc_array_init_size (tree descriptor, int rank, tree * poffset,
type = TREE_TYPE (descriptor);
stride = integer_one_node;
offset = integer_zero_node;
stride = gfc_index_one_node;
offset = gfc_index_zero_node;
/* Set the dtype. */
tmp = gfc_conv_descriptor_dtype (descriptor);
@ -2454,7 +2459,7 @@ gfc_array_init_size (tree descriptor, int rank, tree * poffset,
/* Set lower bound. */
gfc_init_se (&se, NULL);
if (lower == NULL)
se.expr = integer_one_node;
se.expr = gfc_index_one_node;
else
{
assert (lower[n]);
@ -2465,7 +2470,7 @@ gfc_array_init_size (tree descriptor, int rank, tree * poffset,
}
else
{
se.expr = integer_one_node;
se.expr = gfc_index_one_node;
ubound = lower[n];
}
}
@ -2478,7 +2483,7 @@ gfc_array_init_size (tree descriptor, int rank, tree * poffset,
/* Start the calculation for the size of this dimension. */
size = build (MINUS_EXPR, gfc_array_index_type,
integer_one_node, se.expr);
gfc_index_one_node, se.expr);
/* Set upper bound. */
gfc_init_se (&se, NULL);
@ -2754,8 +2759,8 @@ gfc_trans_array_bounds (tree type, gfc_symbol * sym, tree * poffset,
as = sym->as;
size = integer_one_node;
offset = integer_zero_node;
size = gfc_index_one_node;
offset = gfc_index_zero_node;
for (dim = 0; dim < as->rank; dim++)
{
/* Evaluate non-constant array bound expressions. */
@ -2789,7 +2794,7 @@ gfc_trans_array_bounds (tree type, gfc_symbol * sym, tree * poffset,
{
/* Calculate stride = size * (ubound + 1 - lbound). */
tmp = fold (build (MINUS_EXPR, gfc_array_index_type,
integer_one_node, lbound));
gfc_index_one_node, lbound));
tmp = fold (build (PLUS_EXPR, gfc_array_index_type, ubound, tmp));
tmp = fold (build (MULT_EXPR, gfc_array_index_type, size, tmp));
if (stride)
@ -3062,7 +3067,7 @@ gfc_trans_dummy_array_bias (gfc_symbol * sym, tree tmpdesc, tree body)
tmp = build (EQ_EXPR, boolean_type_node, stride, integer_zero_node);
tmp = build (COND_EXPR, gfc_array_index_type, tmp,
integer_one_node, stride);
gfc_index_one_node, stride);
stride = GFC_TYPE_ARRAY_STRIDE (type, 0);
gfc_add_modify_expr (&block, stride, tmp);
@ -3077,7 +3082,7 @@ gfc_trans_dummy_array_bias (gfc_symbol * sym, tree tmpdesc, tree body)
tmp = gfc_chainon_list (NULL_TREE, tmp);
stmt_unpacked = gfc_build_function_call (gfor_fndecl_in_pack, tmp);
stride = integer_one_node;
stride = gfc_index_one_node;
}
/* This is for the case where the array data is used directly without
@ -3096,10 +3101,10 @@ gfc_trans_dummy_array_bias (gfc_symbol * sym, tree tmpdesc, tree body)
}
else
tmp = stmt_packed != NULL_TREE ? stmt_packed : stmt_unpacked;
gfc_add_modify_expr (&block, tmpdesc, tmp);
gfc_add_modify_expr (&block, tmpdesc, fold_convert (type, tmp));
offset = integer_zero_node;
size = integer_one_node;
offset = gfc_index_zero_node;
size = gfc_index_one_node;
/* Evaluate the bounds of the array. */
for (n = 0; n < sym->as->rank; n++)
@ -3185,7 +3190,7 @@ gfc_trans_dummy_array_bias (gfc_symbol * sym, tree tmpdesc, tree body)
{
/* Calculate stride = size * (ubound + 1 - lbound). */
tmp = fold (build (MINUS_EXPR, gfc_array_index_type,
integer_one_node, lbound));
gfc_index_one_node, lbound));
tmp = fold (build (PLUS_EXPR, gfc_array_index_type,
ubound, tmp));
size = fold (build (MULT_EXPR, gfc_array_index_type,
@ -3266,8 +3271,8 @@ gfc_trans_dummy_array_bias (gfc_symbol * sym, tree tmpdesc, tree body)
}
/* Convert an array for passing as an actual parameter. Expressions
and vector subscripts are evaluated and stored in a teporary, which is then
/* Convert an array for passing as an actual parameter. Expressions and
vector subscripts are evaluated and stored in a temporary, which is then
passed. For whole arrays the descriptor is passed. For array sections
a modified copy of the descriptor is passed, but using the original data.
Also used for array pointer assignments by setting se->direct_byref. */
@ -3435,7 +3440,7 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss)
/* Set the first stride component to zero to indicate a temporary. */
desc = loop.temp_ss->data.info.descriptor;
tmp = gfc_conv_descriptor_stride (desc, gfc_rank_cst[0]);
gfc_add_modify_expr (&loop.pre, tmp, integer_zero_node);
gfc_add_modify_expr (&loop.pre, tmp, gfc_index_zero_node);
assert (is_gimple_lvalue (desc));
se->expr = gfc_build_addr_expr (NULL, desc);
@ -3473,7 +3478,7 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss)
parm = gfc_create_var (parmtype, "parm");
}
offset = integer_zero_node;
offset = gfc_index_zero_node;
dim = 0;
/* The following can be somewhat confusing. We have two
@ -3490,7 +3495,7 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss)
gfc_add_modify_expr (&loop.pre, tmp, GFC_TYPE_ARRAY_DTYPE (parmtype));
if (se->direct_byref)
base = integer_zero_node;
base = gfc_index_zero_node;
else
base = NULL_TREE;
@ -3536,10 +3541,10 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss)
if (!integer_onep (from))
{
/* Make sure the new section starts at 1. */
tmp = fold (build (MINUS_EXPR, TREE_TYPE (from),
integer_one_node, from));
to = fold (build (PLUS_EXPR, TREE_TYPE (to), to, tmp));
from = integer_one_node;
tmp = fold (build (MINUS_EXPR, gfc_array_index_type,
gfc_index_one_node, from));
to = fold (build (PLUS_EXPR, gfc_array_index_type, to, tmp));
from = gfc_index_one_node;
}
tmp = gfc_conv_descriptor_lbound (parm, gfc_rank_cst[dim]);
gfc_add_modify_expr (&loop.pre, tmp, from);
@ -3573,7 +3578,8 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss)
offset = gfc_build_addr_expr (gfc_array_dataptr_type (desc), tmp);
tmp = gfc_conv_descriptor_data (parm);
gfc_add_modify_expr (&loop.pre, tmp, offset);
gfc_add_modify_expr (&loop.pre, tmp,
fold_convert (TREE_TYPE (tmp), offset));
if (se->direct_byref)
{
@ -3737,7 +3743,8 @@ gfc_trans_deferred_array (gfc_symbol * sym, tree body)
/* NULLIFY the data pointer. */
tmp = gfc_conv_descriptor_data (descriptor);
gfc_add_modify_expr (&fnblock, tmp, integer_zero_node);
gfc_add_modify_expr (&fnblock, tmp,
convert (TREE_TYPE (tmp), integer_zero_node));
gfc_add_expr_to_block (&fnblock, body);

2
gcc/fortran/trans-const.h
View file

@ -56,4 +56,6 @@ extern GTY(()) tree gfc_strconst_wrong_return;
/* Integer constants 0..GFC_MAX_DIMENSIONS. */
extern GTY(()) tree gfc_rank_cst[GFC_MAX_DIMENSIONS + 1];
#define gfc_index_zero_node gfc_rank_cst[0]
#define gfc_index_one_node gfc_rank_cst[1]

63
gcc/fortran/trans-expr.c
View file

@ -135,7 +135,8 @@ gfc_conv_expr_present (gfc_symbol * sym)
|| GFC_ARRAY_TYPE_P (TREE_TYPE (decl)));
decl = GFC_DECL_SAVED_DESCRIPTOR (decl);
}
return build (NE_EXPR, boolean_type_node, decl, null_pointer_node);
return build (NE_EXPR, boolean_type_node, decl,
fold_convert (TREE_TYPE (decl), null_pointer_node));
}
@ -174,9 +175,7 @@ gfc_conv_substring (gfc_se * se, gfc_ref * ref, int kind)
gfc_add_block_to_block (&se->pre, &start.pre);
if (integer_onep (start.expr))
{
gfc_conv_string_parameter (se);
}
gfc_conv_string_parameter (se);
else
{
/* Change the start of the string. */
@ -198,7 +197,9 @@ gfc_conv_substring (gfc_se * se, gfc_ref * ref, int kind)
gfc_add_block_to_block (&se->pre, &end.pre);
}
tmp =
build (MINUS_EXPR, gfc_strlen_type_node, integer_one_node, start.expr);
build (MINUS_EXPR, gfc_strlen_type_node,
fold_convert (gfc_strlen_type_node, integer_one_node),
start.expr);
tmp = build (PLUS_EXPR, gfc_strlen_type_node, end.expr, tmp);
se->string_length = fold (tmp);
}
@ -376,7 +377,8 @@ gfc_conv_unary_op (enum tree_code code, gfc_se * se, gfc_expr * expr)
We must convert it to a compare to 0 (e.g. EQ_EXPR (op1, 0)).
All other unary operators have an equivalent GIMPLE unary operator */
if (code == TRUTH_NOT_EXPR)
se->expr = build (EQ_EXPR, type, operand.expr, integer_zero_node);
se->expr = build (EQ_EXPR, type, operand.expr,
convert (type, integer_zero_node));
else
se->expr = build1 (code, type, operand.expr);
@ -502,24 +504,27 @@ gfc_conv_cst_int_power (gfc_se * se, tree lhs, tree rhs)
if ((sgn == -1) && (TREE_CODE (type) == INTEGER_TYPE))
{
tmp = build (EQ_EXPR, boolean_type_node, lhs,
integer_minus_one_node);
fold_convert (TREE_TYPE (lhs), integer_minus_one_node));
cond = build (EQ_EXPR, boolean_type_node, lhs,
integer_one_node);
convert (TREE_TYPE (lhs), integer_one_node));
/* If rhs is an even,
result = (lhs == 1 || lhs == -1) ? 1 : 0. */
result = (lhs == 1 || lhs == -1) ? 1 : 0. */
if ((n & 1) == 0)
{
tmp = build (TRUTH_OR_EXPR, boolean_type_node, tmp, cond);
se->expr = build (COND_EXPR, type, tmp, integer_one_node,
integer_zero_node);
se->expr = build (COND_EXPR, type, tmp,
convert (type, integer_one_node),
convert (type, integer_zero_node));
return 1;
}
/* If rhs is an odd,
result = (lhs == 1) ? 1 : (lhs == -1) ? -1 : 0. */
tmp = build (COND_EXPR, type, tmp, integer_minus_one_node,
integer_zero_node);
se->expr = build (COND_EXPR, type, cond, integer_one_node,
tmp = build (COND_EXPR, type, tmp,
convert (type, integer_minus_one_node),
convert (type, integer_zero_node));
se->expr = build (COND_EXPR, type, cond,
convert (type, integer_one_node),
tmp);
return 1;
}
@ -675,11 +680,16 @@ gfc_conv_string_tmp (gfc_se * se, tree type, tree len)
tree tmp;
tree args;
if (TREE_TYPE (len) != gfc_strlen_type_node)
abort ();
if (gfc_can_put_var_on_stack (len))
{
/* Create a temporary variable to hold the result. */
tmp = fold (build (MINUS_EXPR, TREE_TYPE (len), len, integer_one_node));
tmp = build_range_type (gfc_array_index_type, integer_zero_node, tmp);
tmp = fold (build (MINUS_EXPR, gfc_strlen_type_node, len,
convert (gfc_strlen_type_node,
integer_one_node)));
tmp = build_range_type (gfc_array_index_type, gfc_index_zero_node, tmp);
tmp = build_array_type (gfc_character1_type_node, tmp);
var = gfc_create_var (tmp, "str");
var = gfc_build_addr_expr (type, var);
@ -1030,7 +1040,8 @@ gfc_conv_function_call (gfc_se * se, gfc_symbol * sym,
/* Zero the first stride to indicate a temporary. */
tmp =
gfc_conv_descriptor_stride (info->descriptor, gfc_rank_cst[0]);
gfc_add_modify_expr (&se->pre, tmp, integer_zero_node);
gfc_add_modify_expr (&se->pre, tmp,
convert (TREE_TYPE (tmp), integer_zero_node));
/* Pass the temporary as the first argument. */
tmp = info->descriptor;
tmp = gfc_build_addr_expr (NULL, tmp);
@ -1080,8 +1091,10 @@ gfc_conv_function_call (gfc_se * se, gfc_symbol * sym,
parmse.expr = null_pointer_node;
if (arg->missing_arg_type == BT_CHARACTER)
{
stringargs = gfc_chainon_list (stringargs,
convert (gfc_strlen_type_node, integer_zero_node));
stringargs =
gfc_chainon_list (stringargs,
convert (gfc_strlen_type_node,
integer_zero_node));
}
}
}
@ -1589,7 +1602,6 @@ gfc_trans_pointer_assignment (gfc_expr * expr1, gfc_expr * expr2)
gfc_ss *lss;
gfc_ss *rss;
stmtblock_t block;
tree tmp;
gfc_start_block (&block);
@ -1607,7 +1619,8 @@ gfc_trans_pointer_assignment (gfc_expr * expr1, gfc_expr * expr2)
gfc_conv_expr (&rse, expr2);
gfc_add_block_to_block (&block, &lse.pre);
gfc_add_block_to_block (&block, &rse.pre);
gfc_add_modify_expr (&block, lse.expr, rse.expr);
gfc_add_modify_expr (&block, lse.expr,
fold_convert (TREE_TYPE (lse.expr), rse.expr));
gfc_add_block_to_block (&block, &rse.post);
gfc_add_block_to_block (&block, &lse.post);
}
@ -1618,9 +1631,8 @@ gfc_trans_pointer_assignment (gfc_expr * expr1, gfc_expr * expr2)
if (expr2->expr_type == EXPR_NULL)
{
lse.expr = gfc_conv_descriptor_data (lse.expr);
rse.expr = null_pointer_node;
tmp = build_v (MODIFY_EXPR, lse.expr, rse.expr);
gfc_add_expr_to_block (&block, tmp);
rse.expr = fold_convert (TREE_TYPE (lse.expr), null_pointer_node);
gfc_add_modify_expr (&block, lse.expr, rse.expr);
}
else
{
@ -1690,7 +1702,8 @@ gfc_trans_scalar_assign (gfc_se * lse, gfc_se * rse, bt type)
gfc_add_block_to_block (&block, &lse->pre);
gfc_add_block_to_block (&block, &rse->pre);
gfc_add_modify_expr (&block, lse->expr, rse->expr);
gfc_add_modify_expr (&block, lse->expr,
fold_convert (TREE_TYPE (lse->expr), rse->expr));
}
gfc_add_block_to_block (&block, &lse->post);

55
gcc/fortran/trans-intrinsic.c
View file

@ -228,7 +228,8 @@ build_fixbound_expr (stmtblock_t * pblock, tree arg, tree type, int up)
tmp = convert (argtype, intval);
cond = build (up ? GE_EXPR : LE_EXPR, boolean_type_node, tmp, arg);
tmp = build (up ? PLUS_EXPR : MINUS_EXPR, type, intval, integer_one_node);
tmp = build (up ? PLUS_EXPR : MINUS_EXPR, type, intval,
convert (type, integer_one_node));
tmp = build (COND_EXPR, type, cond, intval, tmp);
return tmp;
}
@ -651,7 +652,7 @@ gfc_conv_intrinsic_bound (gfc_se * se, gfc_expr * expr, int upper)
bound = argse.expr;
/* Convert from one based to zero based. */
bound = fold (build (MINUS_EXPR, gfc_array_index_type, bound,
integer_one_node));
gfc_index_one_node));
}
/* TODO: don't re-evaluate the descriptor on each iteration. */
@ -677,7 +678,7 @@ gfc_conv_intrinsic_bound (gfc_se * se, gfc_expr * expr, int upper)
{
bound = gfc_evaluate_now (bound, &se->pre);
cond = fold (build (LT_EXPR, boolean_type_node, bound,
integer_zero_node));
convert (TREE_TYPE (bound), integer_zero_node)));
tmp = gfc_rank_cst[GFC_TYPE_ARRAY_RANK (TREE_TYPE (desc))];
tmp = fold (build (GE_EXPR, boolean_type_node, bound, tmp));
cond = fold(build (TRUTH_ORIF_EXPR, boolean_type_node, cond, tmp));
@ -1172,7 +1173,9 @@ gfc_conv_intrinsic_anyall (gfc_se * se, gfc_expr * expr, int op)
gfc_conv_expr_val (&arrayse, actual->expr);
gfc_add_block_to_block (&body, &arrayse.pre);
tmp = build (op, boolean_type_node, arrayse.expr, integer_zero_node);
tmp = build (op, boolean_type_node, arrayse.expr,
fold_convert (TREE_TYPE (arrayse.expr),
integer_zero_node));
tmp = build_v (COND_EXPR, tmp, found, build_empty_stmt ());
gfc_add_expr_to_block (&body, tmp);
gfc_add_block_to_block (&body, &arrayse.post);
@ -1214,7 +1217,7 @@ gfc_conv_intrinsic_count (gfc_se * se, gfc_expr * expr)
type = gfc_typenode_for_spec (&expr->ts);
/* Initialize the result. */
resvar = gfc_create_var (type, "count");
gfc_add_modify_expr (&se->pre, resvar, integer_zero_node);
gfc_add_modify_expr (&se->pre, resvar, convert (type, integer_zero_node));
/* Walk the arguments. */
arrayss = gfc_walk_expr (actual->expr);
@ -1232,7 +1235,8 @@ gfc_conv_intrinsic_count (gfc_se * se, gfc_expr * expr)
/* Generate the loop body. */
gfc_start_scalarized_body (&loop, &body);
tmp = build (PLUS_EXPR, TREE_TYPE (resvar), resvar, integer_one_node);
tmp = build (PLUS_EXPR, TREE_TYPE (resvar), resvar,
convert (TREE_TYPE (resvar), integer_one_node));
tmp = build_v (MODIFY_EXPR, resvar, tmp);
gfc_init_se (&arrayse, NULL);
@ -1453,7 +1457,7 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr * expr, int op)
array, in case all elements are equal to the limit.
ie. pos = (ubound >= lbound) ? lbound, lbound - 1; */
tmp = fold (build (MINUS_EXPR, gfc_array_index_type,
loop.from[0], integer_one_node));
loop.from[0], gfc_index_one_node));
cond = fold (build (GE_EXPR, boolean_type_node,
loop.to[0], loop.from[0]));
tmp = fold (build (COND_EXPR, gfc_array_index_type, cond,
@ -1522,7 +1526,7 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr * expr, int op)
/* Return a value in the range 1..SIZE(array). */
tmp = fold (build (MINUS_EXPR, gfc_array_index_type, loop.from[0],
integer_one_node));
gfc_index_one_node));
tmp = fold (build (MINUS_EXPR, gfc_array_index_type, pos, tmp));
/* And convert to the required type. */
se->expr = convert (type, tmp);
@ -1670,9 +1674,10 @@ gfc_conv_intrinsic_btest (gfc_se * se, gfc_expr * expr)
arg = TREE_VALUE (arg);
type = TREE_TYPE (arg);
tmp = build (LSHIFT_EXPR, type, integer_one_node, arg2);
tmp = build (LSHIFT_EXPR, type, convert (type, integer_one_node), arg2);
tmp = build (BIT_AND_EXPR, type, arg, tmp);
tmp = fold (build (NE_EXPR, boolean_type_node, tmp, integer_zero_node));
tmp = fold (build (NE_EXPR, boolean_type_node, tmp,
convert (type, integer_zero_node)));
type = gfc_typenode_for_spec (&expr->ts);
se->expr = convert (type, tmp);
}
@ -1720,7 +1725,8 @@ gfc_conv_intrinsic_singlebitop (gfc_se * se, gfc_expr * expr, int set)
arg = TREE_VALUE (arg);
type = TREE_TYPE (arg);
tmp = fold (build (LSHIFT_EXPR, type, integer_one_node, arg2));
tmp = fold (build (LSHIFT_EXPR, type,
convert (type, integer_one_node), arg2));
if (set)
op = BIT_IOR_EXPR;
else
@ -1783,11 +1789,13 @@ gfc_conv_intrinsic_ishft (gfc_se * se, gfc_expr * expr)
tmp = build1 (NEGATE_EXPR, TREE_TYPE (arg2), arg2);
rshift = build (RSHIFT_EXPR, type, arg, tmp);
tmp = build (GT_EXPR, boolean_type_node, arg2, integer_zero_node);
tmp = build (GT_EXPR, boolean_type_node, arg2,
convert (TREE_TYPE (arg2), integer_zero_node));
rshift = build (COND_EXPR, type, tmp, lshift, rshift);
/* Do nothing if shift == 0. */
tmp = build (EQ_EXPR, boolean_type_node, arg2, integer_zero_node);
tmp = build (EQ_EXPR, boolean_type_node, arg2,
convert (TREE_TYPE (arg2), integer_zero_node));
se->expr = build (COND_EXPR, type, tmp, arg, rshift);
}
@ -1843,11 +1851,13 @@ gfc_conv_intrinsic_ishftc (gfc_se * se, gfc_expr * expr)
tmp = build1 (NEGATE_EXPR, TREE_TYPE (arg2), arg2);
rrot = build (RROTATE_EXPR, type, arg, tmp);
tmp = build (GT_EXPR, boolean_type_node, arg2, integer_zero_node);
tmp = build (GT_EXPR, boolean_type_node, arg2,
convert (TREE_TYPE (arg2), integer_zero_node));
rrot = build (COND_EXPR, type, tmp, lrot, rrot);
/* Do nothing if shift == 0. */
tmp = build (EQ_EXPR, boolean_type_node, arg2, integer_zero_node);
tmp = build (EQ_EXPR, boolean_type_node, arg2,
convert (TREE_TYPE (arg2), integer_zero_node));
se->expr = build (COND_EXPR, type, tmp, arg, rrot);
}
@ -2040,7 +2050,8 @@ gfc_conv_intrinsic_strcmp (gfc_se * se, gfc_expr * expr, int op)
se->expr = gfc_build_function_call (gfor_fndecl_compare_string, args);
type = gfc_typenode_for_spec (&expr->ts);
se->expr = build (op, type, se->expr, integer_zero_node);
se->expr = build (op, type, se->expr,
convert (TREE_TYPE (se->expr), integer_zero_node));
}
/* Generate a call to the adjustl/adjustr library function. */
@ -2130,7 +2141,8 @@ gfc_conv_allocated (gfc_se *se, gfc_expr *expr)
gfc_conv_expr_descriptor (&arg1se, arg1->expr, ss1);
tmp = gfc_conv_descriptor_data (arg1se.expr);
tmp = build (NE_EXPR, boolean_type_node, tmp, null_pointer_node);
tmp = build (NE_EXPR, boolean_type_node, tmp,
fold_convert (TREE_TYPE (tmp), null_pointer_node));
se->expr = convert (gfc_typenode_for_spec (&expr->ts), tmp);
}
@ -2176,7 +2188,8 @@ gfc_conv_associated (gfc_se *se, gfc_expr *expr)
gfc_conv_expr_lhs (&arg1se, arg1->expr);
tmp2 = gfc_conv_descriptor_data (arg1se.expr);
}
tmp = build (NE_EXPR, boolean_type_node, tmp2, null_pointer_node);
tmp = build (NE_EXPR, boolean_type_node, tmp2,
fold_convert (TREE_TYPE (tmp2), null_pointer_node));
se->expr = tmp;
}
else
@ -2450,7 +2463,8 @@ gfc_conv_intrinsic_rrspacing (gfc_se * se, gfc_expr * expr)
cond2 = build (EQ_EXPR, boolean_type_node, rcs.frac, zero);
cond = build (TRUTH_ANDIF_EXPR, boolean_type_node, cond, cond2);
tmp = build (COND_EXPR, masktype, cond, integer_zero_node, tmp);
tmp = build (COND_EXPR, masktype, cond,
convert (masktype, integer_zero_node), tmp);
tmp = build1 (VIEW_CONVERT_EXPR, rcs.type, tmp);
se->expr = tmp;
@ -2527,7 +2541,8 @@ gfc_conv_intrinsic_trim (gfc_se * se, gfc_expr * expr)
gfc_add_expr_to_block (&se->pre, tmp);
/* Free the temporary afterwards, if necessary. */
cond = build (GT_EXPR, boolean_type_node, len, integer_zero_node);
cond = build (GT_EXPR, boolean_type_node, len,
convert (TREE_TYPE (len), integer_zero_node));
arglist = gfc_chainon_list (NULL_TREE, var);
tmp = gfc_build_function_call (gfor_fndecl_internal_free, arglist);
tmp = build_v (COND_EXPR, cond, tmp, build_empty_stmt ());

13
gcc/fortran/trans-io.c
View file

@ -404,13 +404,14 @@ set_string (stmtblock_t * block, stmtblock_t * postblock, tree var,
len = build (COMPONENT_REF, TREE_TYPE (var_len), ioparm_var, var_len,
NULL_TREE);
/* Integer variable assigned a format label. */
/* Integer variable assigned a format label. */
if (e->ts.type == BT_INTEGER && e->symtree->n.sym->attr.assign == 1)
{
msg =
gfc_build_string_const (37, "Assigned label is not a format label");
tmp = GFC_DECL_STRING_LEN (se.expr);
tmp = build (LE_EXPR, boolean_type_node, tmp, integer_minus_one_node);
tmp = build (LE_EXPR, boolean_type_node,
tmp, convert (TREE_TYPE (tmp), integer_minus_one_node));
gfc_trans_runtime_check (tmp, msg, &se.pre);
gfc_add_modify_expr (&se.pre, io, GFC_DECL_ASSIGN_ADDR (se.expr));
gfc_add_modify_expr (&se.pre, len, GFC_DECL_STRING_LEN (se.expr));
@ -418,7 +419,7 @@ set_string (stmtblock_t * block, stmtblock_t * postblock, tree var,
else
{
gfc_conv_string_parameter (&se);
gfc_add_modify_expr (&se.pre, io, se.expr);
gfc_add_modify_expr (&se.pre, io, fold_convert (TREE_TYPE (io), se.expr));
gfc_add_modify_expr (&se.pre, len, se.string_length);
}
@ -432,10 +433,10 @@ set_string (stmtblock_t * block, stmtblock_t * postblock, tree var,
static void
set_flag (stmtblock_t *block, tree var)
{
tree tmp;
tree tmp, type = TREE_TYPE (var);
tmp = build (COMPONENT_REF, TREE_TYPE(var), ioparm_var, var, NULL_TREE);
gfc_add_modify_expr (block, tmp, integer_one_node);
tmp = build (COMPONENT_REF, type, ioparm_var, var, NULL_TREE);
gfc_add_modify_expr (block, tmp, convert (type, integer_one_node));
}

128
gcc/fortran/trans-stmt.c
View file

@ -615,7 +615,7 @@ gfc_trans_do (gfc_code * code)
gfc_add_modify_expr (&body, dovar, tmp);
/* Decrement the loop count. */
tmp = build (MINUS_EXPR, type, count, integer_one_node);
tmp = build (MINUS_EXPR, type, count, gfc_index_one_node);
gfc_add_modify_expr (&body, count, tmp);
/* End of loop body. */
@ -1240,13 +1240,13 @@ gfc_trans_forall_loop (forall_info *forall_tmp, int nvar, tree body, int mask_fl
maskindex = forall_tmp->maskindex;
if (mask)
{
tmp = build (PLUS_EXPR, gfc_array_index_type, maskindex,
integer_one_node);
tmp = build (PLUS_EXPR, gfc_array_index_type,
maskindex, gfc_index_one_node);
gfc_add_modify_expr (&block, maskindex, tmp);
}
}
/* Decrement the loop counter. */
tmp = build (MINUS_EXPR, TREE_TYPE (var), count, integer_one_node);
tmp = build (MINUS_EXPR, TREE_TYPE (var), count, gfc_index_one_node);
gfc_add_modify_expr (&block, count, tmp);
body = gfc_finish_block (&block);
@ -1348,12 +1348,12 @@ gfc_do_allocate (tree bytesize, tree size, tree * pdata, stmtblock_t * pblock,
if (INTEGER_CST_P (size))
{
tmp = fold (build (MINUS_EXPR, gfc_array_index_type, size,
integer_one_node));
gfc_index_one_node));
}
else
tmp = NULL_TREE;
type = build_range_type (gfc_array_index_type, integer_zero_node, tmp);
type = build_range_type (gfc_array_index_type, gfc_index_zero_node, tmp);
type = build_array_type (elem_type, type);
if (gfc_can_put_var_on_stack (bytesize))
{
@ -1438,7 +1438,7 @@ generate_loop_for_temp_to_lhs (gfc_expr *expr, tree tmp1, tree size,
gfc_mark_ss_chain_used (lss, 1);
/* Initialize count2. */
gfc_add_modify_expr (&block, count2, integer_zero_node);
gfc_add_modify_expr (&block, count2, gfc_index_zero_node);
/* Start the scalarized loop body. */
gfc_start_scalarized_body (&loop1, &body);
@ -1480,15 +1480,15 @@ generate_loop_for_temp_to_lhs (gfc_expr *expr, tree tmp1, tree size,
gfc_add_expr_to_block (&body, tmp);
/* Increment count2. */
tmp = fold (build (PLUS_EXPR, TREE_TYPE (count2), count2,
integer_one_node));
tmp = fold (build (PLUS_EXPR, gfc_array_index_type,
count2, gfc_index_one_node));
gfc_add_modify_expr (&body, count2, tmp);
/* Increment count3. */
if (count3)
{
tmp = fold (build (PLUS_EXPR, TREE_TYPE (count3), count3,
integer_one_node));
tmp = fold (build (PLUS_EXPR, gfc_array_index_type,
count3, gfc_index_one_node));
gfc_add_modify_expr (&body, count3, tmp);
}
@ -1537,7 +1537,7 @@ generate_loop_for_rhs_to_temp (gfc_expr *expr2, tree tmp1, tree size,
else
{
/* Initilize count2. */
gfc_add_modify_expr (&block, count2, integer_zero_node);
gfc_add_modify_expr (&block, count2, gfc_index_zero_node);
/* Initiliaze the loop. */
gfc_init_loopinfo (&loop);
@ -1592,15 +1592,15 @@ generate_loop_for_rhs_to_temp (gfc_expr *expr2, tree tmp1, tree size,
else
{
/* Increment count2. */
tmp = fold (build (PLUS_EXPR, gfc_array_index_type, count2,
integer_one_node));
tmp = fold (build (PLUS_EXPR, gfc_array_index_type,
count2, gfc_index_one_node));
gfc_add_modify_expr (&body1, count2, tmp);
/* Increment count3. */
if (count3)
{
tmp = fold (build (PLUS_EXPR, gfc_array_index_type, count3,
integer_one_node));
tmp = fold (build (PLUS_EXPR, gfc_array_index_type,
count3, gfc_index_one_node));
gfc_add_modify_expr (&body1, count3, tmp);
}
@ -1639,7 +1639,7 @@ compute_inner_temp_size (gfc_expr *expr1, gfc_expr *expr2,
*lss = gfc_walk_expr (expr1);
*rss = NULL;
size = integer_one_node;
size = gfc_index_one_node;
if (*lss != gfc_ss_terminator)
{
gfc_init_loopinfo (&loop);
@ -1672,10 +1672,11 @@ compute_inner_temp_size (gfc_expr *expr1, gfc_expr *expr2,
/* Figure out how many elements we need. */
for (i = 0; i < loop.dimen; i++)
{
tmp = fold (build (MINUS_EXPR, TREE_TYPE (loop.from[i]),
integer_one_node, loop.from[i]));
tmp = fold (build (PLUS_EXPR, TREE_TYPE (tmp), tmp, loop.to[i]));
size = fold (build (MULT_EXPR, TREE_TYPE (size), size, tmp));
tmp = fold (build (MINUS_EXPR, gfc_array_index_type,
gfc_index_one_node, loop.from[i]));
tmp = fold (build (PLUS_EXPR, gfc_array_index_type,
tmp, loop.to[i]));
size = fold (build (MULT_EXPR, gfc_array_index_type, size, tmp));
}
gfc_add_block_to_block (pblock, &loop.pre);
size = gfc_evaluate_now (size, pblock);
@ -1700,7 +1701,7 @@ compute_overall_iter_number (forall_info *nested_forall_info, tree inner_size,
/* TODO: optimizing the computing process. */
number = gfc_create_var (gfc_array_index_type, "num");
gfc_add_modify_expr (block, number, integer_zero_node);
gfc_add_modify_expr (block, number, gfc_index_zero_node);
gfc_start_block (&body);
if (nested_forall_info)
@ -1778,13 +1779,13 @@ gfc_trans_assign_need_temp (gfc_expr * expr1, gfc_expr * expr2, tree wheremask,
if (wheremask)
{
count = gfc_create_var (gfc_array_index_type, "count");
gfc_add_modify_expr (block, count, integer_zero_node);
gfc_add_modify_expr (block, count, gfc_index_zero_node);
}
else
count = NULL;
/* Initialize count1. */
gfc_add_modify_expr (block, count1, integer_zero_node);
gfc_add_modify_expr (block, count1, gfc_index_zero_node);
/* Calculate the size of temporary needed in the assignment. Return loop, lss
and rss which are used in function generate_loop_for_rhs_to_temp(). */
@ -1805,7 +1806,7 @@ gfc_trans_assign_need_temp (gfc_expr * expr1, gfc_expr * expr2, tree wheremask,
mask = forall_tmp->mask;
maskindex = forall_tmp->maskindex;
if (mask)
gfc_add_modify_expr (block, maskindex, integer_zero_node);
gfc_add_modify_expr (block, maskindex, gfc_index_zero_node);
forall_tmp = forall_tmp->next_nest;
}
@ -1819,7 +1820,7 @@ gfc_trans_assign_need_temp (gfc_expr * expr1, gfc_expr * expr2, tree wheremask,
gfc_add_expr_to_block (block, tmp);
/* Reset count1. */
gfc_add_modify_expr (block, count1, integer_zero_node);
gfc_add_modify_expr (block, count1, gfc_index_zero_node);
/* Reset maskindexed. */
forall_tmp = nested_forall_info;
@ -1828,13 +1829,13 @@ gfc_trans_assign_need_temp (gfc_expr * expr1, gfc_expr * expr2, tree wheremask,
mask = forall_tmp->mask;
maskindex = forall_tmp->maskindex;
if (mask)
gfc_add_modify_expr (block, maskindex, integer_zero_node);
gfc_add_modify_expr (block, maskindex, gfc_index_zero_node);
forall_tmp = forall_tmp->next_nest;
}
/* Reset count. */
if (wheremask)
gfc_add_modify_expr (block, count, integer_zero_node);
gfc_add_modify_expr (block, count, gfc_index_zero_node);
/* Generate codes to copy the temporary to lhs. */
tmp = generate_loop_for_temp_to_lhs (expr1, tmp1, inner_size, count,
@ -1879,7 +1880,7 @@ gfc_trans_pointer_assign_need_temp (gfc_expr * expr1, gfc_expr * expr2,
forall_info *forall_tmp;
count = gfc_create_var (gfc_array_index_type, "count");
gfc_add_modify_expr (block, count, integer_zero_node);
gfc_add_modify_expr (block, count, gfc_index_zero_node);
inner_size = integer_one_node;
lss = gfc_walk_expr (expr1);
@ -1904,8 +1905,8 @@ gfc_trans_pointer_assign_need_temp (gfc_expr * expr1, gfc_expr * expr2,
gfc_add_block_to_block (&body, &rse.post);
/* Increment count. */
tmp = fold (build (PLUS_EXPR, TREE_TYPE (count), count,
integer_one_node));
tmp = fold (build (PLUS_EXPR, gfc_array_index_type,
count, gfc_index_one_node));
gfc_add_modify_expr (&body, count, tmp);
tmp = gfc_finish_block (&body);
@ -1917,7 +1918,7 @@ gfc_trans_pointer_assign_need_temp (gfc_expr * expr1, gfc_expr * expr2,
mask = forall_tmp->mask;
maskindex = forall_tmp->maskindex;
if (mask)
gfc_add_modify_expr (block, maskindex, integer_zero_node);
gfc_add_modify_expr (block, maskindex, gfc_index_zero_node);
forall_tmp = forall_tmp->next_nest;
}
@ -1927,7 +1928,7 @@ gfc_trans_pointer_assign_need_temp (gfc_expr * expr1, gfc_expr * expr2,
gfc_add_expr_to_block (block, tmp);
/* Reset count. */
gfc_add_modify_expr (block, count, integer_zero_node);
gfc_add_modify_expr (block, count, gfc_index_zero_node);
/* Reset maskindexes. */
forall_tmp = nested_forall_info;
@ -1936,7 +1937,7 @@ gfc_trans_pointer_assign_need_temp (gfc_expr * expr1, gfc_expr * expr2,
mask = forall_tmp->mask;
maskindex = forall_tmp->maskindex;
if (mask)
gfc_add_modify_expr (block, maskindex, integer_zero_node);
gfc_add_modify_expr (block, maskindex, gfc_index_zero_node);
forall_tmp = forall_tmp->next_nest;
}
gfc_start_block (&body);
@ -1949,8 +1950,8 @@ gfc_trans_pointer_assign_need_temp (gfc_expr * expr1, gfc_expr * expr2,
gfc_add_modify_expr (&body, lse.expr, rse.expr);
gfc_add_block_to_block (&body, &lse.post);
/* Increment count. */
tmp = fold (build (PLUS_EXPR, TREE_TYPE (count), count,
integer_one_node));
tmp = fold (build (PLUS_EXPR, gfc_array_index_type,
count, gfc_index_one_node));
gfc_add_modify_expr (&body, count, tmp);
tmp = gfc_finish_block (&body);
@ -1993,8 +1994,8 @@ gfc_trans_pointer_assign_need_temp (gfc_expr * expr1, gfc_expr * expr2,
gfc_add_block_to_block (&body, &lse.post);
/* Increment count. */
tmp = fold (build (PLUS_EXPR, TREE_TYPE (count), count,
integer_one_node));
tmp = fold (build (PLUS_EXPR, gfc_array_index_type,
count, gfc_index_one_node));
gfc_add_modify_expr (&body, count, tmp);
tmp = gfc_finish_block (&body);
@ -2006,7 +2007,7 @@ gfc_trans_pointer_assign_need_temp (gfc_expr * expr1, gfc_expr * expr2,
mask = forall_tmp->mask;
maskindex = forall_tmp->maskindex;
if (mask)
gfc_add_modify_expr (block, maskindex, integer_zero_node);
gfc_add_modify_expr (block, maskindex, gfc_index_zero_node);
forall_tmp = forall_tmp->next_nest;
}
@ -2016,7 +2017,7 @@ gfc_trans_pointer_assign_need_temp (gfc_expr * expr1, gfc_expr * expr2,
gfc_add_expr_to_block (block, tmp);
/* Reset count. */
gfc_add_modify_expr (block, count, integer_zero_node);
gfc_add_modify_expr (block, count, gfc_index_zero_node);
/* Reset maskindexes. */
forall_tmp = nested_forall_info;
@ -2025,7 +2026,7 @@ gfc_trans_pointer_assign_need_temp (gfc_expr * expr1, gfc_expr * expr2,
mask = forall_tmp->mask;
maskindex = forall_tmp->maskindex;
if (mask)
gfc_add_modify_expr (block, maskindex, integer_zero_node);
gfc_add_modify_expr (block, maskindex, gfc_index_zero_node);
forall_tmp = forall_tmp->next_nest;
}
parm = gfc_build_array_ref (tmp1, count);
@ -2038,8 +2039,8 @@ gfc_trans_pointer_assign_need_temp (gfc_expr * expr1, gfc_expr * expr2,
gfc_add_block_to_block (&body, &lse.post);
/* Increment count. */
tmp = fold (build (PLUS_EXPR, TREE_TYPE (count), count,
integer_one_node));
tmp = fold (build (PLUS_EXPR, gfc_array_index_type,
count, gfc_index_one_node));
gfc_add_modify_expr (&body, count, tmp);
tmp = gfc_finish_block (&body);
@ -2207,7 +2208,7 @@ gfc_trans_forall_1 (gfc_code * code, forall_info * nested_forall_info)
/* Work out the number of elements in the mask array. */
tmpvar = NULL_TREE;
lenvar = NULL_TREE;
size = integer_one_node;
size = gfc_index_one_node;
sizevar = NULL_TREE;
for (n = 0; n < nvar; n++)
@ -2257,7 +2258,7 @@ gfc_trans_forall_1 (gfc_code * code, forall_info * nested_forall_info)
info->mask = mask;
info->maskindex = maskindex;
gfc_add_modify_expr (&block, maskindex, integer_zero_node);
gfc_add_modify_expr (&block, maskindex, gfc_index_zero_node);
/* Start of mask assignment loop body. */
gfc_start_block (&body);
@ -2278,8 +2279,8 @@ gfc_trans_forall_1 (gfc_code * code, forall_info * nested_forall_info)
gfc_add_modify_expr (&body, tmp, se.expr);
/* Advance to the next mask element. */
tmp = build (PLUS_EXPR, gfc_array_index_type, maskindex,
integer_one_node);
tmp = build (PLUS_EXPR, gfc_array_index_type,
maskindex, gfc_index_one_node);
gfc_add_modify_expr (&body, maskindex, tmp);
/* Generate the loops. */
@ -2317,7 +2318,7 @@ gfc_trans_forall_1 (gfc_code * code, forall_info * nested_forall_info)
/* Reset the mask index. */
if (mask)
gfc_add_modify_expr (&block, maskindex, integer_zero_node);
gfc_add_modify_expr (&block, maskindex, gfc_index_zero_node);
/* Generate body and loops. */
tmp = gfc_trans_nested_forall_loop (nested_forall_info, assign, 1, 1);
@ -2362,7 +2363,7 @@ gfc_trans_forall_1 (gfc_code * code, forall_info * nested_forall_info)
/* Reset the mask index. */
if (mask)
gfc_add_modify_expr (&block, maskindex, integer_zero_node);
gfc_add_modify_expr (&block, maskindex, gfc_index_zero_node);
/* Generate body and loops. */
tmp = gfc_trans_nested_forall_loop (nested_forall_info, assign,
@ -2478,7 +2479,7 @@ gfc_evaluate_where_mask (gfc_expr * me, forall_info * nested_forall_info,
/* Variable to index the temporary. */
count = gfc_create_var (gfc_array_index_type, "count");
/* Initilize count. */
gfc_add_modify_expr (block, count, integer_zero_node);
gfc_add_modify_expr (block, count, gfc_index_zero_node);
gfc_start_block (&body);
@ -2530,7 +2531,7 @@ gfc_evaluate_where_mask (gfc_expr * me, forall_info * nested_forall_info,
{
/* Increment count. */
tmp1 = fold (build (PLUS_EXPR, gfc_array_index_type, count,
integer_one_node));
gfc_index_one_node));
gfc_add_modify_expr (&body1, count, tmp1);
/* Generate the copying loops. */
@ -2696,8 +2697,8 @@ gfc_trans_where_assign (gfc_expr *expr1, gfc_expr *expr2, tree mask,
if (lss == gfc_ss_terminator)
{
/* Increment count1. */
tmp = fold (build (PLUS_EXPR, TREE_TYPE (count1), count1,
integer_one_node));
tmp = fold (build (PLUS_EXPR, gfc_array_index_type,
count1, gfc_index_one_node));
gfc_add_modify_expr (&body, count1, tmp);
/* Use the scalar assignment as is. */
@ -2714,8 +2715,8 @@ gfc_trans_where_assign (gfc_expr *expr1, gfc_expr *expr2, tree mask,
{
/* Increment count1 before finish the main body of a scalarized
expression. */
tmp = fold (build (PLUS_EXPR, TREE_TYPE (count1), count1,
integer_one_node));
tmp = fold (build (PLUS_EXPR, gfc_array_index_type,
count1, gfc_index_one_node));
gfc_add_modify_expr (&body, count1, tmp);
gfc_trans_scalarized_loop_boundary (&loop, &body);
@ -2758,16 +2759,17 @@ gfc_trans_where_assign (gfc_expr *expr1, gfc_expr *expr2, tree mask,
tmp = gfc_trans_scalar_assign (&lse, &rse, expr1->ts.type);
tmp = build_v (COND_EXPR, maskexpr, tmp, build_empty_stmt ());
gfc_add_expr_to_block (&body, tmp);
/* Increment count2. */
tmp = fold (build (PLUS_EXPR, TREE_TYPE (count2), count2,
integer_one_node));
tmp = fold (build (PLUS_EXPR, gfc_array_index_type,
count2, gfc_index_one_node));
gfc_add_modify_expr (&body, count2, tmp);
}
else
{
/* Increment count1. */
tmp = fold (build (PLUS_EXPR, TREE_TYPE (count1), count1,
integer_one_node));
tmp = fold (build (PLUS_EXPR, gfc_array_index_type,
count1, gfc_index_one_node));
gfc_add_modify_expr (&body, count1, tmp);
}
@ -2876,8 +2878,8 @@ gfc_trans_where_2 (gfc_code * code, tree mask, tree pmask,
/* Variables to control maskexpr. */
count1 = gfc_create_var (gfc_array_index_type, "count1");
count2 = gfc_create_var (gfc_array_index_type, "count2");
gfc_add_modify_expr (block, count1, integer_zero_node);
gfc_add_modify_expr (block, count2, integer_zero_node);
gfc_add_modify_expr (block, count1, gfc_index_zero_node);
gfc_add_modify_expr (block, count2, gfc_index_zero_node);
tmp = gfc_trans_where_assign (expr1, expr2, mask, count1,
count2);
@ -2891,8 +2893,8 @@ gfc_trans_where_2 (gfc_code * code, tree mask, tree pmask,
/* Variables to control maskexpr. */
count1 = gfc_create_var (gfc_array_index_type, "count1");
count2 = gfc_create_var (gfc_array_index_type, "count2");
gfc_add_modify_expr (block, count1, integer_zero_node);
gfc_add_modify_expr (block, count2, integer_zero_node);
gfc_add_modify_expr (block, count1, gfc_index_zero_node);
gfc_add_modify_expr (block, count2, gfc_index_zero_node);
tmp = gfc_trans_where_assign (expr1, expr2, mask, count1,
count2);

16
gcc/fortran/trans-types.c
View file

@ -290,7 +290,7 @@ gfc_get_character_type (int kind, gfc_charlen * cl)
len = (cl == 0) ? NULL_TREE : cl->backend_decl;
bounds = build_range_type (gfc_array_index_type, integer_one_node, len);
bounds = build_range_type (gfc_array_index_type, gfc_index_one_node, len);
type = build_array_type (base, bounds);
TYPE_STRING_FLAG (type) = 1;
@ -493,7 +493,7 @@ gfc_build_array_type (tree type, gfc_array_spec * as)
{
/* Create expressions for the known bounds of the array. */
if (as->type == AS_ASSUMED_SHAPE && as->lower[n] == NULL)
lbound[n] = integer_one_node;
lbound[n] = gfc_index_one_node;
else
lbound[n] = gfc_conv_array_bound (as->lower[n]);
ubound[n] = gfc_conv_array_bound (as->upper[n]);
@ -727,7 +727,7 @@ gfc_get_nodesc_array_type (tree etype, gfc_array_spec * as, int packed)
GFC_TYPE_ARRAY_DTYPE (type) = gfc_get_dtype (etype, as->rank);
GFC_TYPE_ARRAY_RANK (type) = as->rank;
range = build_range_type (gfc_array_index_type, integer_zero_node,
range = build_range_type (gfc_array_index_type, gfc_index_zero_node,
NULL_TREE);
/* TODO: use main type if it is unbounded. */
GFC_TYPE_ARRAY_DATAPTR_TYPE (type) =
@ -741,7 +741,7 @@ gfc_get_nodesc_array_type (tree etype, gfc_array_spec * as, int packed)
else
range = NULL_TREE;
range = build_range_type (gfc_array_index_type, integer_zero_node, range);
range = build_range_type (gfc_array_index_type, gfc_index_zero_node, range);
TYPE_DOMAIN (type) = range;
build_pointer_type (etype);
@ -806,7 +806,7 @@ gfc_get_array_type_bounds (tree etype, int dimen, tree * lbound,
/* Build an array descriptor record type. */
if (packed != 0)
stride = integer_one_node;
stride = gfc_index_one_node;
else
stride = NULL_TREE;
@ -840,7 +840,7 @@ gfc_get_array_type_bounds (tree etype, int dimen, tree * lbound,
{
tmp = fold (build (MINUS_EXPR, gfc_array_index_type, upper, lower));
tmp = fold (build (PLUS_EXPR, gfc_array_index_type, tmp,
integer_one_node));
gfc_index_one_node));
stride =
fold (build (MULT_EXPR, gfc_array_index_type, tmp, stride));
/* Check the folding worked. */
@ -858,7 +858,7 @@ gfc_get_array_type_bounds (tree etype, int dimen, tree * lbound,
arraytype =
build_array_type (etype,
build_range_type (gfc_array_index_type,
integer_zero_node, NULL_TREE));
gfc_index_zero_node, NULL_TREE));
arraytype = build_pointer_type (arraytype);
GFC_TYPE_ARRAY_DATAPTR_TYPE (fat_type) = arraytype;
@ -885,7 +885,7 @@ gfc_get_array_type_bounds (tree etype, int dimen, tree * lbound,
arraytype =
build_array_type (gfc_get_desc_dim_type (),
build_range_type (gfc_array_index_type,
integer_zero_node,
gfc_index_zero_node,
gfc_rank_cst[dimen - 1]));
decl = build_decl (FIELD_DECL, get_identifier ("dim"), arraytype);

10
gcc/fortran/trans.c
View file

@ -146,6 +146,16 @@ gfc_add_modify_expr (stmtblock_t * pblock, tree lhs, tree rhs)
{
tree tmp;
#ifdef ENABLE_CHECKING
/* Make sure that the types of the rhs and the lhs are the same
for scalar assignments. We should probably have something
similar for aggregates, but right now removing that check just
breaks everything. */
if (TREE_TYPE (rhs) != TREE_TYPE (lhs)
&& !AGGREGATE_TYPE_P (TREE_TYPE (lhs)))
abort ();
#endif
tmp = fold (build_v (MODIFY_EXPR, lhs, rhs));
gfc_add_expr_to_block (pblock, tmp);
}