+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.
/* 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);
{
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;
}
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. */
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);
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. */
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
{
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));
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,
/* 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;
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++)
/* 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. */
/* 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);
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;
/* 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. */
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;
}
}
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);
/* 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]);
}
else
{
- se.expr = integer_one_node;
+ se.expr = gfc_index_one_node;
ubound = lower[n];
}
}
/* 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);
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. */
{
/* 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)
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);
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
}
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++)
{
/* 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,
}
-/* 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. */
/* 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);
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
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;
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);
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)
{
/* 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);
/* 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]
|| 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));
}
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. */
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);
}
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);
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;
}
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);
/* 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);
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));
}
}
}
gfc_ss *lss;
gfc_ss *rss;
stmtblock_t block;
- tree tmp;
gfc_start_block (&block);
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);
}
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
{
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);
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;
}
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. */
{
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));
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);
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);
/* 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);
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,
/* 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);
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);
}
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
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);
}
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);
}
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. */
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);
}
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
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;
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 ());
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));
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);
}
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));
}
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. */
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);
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))
{
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);
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);
}
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);
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);
}
*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);
/* 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);
/* 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)
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(). */
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_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;
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,
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);
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);
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_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;
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);
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);
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);
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_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;
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);
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);
/* 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++)
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);
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. */
/* 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);
/* 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,
/* 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);
{
/* 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. */
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. */
{
/* 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);
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);
}
/* 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);
/* 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);
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;
{
/* 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]);
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) =
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);
/* Build an array descriptor record type. */
if (packed != 0)
- stride = integer_one_node;
+ stride = gfc_index_one_node;
else
stride = NULL_TREE;
{
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. */
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;
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);
{
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);
}
projects / gcc.git / commitdiff