Commit 44855d8c by Tobias Schlüter

trans-array.c (gfc_conv_descriptor_data_get, [...]): Use fold_buildN instead of buildN.

* trans-array.c (gfc_conv_descriptor_data_get,
gfc_conv_descriptor_data_set_internal,
gfc_conv_descriptor_data_addr, gfc_conv_descriptor_offset,
gfc_conv_descriptor_dtype, gfc_conv_descriptor_dimension,
gfc_conv_descriptor_stride, gfc_conv_descriptor_lbound,
gfc_conv_descriptor_ubound, gfc_trans_create_temp_array,
gfc_conv_array_transpose, gfc_grow_array,
gfc_trans_array_constructor_subarray,
gfc_trans_array_constructor_value, gfc_trans_scalarized_loop_end,
gfc_array_init_size, gfc_array_allocate, gfc_array_deallocate,
gfc_conv_array_initializer, gfc_trans_array_bounds,
gfc_trans_auto_array_allocation, gfc_trans_dummy_array_bias,
gfc_get_dataptr_offset, gfc_conv_array_parameter,
gfc_trans_dealloc_allocated, get_full_array_size,
gfc_duplicate_allocatable, structure_alloc_comps): Use fold_buildN
instead of buildN.
* trans-expr.c (gfc_conv_expr_present, gfc_conv_missing_dummy,
gfc_conv_component_ref, gfc_conv_cst_int_power,
gfc_conv_function_call, gfc_trans_structur_assign): Likewise.
* trans-common.c (create_common): Likewise.
* trans-openmp.c (gfc_trans_omp_atomic, gfc_trans_omp_do):
Likewise.
* trans-const.c (gfc_conv_constant_to_tree): Likewise.
* trans-stmt.c (gfc_trans_goto, gfc_trans_return, gfc_trans_do,
gfc_trans_integer_select, gfc_trans_character_select,
gfc_trans_forall_loop, compute_overall_iter_number,
gfc_trans_forall_1, gfc_evaluate_where_mask, gfc_trans_allocate,
gfc_trans_deallocate): Likewise.
* trans.c (gfc_build_addr_expr, gfc_trans_runtime_check,
gfc_allocate_with_status, gfc_allocate_array_with_status,
gfc_deallocate_with_status): Likewise.
* f95-lang.c (gfc_truthvalue_conversion): Likewise.
* trans-io.c (set_parameter_const, set_parameter_value,
set_parameter_ref, set_string, set_internal_unit, io_result,
set_error_locus, nml_get_addr_expr, transfer_expr): Likewise.
* trans-decl.c (gfc_build_qualified_array, build_entry_thunks,
gfc_get_fake_result_decl, gfc_trans_auto_character_variable,
gfc_generate_function_code): Likewise.
* convert.c (convert): Likewise.
* trans-intrinsic.c (gfc_conv_intrinsic_conversion,
build_fixbound_expr, build_fix_expr, gfc_conv_intrinsic_aint,
gfc_conv_intrinsic_int, gfc_conv_intrinsic_imagpart,
gfc_conv_intrinsic_conjg, gfc_conv_intrinsic_abs,
gfc_conv_intrinsic_cmplx, gfc_conv_intrinsic_mod,
gfc_conv_intrinsic_dim, gfc_conv_intrinsic_dprod,
gfc_conv_intrinsic_ctime, gfc_conv_intrinsic_fdate,
gfc_conv_intrinsic_ttynam, gfc_conv_intrinsic_minmax,
gfc_conv_intrinsic_minmax_char, gfc_conv_intrinsic_count,
gfc_conv_intrinsic_arith, gfc_conv_intrinsic_dot_product,
gfc_conv_intrinsic_minmaxloc, gfc_conv_intrinsic_minmaxval,
gfc_conv_intrinsic_btest, gfc_conv_intrinsic_not,
gfc_conv_intrinsic_ibits, gfc_conv_intrinsic_ishft,
gfc_conv_intrinsic_ichar, gfc_conv_intrinsic_size,
gfc_conv_intrinsic_array_transfer, gfc_conv_intrinsic_transfer,
gfc_conv_allocated, gfc_conv_associated, gfc_conv_intrinsic_trim,
gfc_conv_intrinsic_repeat): Likewise.

From-SVN: r132592
parent faebccf9
/* Language-level data type conversion for GNU C. /* Language-level data type conversion for GNU C.
Copyright (C) 1987, 1988, 1991, 1998, 2002, 2007 Copyright (C) 1987, 1988, 1991, 1998, 2002, 2007, 2008
Free Software Foundation, Inc. Free Software Foundation, Inc.
This file is part of GCC. This file is part of GCC.
...@@ -89,7 +89,7 @@ convert (tree type, tree expr) ...@@ -89,7 +89,7 @@ convert (tree type, tree expr)
return error_mark_node; return error_mark_node;
} }
if (code == VOID_TYPE) if (code == VOID_TYPE)
return build1 (CONVERT_EXPR, type, e); return fold_build1 (CONVERT_EXPR, type, e);
#if 0 #if 0
/* This is incorrect. A truncation can't be stripped this way. /* This is incorrect. A truncation can't be stripped this way.
Extensions will be stripped by the use of get_unwidened. */ Extensions will be stripped by the use of get_unwidened. */
......
/* gfortran backend interface /* gfortran backend interface
Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007 Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
Free Software Foundation, Inc. Free Software Foundation, Inc.
Contributed by Paul Brook. Contributed by Paul Brook.
...@@ -220,16 +220,17 @@ gfc_truthvalue_conversion (tree expr) ...@@ -220,16 +220,17 @@ gfc_truthvalue_conversion (tree expr)
return expr; return expr;
} }
else if (TREE_CODE (expr) == NOP_EXPR) else if (TREE_CODE (expr) == NOP_EXPR)
return build1 (NOP_EXPR, boolean_type_node, TREE_OPERAND (expr, 0)); return fold_build1 (NOP_EXPR,
boolean_type_node, TREE_OPERAND (expr, 0));
else else
return build1 (NOP_EXPR, boolean_type_node, expr); return fold_build1 (NOP_EXPR, boolean_type_node, expr);
case INTEGER_TYPE: case INTEGER_TYPE:
if (TREE_CODE (expr) == INTEGER_CST) if (TREE_CODE (expr) == INTEGER_CST)
return integer_zerop (expr) ? boolean_false_node : boolean_true_node; return integer_zerop (expr) ? boolean_false_node : boolean_true_node;
else else
return build2 (NE_EXPR, boolean_type_node, expr, return fold_build2 (NE_EXPR, boolean_type_node, expr,
build_int_cst (TREE_TYPE (expr), 0)); build_int_cst (TREE_TYPE (expr), 0));
default: default:
internal_error ("Unexpected type in truthvalue_conversion"); internal_error ("Unexpected type in truthvalue_conversion");
......
/* Common block and equivalence list handling /* Common block and equivalence list handling
Copyright (C) 2000, 2003, 2004, 2005, 2006, 2007 Copyright (C) 2000, 2003, 2004, 2005, 2006, 2007, 2008
Free Software Foundation, Inc. Free Software Foundation, Inc.
Contributed by Canqun Yang <canqun@nudt.edu.cn> Contributed by Canqun Yang <canqun@nudt.edu.cn>
...@@ -693,8 +693,8 @@ create_common (gfc_common_head *com, segment_info *head, bool saw_equiv) ...@@ -693,8 +693,8 @@ create_common (gfc_common_head *com, segment_info *head, bool saw_equiv)
gfc_add_decl_to_function (var_decl); gfc_add_decl_to_function (var_decl);
SET_DECL_VALUE_EXPR (var_decl, SET_DECL_VALUE_EXPR (var_decl,
build3 (COMPONENT_REF, TREE_TYPE (s->field), fold_build3 (COMPONENT_REF, TREE_TYPE (s->field),
decl, s->field, NULL_TREE)); decl, s->field, NULL_TREE));
DECL_HAS_VALUE_EXPR_P (var_decl) = 1; DECL_HAS_VALUE_EXPR_P (var_decl) = 1;
GFC_DECL_COMMON_OR_EQUIV (var_decl) = 1; GFC_DECL_COMMON_OR_EQUIV (var_decl) = 1;
......
/* Translation of constants /* Translation of constants
Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007 Free Software Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software
Foundation, Inc. Foundation, Inc.
Contributed by Paul Brook Contributed by Paul Brook
...@@ -215,38 +215,38 @@ gfc_conv_constant_to_tree (gfc_expr * expr) ...@@ -215,38 +215,38 @@ gfc_conv_constant_to_tree (gfc_expr * expr)
{ {
case BT_INTEGER: case BT_INTEGER:
if (expr->representation.string) if (expr->representation.string)
return build1 (VIEW_CONVERT_EXPR, return fold_build1 (VIEW_CONVERT_EXPR,
gfc_get_int_type (expr->ts.kind), gfc_get_int_type (expr->ts.kind),
gfc_build_string_const (expr->representation.length, gfc_build_string_const (expr->representation.length,
expr->representation.string)); expr->representation.string));
else else
return gfc_conv_mpz_to_tree (expr->value.integer, expr->ts.kind); return gfc_conv_mpz_to_tree (expr->value.integer, expr->ts.kind);
case BT_REAL: case BT_REAL:
if (expr->representation.string) if (expr->representation.string)
return build1 (VIEW_CONVERT_EXPR, return fold_build1 (VIEW_CONVERT_EXPR,
gfc_get_real_type (expr->ts.kind), gfc_get_real_type (expr->ts.kind),
gfc_build_string_const (expr->representation.length, gfc_build_string_const (expr->representation.length,
expr->representation.string)); expr->representation.string));
else else
return gfc_conv_mpfr_to_tree (expr->value.real, expr->ts.kind); return gfc_conv_mpfr_to_tree (expr->value.real, expr->ts.kind);
case BT_LOGICAL: case BT_LOGICAL:
if (expr->representation.string) if (expr->representation.string)
return build1 (VIEW_CONVERT_EXPR, return fold_build1 (VIEW_CONVERT_EXPR,
gfc_get_logical_type (expr->ts.kind), gfc_get_logical_type (expr->ts.kind),
gfc_build_string_const (expr->representation.length, gfc_build_string_const (expr->representation.length,
expr->representation.string)); expr->representation.string));
else else
return build_int_cst (gfc_get_logical_type (expr->ts.kind), return build_int_cst (gfc_get_logical_type (expr->ts.kind),
expr->value.logical); expr->value.logical);
case BT_COMPLEX: case BT_COMPLEX:
if (expr->representation.string) if (expr->representation.string)
return build1 (VIEW_CONVERT_EXPR, return fold_build1 (VIEW_CONVERT_EXPR,
gfc_get_complex_type (expr->ts.kind), gfc_get_complex_type (expr->ts.kind),
gfc_build_string_const (expr->representation.length, gfc_build_string_const (expr->representation.length,
expr->representation.string)); expr->representation.string));
else else
{ {
tree real = gfc_conv_mpfr_to_tree (expr->value.complex.r, tree real = gfc_conv_mpfr_to_tree (expr->value.complex.r,
......
/* Backend function setup /* Backend function setup
Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007 Free Software Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software
Foundation, Inc. Foundation, Inc.
Contributed by Paul Brook Contributed by Paul Brook
...@@ -689,8 +689,8 @@ gfc_build_qualified_array (tree decl, gfc_symbol * sym) ...@@ -689,8 +689,8 @@ gfc_build_qualified_array (tree decl, gfc_symbol * sym)
{ {
tree size, range; tree size, range;
size = build2 (MINUS_EXPR, gfc_array_index_type, size = fold_build2 (MINUS_EXPR, gfc_array_index_type,
GFC_TYPE_ARRAY_SIZE (type), gfc_index_one_node); GFC_TYPE_ARRAY_SIZE (type), gfc_index_one_node);
range = build_range_type (gfc_array_index_type, gfc_index_zero_node, range = build_range_type (gfc_array_index_type, gfc_index_zero_node,
size); size);
TYPE_DOMAIN (type) = range; TYPE_DOMAIN (type) = range;
...@@ -1729,9 +1729,8 @@ build_entry_thunks (gfc_namespace * ns) ...@@ -1729,9 +1729,8 @@ build_entry_thunks (gfc_namespace * ns)
pushdecl (union_decl); pushdecl (union_decl);
DECL_CONTEXT (union_decl) = current_function_decl; DECL_CONTEXT (union_decl) = current_function_decl;
tmp = build2 (MODIFY_EXPR, tmp = fold_build2 (MODIFY_EXPR, TREE_TYPE (union_decl),
TREE_TYPE (union_decl), union_decl, tmp);
union_decl, tmp);
gfc_add_expr_to_block (&body, tmp); gfc_add_expr_to_block (&body, tmp);
for (field = TYPE_FIELDS (TREE_TYPE (union_decl)); for (field = TYPE_FIELDS (TREE_TYPE (union_decl));
...@@ -1740,19 +1739,19 @@ build_entry_thunks (gfc_namespace * ns) ...@@ -1740,19 +1739,19 @@ build_entry_thunks (gfc_namespace * ns)
thunk_sym->result->name) == 0) thunk_sym->result->name) == 0)
break; break;
gcc_assert (field != NULL_TREE); gcc_assert (field != NULL_TREE);
tmp = build3 (COMPONENT_REF, TREE_TYPE (field), union_decl, field, tmp = fold_build3 (COMPONENT_REF, TREE_TYPE (field),
NULL_TREE); union_decl, field, NULL_TREE);
tmp = build2 (MODIFY_EXPR, tmp = fold_build2 (MODIFY_EXPR,
TREE_TYPE (DECL_RESULT (current_function_decl)), TREE_TYPE (DECL_RESULT (current_function_decl)),
DECL_RESULT (current_function_decl), tmp); DECL_RESULT (current_function_decl), tmp);
tmp = build1_v (RETURN_EXPR, tmp); tmp = build1_v (RETURN_EXPR, tmp);
} }
else if (TREE_TYPE (DECL_RESULT (current_function_decl)) else if (TREE_TYPE (DECL_RESULT (current_function_decl))
!= void_type_node) != void_type_node)
{ {
tmp = build2 (MODIFY_EXPR, tmp = fold_build2 (MODIFY_EXPR,
TREE_TYPE (DECL_RESULT (current_function_decl)), TREE_TYPE (DECL_RESULT (current_function_decl)),
DECL_RESULT (current_function_decl), tmp); DECL_RESULT (current_function_decl), tmp);
tmp = build1_v (RETURN_EXPR, tmp); tmp = build1_v (RETURN_EXPR, tmp);
} }
gfc_add_expr_to_block (&body, tmp); gfc_add_expr_to_block (&body, tmp);
...@@ -1874,8 +1873,8 @@ gfc_get_fake_result_decl (gfc_symbol * sym, int parent_flag) ...@@ -1874,8 +1873,8 @@ gfc_get_fake_result_decl (gfc_symbol * sym, int parent_flag)
break; break;
gcc_assert (field != NULL_TREE); gcc_assert (field != NULL_TREE);
decl = build3 (COMPONENT_REF, TREE_TYPE (field), decl, field, decl = fold_build3 (COMPONENT_REF, TREE_TYPE (field),
NULL_TREE); decl, field, NULL_TREE);
} }
var = create_tmp_var_raw (TREE_TYPE (decl), sym->name); var = create_tmp_var_raw (TREE_TYPE (decl), sym->name);
...@@ -2430,7 +2429,7 @@ gfc_trans_auto_character_variable (gfc_symbol * sym, tree fnbody) ...@@ -2430,7 +2429,7 @@ gfc_trans_auto_character_variable (gfc_symbol * sym, tree fnbody)
/* Emit a DECL_EXPR for this variable, which will cause the /* Emit a DECL_EXPR for this variable, which will cause the
gimplifier to allocate storage, and all that good stuff. */ gimplifier to allocate storage, and all that good stuff. */
tmp = build1 (DECL_EXPR, TREE_TYPE (decl), decl); tmp = fold_build1 (DECL_EXPR, TREE_TYPE (decl), decl);
gfc_add_expr_to_block (&body, tmp); gfc_add_expr_to_block (&body, tmp);
gfc_add_expr_to_block (&body, fnbody); gfc_add_expr_to_block (&body, fnbody);
...@@ -3318,8 +3317,8 @@ gfc_generate_function_code (gfc_namespace * ns) ...@@ -3318,8 +3317,8 @@ gfc_generate_function_code (gfc_namespace * ns)
types may be different for scalar default REAL functions types may be different for scalar default REAL functions
with -ff2c, therefore we have to convert. */ with -ff2c, therefore we have to convert. */
tmp = convert (TREE_TYPE (DECL_RESULT (fndecl)), result); tmp = convert (TREE_TYPE (DECL_RESULT (fndecl)), result);
tmp = build2 (MODIFY_EXPR, TREE_TYPE (tmp), tmp = fold_build2 (MODIFY_EXPR, TREE_TYPE (tmp),
DECL_RESULT (fndecl), tmp); DECL_RESULT (fndecl), tmp);
tmp = build1_v (RETURN_EXPR, tmp); tmp = build1_v (RETURN_EXPR, tmp);
gfc_add_expr_to_block (&block, tmp); gfc_add_expr_to_block (&block, tmp);
} }
......
/* Expression translation /* Expression translation
Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007 Free Software Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software
Foundation, Inc. Foundation, Inc.
Contributed by Paul Brook <paul@nowt.org> Contributed by Paul Brook <paul@nowt.org>
and Steven Bosscher <s.bosscher@student.tudelft.nl> and Steven Bosscher <s.bosscher@student.tudelft.nl>
...@@ -139,8 +139,8 @@ gfc_conv_expr_present (gfc_symbol * sym) ...@@ -139,8 +139,8 @@ gfc_conv_expr_present (gfc_symbol * sym)
|| GFC_ARRAY_TYPE_P (TREE_TYPE (decl))); || GFC_ARRAY_TYPE_P (TREE_TYPE (decl)));
decl = GFC_DECL_SAVED_DESCRIPTOR (decl); decl = GFC_DECL_SAVED_DESCRIPTOR (decl);
} }
return build2 (NE_EXPR, boolean_type_node, decl, return fold_build2 (NE_EXPR, boolean_type_node, decl,
fold_convert (TREE_TYPE (decl), null_pointer_node)); fold_convert (TREE_TYPE (decl), null_pointer_node));
} }
...@@ -176,8 +176,8 @@ gfc_conv_missing_dummy (gfc_se * se, gfc_expr * arg, gfc_typespec ts, int kind) ...@@ -176,8 +176,8 @@ gfc_conv_missing_dummy (gfc_se * se, gfc_expr * arg, gfc_typespec ts, int kind)
if (ts.type == BT_CHARACTER) if (ts.type == BT_CHARACTER)
{ {
tmp = build_int_cst (gfc_charlen_type_node, 0); tmp = build_int_cst (gfc_charlen_type_node, 0);
tmp = build3 (COND_EXPR, gfc_charlen_type_node, present, tmp = fold_build3 (COND_EXPR, gfc_charlen_type_node,
se->string_length, tmp); present, se->string_length, tmp);
tmp = gfc_evaluate_now (tmp, &se->pre); tmp = gfc_evaluate_now (tmp, &se->pre);
se->string_length = tmp; se->string_length = tmp;
} }
...@@ -378,7 +378,7 @@ gfc_conv_component_ref (gfc_se * se, gfc_ref * ref) ...@@ -378,7 +378,7 @@ gfc_conv_component_ref (gfc_se * se, gfc_ref * ref)
field = c->backend_decl; field = c->backend_decl;
gcc_assert (TREE_CODE (field) == FIELD_DECL); gcc_assert (TREE_CODE (field) == FIELD_DECL);
decl = se->expr; decl = se->expr;
tmp = build3 (COMPONENT_REF, TREE_TYPE (field), decl, field, NULL_TREE); tmp = fold_build3 (COMPONENT_REF, TREE_TYPE (field), decl, field, NULL_TREE);
se->expr = tmp; se->expr = tmp;
...@@ -748,25 +748,27 @@ gfc_conv_cst_int_power (gfc_se * se, tree lhs, tree rhs) ...@@ -748,25 +748,27 @@ gfc_conv_cst_int_power (gfc_se * se, tree lhs, tree rhs)
/* If rhs < 0 and lhs is an integer, the result is -1, 0 or 1. */ /* If rhs < 0 and lhs is an integer, the result is -1, 0 or 1. */
if ((sgn == -1) && (TREE_CODE (type) == INTEGER_TYPE)) if ((sgn == -1) && (TREE_CODE (type) == INTEGER_TYPE))
{ {
tmp = build2 (EQ_EXPR, boolean_type_node, lhs, tmp = fold_build2 (EQ_EXPR, boolean_type_node,
build_int_cst (TREE_TYPE (lhs), -1)); lhs, build_int_cst (TREE_TYPE (lhs), -1));
cond = build2 (EQ_EXPR, boolean_type_node, lhs, cond = fold_build2 (EQ_EXPR, boolean_type_node,
build_int_cst (TREE_TYPE (lhs), 1)); lhs, build_int_cst (TREE_TYPE (lhs), 1));
/* If rhs is even, /* If rhs is even,
result = (lhs == 1 || lhs == -1) ? 1 : 0. */ result = (lhs == 1 || lhs == -1) ? 1 : 0. */
if ((n & 1) == 0) if ((n & 1) == 0)
{ {
tmp = build2 (TRUTH_OR_EXPR, boolean_type_node, tmp, cond); tmp = fold_build2 (TRUTH_OR_EXPR, boolean_type_node, tmp, cond);
se->expr = build3 (COND_EXPR, type, tmp, build_int_cst (type, 1), se->expr = fold_build3 (COND_EXPR, type,
build_int_cst (type, 0)); tmp, build_int_cst (type, 1),
build_int_cst (type, 0));
return 1; return 1;
} }
/* If rhs is odd, /* If rhs is odd,
result = (lhs == 1) ? 1 : (lhs == -1) ? -1 : 0. */ result = (lhs == 1) ? 1 : (lhs == -1) ? -1 : 0. */
tmp = build3 (COND_EXPR, type, tmp, build_int_cst (type, -1), tmp = fold_build3 (COND_EXPR, type, tmp, build_int_cst (type, -1),
build_int_cst (type, 0)); build_int_cst (type, 0));
se->expr = build3 (COND_EXPR, type, cond, build_int_cst (type, 1), tmp); se->expr = fold_build3 (COND_EXPR, type,
cond, build_int_cst (type, 1), tmp);
return 1; return 1;
} }
...@@ -775,7 +777,7 @@ gfc_conv_cst_int_power (gfc_se * se, tree lhs, tree rhs) ...@@ -775,7 +777,7 @@ gfc_conv_cst_int_power (gfc_se * se, tree lhs, tree rhs)
if (sgn == -1) if (sgn == -1)
{ {
tmp = gfc_build_const (type, integer_one_node); tmp = gfc_build_const (type, integer_one_node);
vartmp[1] = build2 (RDIV_EXPR, type, tmp, vartmp[1]); vartmp[1] = fold_build2 (RDIV_EXPR, type, tmp, vartmp[1]);
} }
se->expr = gfc_conv_powi (se, n, vartmp); se->expr = gfc_conv_powi (se, n, vartmp);
...@@ -2306,9 +2308,9 @@ gfc_conv_function_call (gfc_se * se, gfc_symbol * sym, ...@@ -2306,9 +2308,9 @@ gfc_conv_function_call (gfc_se * se, gfc_symbol * sym,
if (arg->next == NULL) if (arg->next == NULL)
/* Only given one arg so generate a null and do a /* Only given one arg so generate a null and do a
not-equal comparison against the first arg. */ not-equal comparison against the first arg. */
se->expr = build2 (NE_EXPR, boolean_type_node, arg1se.expr, se->expr = fold_build2 (NE_EXPR, boolean_type_node, arg1se.expr,
fold_convert (TREE_TYPE (arg1se.expr), fold_convert (TREE_TYPE (arg1se.expr),
null_pointer_node)); null_pointer_node));
else else
{ {
tree eq_expr; tree eq_expr;
...@@ -2321,16 +2323,16 @@ gfc_conv_function_call (gfc_se * se, gfc_symbol * sym, ...@@ -2321,16 +2323,16 @@ gfc_conv_function_call (gfc_se * se, gfc_symbol * sym,
gfc_add_block_to_block (&se->post, &arg2se.post); gfc_add_block_to_block (&se->post, &arg2se.post);
/* Generate test to compare that the two args are equal. */ /* Generate test to compare that the two args are equal. */
eq_expr = build2 (EQ_EXPR, boolean_type_node, arg1se.expr, eq_expr = fold_build2 (EQ_EXPR, boolean_type_node,
arg2se.expr); arg1se.expr, arg2se.expr);
/* Generate test to ensure that the first arg is not null. */ /* Generate test to ensure that the first arg is not null. */
not_null_expr = build2 (NE_EXPR, boolean_type_node, arg1se.expr, not_null_expr = fold_build2 (NE_EXPR, boolean_type_node,
null_pointer_node); arg1se.expr, null_pointer_node);
/* Finally, the generated test must check that both arg1 is not /* Finally, the generated test must check that both arg1 is not
NULL and that it is equal to the second arg. */ NULL and that it is equal to the second arg. */
se->expr = build2 (TRUTH_AND_EXPR, boolean_type_node, se->expr = fold_build2 (TRUTH_AND_EXPR, boolean_type_node,
not_null_expr, eq_expr); not_null_expr, eq_expr);
} }
return 0; return 0;
...@@ -3418,7 +3420,8 @@ gfc_trans_structure_assign (tree dest, gfc_expr * expr) ...@@ -3418,7 +3420,8 @@ gfc_trans_structure_assign (tree dest, gfc_expr * expr)
} }
field = cm->backend_decl; field = cm->backend_decl;
tmp = build3 (COMPONENT_REF, TREE_TYPE (field), dest, field, NULL_TREE); tmp = fold_build3 (COMPONENT_REF, TREE_TYPE (field),
dest, field, NULL_TREE);
tmp = gfc_trans_subcomponent_assign (tmp, cm, c->expr); tmp = gfc_trans_subcomponent_assign (tmp, cm, c->expr);
gfc_add_expr_to_block (&block, tmp); gfc_add_expr_to_block (&block, tmp);
} }
......
/* IO Code translation/library interface /* IO Code translation/library interface
Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007 Free Software Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software
Foundation, Inc. Foundation, Inc.
Contributed by Paul Brook Contributed by Paul Brook
...@@ -429,10 +429,10 @@ set_parameter_const (stmtblock_t *block, tree var, enum iofield type, ...@@ -429,10 +429,10 @@ set_parameter_const (stmtblock_t *block, tree var, enum iofield type,
gfc_st_parameter_field *p = &st_parameter_field[type]; gfc_st_parameter_field *p = &st_parameter_field[type];
if (p->param_type == IOPARM_ptype_common) if (p->param_type == IOPARM_ptype_common)
var = build3 (COMPONENT_REF, st_parameter[IOPARM_ptype_common].type, var = fold_build3 (COMPONENT_REF, st_parameter[IOPARM_ptype_common].type,
var, TYPE_FIELDS (TREE_TYPE (var)), NULL_TREE); var, TYPE_FIELDS (TREE_TYPE (var)), NULL_TREE);
tmp = build3 (COMPONENT_REF, TREE_TYPE (p->field), var, p->field, tmp = fold_build3 (COMPONENT_REF, TREE_TYPE (p->field), var, p->field,
NULL_TREE); NULL_TREE);
gfc_add_modify_expr (block, tmp, build_int_cst (TREE_TYPE (p->field), val)); gfc_add_modify_expr (block, tmp, build_int_cst (TREE_TYPE (p->field), val));
return p->mask; return p->mask;
} }
...@@ -484,10 +484,10 @@ set_parameter_value (stmtblock_t *block, tree var, enum iofield type, ...@@ -484,10 +484,10 @@ set_parameter_value (stmtblock_t *block, tree var, enum iofield type,
gfc_add_block_to_block (block, &se.pre); gfc_add_block_to_block (block, &se.pre);
if (p->param_type == IOPARM_ptype_common) if (p->param_type == IOPARM_ptype_common)
var = build3 (COMPONENT_REF, st_parameter[IOPARM_ptype_common].type, var = fold_build3 (COMPONENT_REF, st_parameter[IOPARM_ptype_common].type,
var, TYPE_FIELDS (TREE_TYPE (var)), NULL_TREE); var, TYPE_FIELDS (TREE_TYPE (var)), NULL_TREE);
tmp = build3 (COMPONENT_REF, dest_type, var, p->field, NULL_TREE); tmp = fold_build3 (COMPONENT_REF, dest_type, var, p->field, NULL_TREE);
gfc_add_modify_expr (block, tmp, se.expr); gfc_add_modify_expr (block, tmp, se.expr);
return p->mask; return p->mask;
} }
...@@ -542,10 +542,10 @@ set_parameter_ref (stmtblock_t *block, stmtblock_t *postblock, ...@@ -542,10 +542,10 @@ set_parameter_ref (stmtblock_t *block, stmtblock_t *postblock,
} }
if (p->param_type == IOPARM_ptype_common) if (p->param_type == IOPARM_ptype_common)
var = build3 (COMPONENT_REF, st_parameter[IOPARM_ptype_common].type, var = fold_build3 (COMPONENT_REF, st_parameter[IOPARM_ptype_common].type,
var, TYPE_FIELDS (TREE_TYPE (var)), NULL_TREE); var, TYPE_FIELDS (TREE_TYPE (var)), NULL_TREE);
tmp = build3 (COMPONENT_REF, TREE_TYPE (p->field), var, p->field, tmp = fold_build3 (COMPONENT_REF, TREE_TYPE (p->field),
NULL_TREE); var, p->field, NULL_TREE);
gfc_add_modify_expr (block, tmp, addr); gfc_add_modify_expr (block, tmp, addr);
return p->mask; return p->mask;
} }
...@@ -631,12 +631,12 @@ set_string (stmtblock_t * block, stmtblock_t * postblock, tree var, ...@@ -631,12 +631,12 @@ set_string (stmtblock_t * block, stmtblock_t * postblock, tree var,
gfc_init_se (&se, NULL); gfc_init_se (&se, NULL);
if (p->param_type == IOPARM_ptype_common) if (p->param_type == IOPARM_ptype_common)
var = build3 (COMPONENT_REF, st_parameter[IOPARM_ptype_common].type, var = fold_build3 (COMPONENT_REF, st_parameter[IOPARM_ptype_common].type,
var, TYPE_FIELDS (TREE_TYPE (var)), NULL_TREE); var, TYPE_FIELDS (TREE_TYPE (var)), NULL_TREE);
io = build3 (COMPONENT_REF, TREE_TYPE (p->field), var, p->field, io = fold_build3 (COMPONENT_REF, TREE_TYPE (p->field),
NULL_TREE); var, p->field, NULL_TREE);
len = build3 (COMPONENT_REF, TREE_TYPE (p->field_len), var, p->field_len, len = fold_build3 (COMPONENT_REF, TREE_TYPE (p->field_len),
NULL_TREE); var, p->field_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) if (e->ts.type == BT_INTEGER && e->symtree->n.sym->attr.assign == 1)
...@@ -700,13 +700,13 @@ set_internal_unit (stmtblock_t * block, stmtblock_t * post_block, ...@@ -700,13 +700,13 @@ set_internal_unit (stmtblock_t * block, stmtblock_t * post_block,
p = &st_parameter_field[IOPARM_dt_internal_unit]; p = &st_parameter_field[IOPARM_dt_internal_unit];
mask = p->mask; mask = p->mask;
io = build3 (COMPONENT_REF, TREE_TYPE (p->field), var, p->field, io = fold_build3 (COMPONENT_REF, TREE_TYPE (p->field),
NULL_TREE); var, p->field, NULL_TREE);
len = build3 (COMPONENT_REF, TREE_TYPE (p->field_len), var, p->field_len, len = fold_build3 (COMPONENT_REF, TREE_TYPE (p->field_len),
NULL_TREE); var, p->field_len, NULL_TREE);
p = &st_parameter_field[IOPARM_dt_internal_unit_desc]; p = &st_parameter_field[IOPARM_dt_internal_unit_desc];
desc = build3 (COMPONENT_REF, TREE_TYPE (p->field), var, p->field, desc = fold_build3 (COMPONENT_REF, TREE_TYPE (p->field),
NULL_TREE); var, p->field, NULL_TREE);
gcc_assert (e->ts.type == BT_CHARACTER); gcc_assert (e->ts.type == BT_CHARACTER);
...@@ -814,12 +814,13 @@ io_result (stmtblock_t * block, tree var, gfc_st_label * err_label, ...@@ -814,12 +814,13 @@ io_result (stmtblock_t * block, tree var, gfc_st_label * err_label,
tmp = gfc_finish_block (&body); tmp = gfc_finish_block (&body);
var = build3 (COMPONENT_REF, st_parameter[IOPARM_ptype_common].type, var = fold_build3 (COMPONENT_REF, st_parameter[IOPARM_ptype_common].type,
var, TYPE_FIELDS (TREE_TYPE (var)), NULL_TREE); var, TYPE_FIELDS (TREE_TYPE (var)), NULL_TREE);
rc = build3 (COMPONENT_REF, TREE_TYPE (p->field), var, p->field, rc = fold_build3 (COMPONENT_REF, TREE_TYPE (p->field),
NULL_TREE); var, p->field, NULL_TREE);
rc = build2 (BIT_AND_EXPR, TREE_TYPE (rc), rc, rc = fold_build2 (BIT_AND_EXPR, TREE_TYPE (rc),
build_int_cst (TREE_TYPE (rc), IOPARM_common_libreturn_mask)); rc, build_int_cst (TREE_TYPE (rc),
IOPARM_common_libreturn_mask));
tmp = build3_v (SWITCH_EXPR, rc, tmp, NULL_TREE); tmp = build3_v (SWITCH_EXPR, rc, tmp, NULL_TREE);
...@@ -838,10 +839,11 @@ set_error_locus (stmtblock_t * block, tree var, locus * where) ...@@ -838,10 +839,11 @@ set_error_locus (stmtblock_t * block, tree var, locus * where)
int line; int line;
gfc_st_parameter_field *p = &st_parameter_field[IOPARM_common_filename]; gfc_st_parameter_field *p = &st_parameter_field[IOPARM_common_filename];
locus_file = build3 (COMPONENT_REF, st_parameter[IOPARM_ptype_common].type, locus_file = fold_build3 (COMPONENT_REF,
var, TYPE_FIELDS (TREE_TYPE (var)), NULL_TREE); st_parameter[IOPARM_ptype_common].type,
locus_file = build3 (COMPONENT_REF, TREE_TYPE (p->field), locus_file, var, TYPE_FIELDS (TREE_TYPE (var)), NULL_TREE);
p->field, NULL_TREE); locus_file = fold_build3 (COMPONENT_REF, TREE_TYPE (p->field),
locus_file, p->field, NULL_TREE);
f = where->lb->file; f = where->lb->file;
str = gfc_build_cstring_const (f->filename); str = gfc_build_cstring_const (f->filename);
...@@ -1357,8 +1359,8 @@ nml_get_addr_expr (gfc_symbol * sym, gfc_component * c, ...@@ -1357,8 +1359,8 @@ nml_get_addr_expr (gfc_symbol * sym, gfc_component * c,
the derived type. */ the derived type. */
if (TREE_CODE (decl) == FIELD_DECL) if (TREE_CODE (decl) == FIELD_DECL)
tmp = build3 (COMPONENT_REF, TREE_TYPE (tmp), tmp = fold_build3 (COMPONENT_REF, TREE_TYPE (tmp),
base_addr, tmp, NULL_TREE); base_addr, tmp, NULL_TREE);
/* If we have a derived type component, a reference to the first /* If we have a derived type component, a reference to the first
element of the array is built. This is done so that base_addr, element of the array is built. This is done so that base_addr,
...@@ -1908,8 +1910,8 @@ transfer_expr (gfc_se * se, gfc_typespec * ts, tree addr_expr, gfc_code * code) ...@@ -1908,8 +1910,8 @@ transfer_expr (gfc_se * se, gfc_typespec * ts, tree addr_expr, gfc_code * code)
field = c->backend_decl; field = c->backend_decl;
gcc_assert (field && TREE_CODE (field) == FIELD_DECL); gcc_assert (field && TREE_CODE (field) == FIELD_DECL);
tmp = build3 (COMPONENT_REF, TREE_TYPE (field), expr, field, tmp = fold_build3 (COMPONENT_REF, TREE_TYPE (field),
NULL_TREE); expr, field, NULL_TREE);
if (c->dimension) if (c->dimension)
{ {
......
/* OpenMP directive translation -- generate GCC trees from gfc_code. /* OpenMP directive translation -- generate GCC trees from gfc_code.
Copyright (C) 2005, 2006, 2007 Free Software Foundation, Inc. Copyright (C) 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
Contributed by Jakub Jelinek <jakub@redhat.com> Contributed by Jakub Jelinek <jakub@redhat.com>
This file is part of GCC. This file is part of GCC.
...@@ -863,7 +863,7 @@ gfc_trans_omp_atomic (gfc_code *code) ...@@ -863,7 +863,7 @@ gfc_trans_omp_atomic (gfc_code *code)
if (TREE_CODE (TREE_TYPE (rhs)) == COMPLEX_TYPE if (TREE_CODE (TREE_TYPE (rhs)) == COMPLEX_TYPE
&& TREE_CODE (type) != COMPLEX_TYPE) && TREE_CODE (type) != COMPLEX_TYPE)
x = build1 (REALPART_EXPR, TREE_TYPE (TREE_TYPE (rhs)), x); x = fold_build1 (REALPART_EXPR, TREE_TYPE (TREE_TYPE (rhs)), x);
x = build2_v (OMP_ATOMIC, lhsaddr, convert (type, x)); x = build2_v (OMP_ATOMIC, lhsaddr, convert (type, x));
gfc_add_expr_to_block (&block, x); gfc_add_expr_to_block (&block, x);
...@@ -961,8 +961,8 @@ gfc_trans_omp_do (gfc_code *code, stmtblock_t *pblock, ...@@ -961,8 +961,8 @@ gfc_trans_omp_do (gfc_code *code, stmtblock_t *pblock,
if (simple) if (simple)
{ {
init = build2_v (GIMPLE_MODIFY_STMT, dovar, from); init = build2_v (GIMPLE_MODIFY_STMT, dovar, from);
cond = build2 (simple > 0 ? LE_EXPR : GE_EXPR, boolean_type_node, cond = fold_build2 (simple > 0 ? LE_EXPR : GE_EXPR, boolean_type_node,
dovar, to); dovar, to);
incr = fold_build2 (PLUS_EXPR, type, dovar, step); incr = fold_build2 (PLUS_EXPR, type, dovar, step);
incr = fold_build2 (GIMPLE_MODIFY_STMT, type, dovar, incr); incr = fold_build2 (GIMPLE_MODIFY_STMT, type, dovar, incr);
if (pblock != &block) if (pblock != &block)
...@@ -987,7 +987,7 @@ gfc_trans_omp_do (gfc_code *code, stmtblock_t *pblock, ...@@ -987,7 +987,7 @@ gfc_trans_omp_do (gfc_code *code, stmtblock_t *pblock,
tmp = gfc_evaluate_now (tmp, pblock); tmp = gfc_evaluate_now (tmp, pblock);
count = gfc_create_var (type, "count"); count = gfc_create_var (type, "count");
init = build2_v (GIMPLE_MODIFY_STMT, count, build_int_cst (type, 0)); init = build2_v (GIMPLE_MODIFY_STMT, count, build_int_cst (type, 0));
cond = build2 (LT_EXPR, boolean_type_node, count, tmp); cond = fold_build2 (LT_EXPR, boolean_type_node, count, tmp);
incr = fold_build2 (PLUS_EXPR, type, count, build_int_cst (type, 1)); incr = fold_build2 (PLUS_EXPR, type, count, build_int_cst (type, 1));
incr = fold_build2 (GIMPLE_MODIFY_STMT, type, count, incr); incr = fold_build2 (GIMPLE_MODIFY_STMT, type, count, incr);
...@@ -1000,7 +1000,7 @@ gfc_trans_omp_do (gfc_code *code, stmtblock_t *pblock, ...@@ -1000,7 +1000,7 @@ gfc_trans_omp_do (gfc_code *code, stmtblock_t *pblock,
/* Initialize DOVAR. */ /* Initialize DOVAR. */
tmp = fold_build2 (MULT_EXPR, type, count, step); tmp = fold_build2 (MULT_EXPR, type, count, step);
tmp = build2 (PLUS_EXPR, type, from, tmp); tmp = fold_build2 (PLUS_EXPR, type, from, tmp);
gfc_add_modify_stmt (&body, dovar, tmp); gfc_add_modify_stmt (&body, dovar, tmp);
} }
......
/* Statement translation -- generate GCC trees from gfc_code. /* Statement translation -- generate GCC trees from gfc_code.
Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007 Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008
Free Software Foundation, Inc. Free Software Foundation, Inc.
Contributed by Paul Brook <paul@nowt.org> Contributed by Paul Brook <paul@nowt.org>
and Steven Bosscher <s.bosscher@student.tudelft.nl> and Steven Bosscher <s.bosscher@student.tudelft.nl>
...@@ -161,7 +161,7 @@ gfc_trans_goto (gfc_code * code) ...@@ -161,7 +161,7 @@ gfc_trans_goto (gfc_code * code)
code = code->block; code = code->block;
if (code == NULL) if (code == NULL)
{ {
target = build1 (GOTO_EXPR, void_type_node, assigned_goto); target = fold_build1 (GOTO_EXPR, void_type_node, assigned_goto);
gfc_add_expr_to_block (&se.pre, target); gfc_add_expr_to_block (&se.pre, target);
return gfc_finish_block (&se.pre); return gfc_finish_block (&se.pre);
} }
...@@ -171,9 +171,9 @@ gfc_trans_goto (gfc_code * code) ...@@ -171,9 +171,9 @@ gfc_trans_goto (gfc_code * code)
{ {
target = gfc_get_label_decl (code->label); target = gfc_get_label_decl (code->label);
tmp = gfc_build_addr_expr (pvoid_type_node, target); tmp = gfc_build_addr_expr (pvoid_type_node, target);
tmp = build2 (EQ_EXPR, boolean_type_node, tmp, assigned_goto); tmp = fold_build2 (EQ_EXPR, boolean_type_node, tmp, assigned_goto);
tmp = build3_v (COND_EXPR, tmp, tmp = build3_v (COND_EXPR, tmp,
build1 (GOTO_EXPR, void_type_node, target), fold_build1 (GOTO_EXPR, void_type_node, target),
build_empty_stmt ()); build_empty_stmt ());
gfc_add_expr_to_block (&se.pre, tmp); gfc_add_expr_to_block (&se.pre, tmp);
code = code->block; code = code->block;
...@@ -444,8 +444,8 @@ gfc_trans_return (gfc_code * code ATTRIBUTE_UNUSED) ...@@ -444,8 +444,8 @@ gfc_trans_return (gfc_code * code ATTRIBUTE_UNUSED)
gfc_conv_expr (&se, code->expr); gfc_conv_expr (&se, code->expr);
tmp = build2 (MODIFY_EXPR, TREE_TYPE (result), result, tmp = fold_build2 (MODIFY_EXPR, TREE_TYPE (result), result,
fold_convert (TREE_TYPE (result), se.expr)); fold_convert (TREE_TYPE (result), se.expr));
gfc_add_expr_to_block (&se.pre, tmp); gfc_add_expr_to_block (&se.pre, tmp);
tmp = build1_v (GOTO_EXPR, gfc_get_return_label ()); tmp = build1_v (GOTO_EXPR, gfc_get_return_label ());
...@@ -946,7 +946,7 @@ gfc_trans_do (gfc_code * code) ...@@ -946,7 +946,7 @@ gfc_trans_do (gfc_code * code)
} }
/* Increment the loop variable. */ /* Increment the loop variable. */
tmp = build2 (PLUS_EXPR, type, dovar, step); tmp = fold_build2 (PLUS_EXPR, type, dovar, step);
gfc_add_modify_expr (&body, dovar, tmp); gfc_add_modify_expr (&body, dovar, tmp);
/* End with the loop condition. Loop until countm1 == 0. */ /* End with the loop condition. Loop until countm1 == 0. */
...@@ -958,7 +958,7 @@ gfc_trans_do (gfc_code * code) ...@@ -958,7 +958,7 @@ gfc_trans_do (gfc_code * code)
gfc_add_expr_to_block (&body, tmp); gfc_add_expr_to_block (&body, tmp);
/* Decrement the loop count. */ /* Decrement the loop count. */
tmp = build2 (MINUS_EXPR, utype, countm1, build_int_cst (utype, 1)); tmp = fold_build2 (MINUS_EXPR, utype, countm1, build_int_cst (utype, 1));
gfc_add_modify_expr (&body, countm1, tmp); gfc_add_modify_expr (&body, countm1, tmp);
/* End of loop body. */ /* End of loop body. */
...@@ -1181,7 +1181,8 @@ gfc_trans_integer_select (gfc_code * code) ...@@ -1181,7 +1181,8 @@ gfc_trans_integer_select (gfc_code * code)
/* Add this case label. /* Add this case label.
Add parameter 'label', make it match GCC backend. */ Add parameter 'label', make it match GCC backend. */
tmp = build3 (CASE_LABEL_EXPR, void_type_node, low, high, label); tmp = fold_build3 (CASE_LABEL_EXPR, void_type_node,
low, high, label);
gfc_add_expr_to_block (&body, tmp); gfc_add_expr_to_block (&body, tmp);
} }
...@@ -1373,9 +1374,9 @@ gfc_trans_character_select (gfc_code *code) ...@@ -1373,9 +1374,9 @@ gfc_trans_character_select (gfc_code *code)
for (d = c->ext.case_list; d; d = d->next) for (d = c->ext.case_list; d; d = d->next)
{ {
label = gfc_build_label_decl (NULL_TREE); label = gfc_build_label_decl (NULL_TREE);
tmp = build3 (CASE_LABEL_EXPR, void_type_node, tmp = fold_build3 (CASE_LABEL_EXPR, void_type_node,
build_int_cst (NULL_TREE, d->n), build_int_cst (NULL_TREE, d->n),
build_int_cst (NULL_TREE, d->n), label); build_int_cst (NULL_TREE, d->n), label);
gfc_add_expr_to_block (&body, tmp); gfc_add_expr_to_block (&body, tmp);
} }
...@@ -1775,7 +1776,7 @@ gfc_trans_forall_loop (forall_info *forall_tmp, tree body, ...@@ -1775,7 +1776,7 @@ gfc_trans_forall_loop (forall_info *forall_tmp, tree body,
gfc_add_expr_to_block (&block, body); gfc_add_expr_to_block (&block, body);
/* Increment the loop variable. */ /* Increment the loop variable. */
tmp = build2 (PLUS_EXPR, TREE_TYPE (var), var, step); tmp = fold_build2 (PLUS_EXPR, TREE_TYPE (var), var, step);
gfc_add_modify_expr (&block, var, tmp); gfc_add_modify_expr (&block, var, tmp);
/* Advance to the next mask element. Only do this for the /* Advance to the next mask element. Only do this for the
...@@ -1783,14 +1784,14 @@ gfc_trans_forall_loop (forall_info *forall_tmp, tree body, ...@@ -1783,14 +1784,14 @@ gfc_trans_forall_loop (forall_info *forall_tmp, tree body,
if (n == 0 && mask_flag && forall_tmp->mask) if (n == 0 && mask_flag && forall_tmp->mask)
{ {
tree maskindex = forall_tmp->maskindex; tree maskindex = forall_tmp->maskindex;
tmp = build2 (PLUS_EXPR, gfc_array_index_type, tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type,
maskindex, gfc_index_one_node); maskindex, gfc_index_one_node);
gfc_add_modify_expr (&block, maskindex, tmp); gfc_add_modify_expr (&block, maskindex, tmp);
} }
/* Decrement the loop counter. */ /* Decrement the loop counter. */
tmp = build2 (MINUS_EXPR, TREE_TYPE (var), count, tmp = fold_build2 (MINUS_EXPR, TREE_TYPE (var), count,
build_int_cst (TREE_TYPE (var), 1)); build_int_cst (TREE_TYPE (var), 1));
gfc_add_modify_expr (&block, count, tmp); gfc_add_modify_expr (&block, count, tmp);
body = gfc_finish_block (&block); body = gfc_finish_block (&block);
...@@ -2241,8 +2242,8 @@ compute_overall_iter_number (forall_info *nested_forall_info, tree inner_size, ...@@ -2241,8 +2242,8 @@ compute_overall_iter_number (forall_info *nested_forall_info, tree inner_size,
if (inner_size_body) if (inner_size_body)
gfc_add_block_to_block (&body, inner_size_body); gfc_add_block_to_block (&body, inner_size_body);
if (forall_tmp) if (forall_tmp)
tmp = build2 (PLUS_EXPR, gfc_array_index_type, number, tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type,
inner_size); number, inner_size);
else else
tmp = inner_size; tmp = inner_size;
gfc_add_modify_expr (&body, number, tmp); gfc_add_modify_expr (&body, number, tmp);
...@@ -2817,8 +2818,8 @@ gfc_trans_forall_1 (gfc_code * code, forall_info * nested_forall_info) ...@@ -2817,8 +2818,8 @@ gfc_trans_forall_1 (gfc_code * code, forall_info * nested_forall_info)
gfc_add_modify_expr (&body, tmp, se.expr); gfc_add_modify_expr (&body, tmp, se.expr);
/* Advance to the next mask element. */ /* Advance to the next mask element. */
tmp = build2 (PLUS_EXPR, gfc_array_index_type, tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type,
maskindex, gfc_index_one_node); maskindex, gfc_index_one_node);
gfc_add_modify_expr (&body, maskindex, tmp); gfc_add_modify_expr (&body, maskindex, tmp);
/* Generate the loops. */ /* Generate the loops. */
...@@ -3034,16 +3035,16 @@ gfc_evaluate_where_mask (gfc_expr * me, forall_info * nested_forall_info, ...@@ -3034,16 +3035,16 @@ gfc_evaluate_where_mask (gfc_expr * me, forall_info * nested_forall_info,
tmp1 = gfc_build_array_ref (cmask, count, NULL); tmp1 = gfc_build_array_ref (cmask, count, NULL);
tmp = cond; tmp = cond;
if (mask) if (mask)
tmp = build2 (TRUTH_AND_EXPR, mask_type, mtmp, tmp); tmp = fold_build2 (TRUTH_AND_EXPR, mask_type, mtmp, tmp);
gfc_add_modify_expr (&body1, tmp1, tmp); gfc_add_modify_expr (&body1, tmp1, tmp);
} }
if (pmask) if (pmask)
{ {
tmp1 = gfc_build_array_ref (pmask, count, NULL); tmp1 = gfc_build_array_ref (pmask, count, NULL);
tmp = build1 (TRUTH_NOT_EXPR, mask_type, cond); tmp = fold_build1 (TRUTH_NOT_EXPR, mask_type, cond);
if (mask) if (mask)
tmp = build2 (TRUTH_AND_EXPR, mask_type, mtmp, tmp); tmp = fold_build2 (TRUTH_AND_EXPR, mask_type, mtmp, tmp);
gfc_add_modify_expr (&body1, tmp1, tmp); gfc_add_modify_expr (&body1, tmp1, tmp);
} }
...@@ -3815,8 +3816,8 @@ gfc_trans_allocate (gfc_code * code) ...@@ -3815,8 +3816,8 @@ gfc_trans_allocate (gfc_code * code)
tmp = se.string_length; tmp = se.string_length;
tmp = gfc_allocate_with_status (&se.pre, tmp, pstat); tmp = gfc_allocate_with_status (&se.pre, tmp, pstat);
tmp = build2 (MODIFY_EXPR, void_type_node, se.expr, tmp = fold_build2 (MODIFY_EXPR, void_type_node, se.expr,
fold_convert (TREE_TYPE (se.expr), tmp)); fold_convert (TREE_TYPE (se.expr), tmp));
gfc_add_expr_to_block (&se.pre, tmp); gfc_add_expr_to_block (&se.pre, tmp);
if (code->expr) if (code->expr)
...@@ -3944,8 +3945,8 @@ gfc_trans_deallocate (gfc_code * code) ...@@ -3944,8 +3945,8 @@ gfc_trans_deallocate (gfc_code * code)
tmp = gfc_deallocate_with_status (se.expr, pstat, false); tmp = gfc_deallocate_with_status (se.expr, pstat, false);
gfc_add_expr_to_block (&se.pre, tmp); gfc_add_expr_to_block (&se.pre, tmp);
tmp = build2 (MODIFY_EXPR, void_type_node, tmp = fold_build2 (MODIFY_EXPR, void_type_node,
se.expr, build_int_cst (TREE_TYPE (se.expr), 0)); se.expr, build_int_cst (TREE_TYPE (se.expr), 0));
} }
gfc_add_expr_to_block (&se.pre, tmp); gfc_add_expr_to_block (&se.pre, tmp);
...@@ -3954,7 +3955,7 @@ gfc_trans_deallocate (gfc_code * code) ...@@ -3954,7 +3955,7 @@ gfc_trans_deallocate (gfc_code * code)
of the last deallocation to the running total. */ of the last deallocation to the running total. */
if (code->expr) if (code->expr)
{ {
apstat = build2 (PLUS_EXPR, TREE_TYPE (stat), astat, stat); apstat = fold_build2 (PLUS_EXPR, TREE_TYPE (stat), astat, stat);
gfc_add_modify_expr (&se.pre, astat, apstat); gfc_add_modify_expr (&se.pre, astat, apstat);
} }
......
/* Code translation -- generate GCC trees from gfc_code. /* Code translation -- generate GCC trees from gfc_code.
Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007 Free Software Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software
Foundation, Inc. Foundation, Inc.
Contributed by Paul Brook Contributed by Paul Brook
...@@ -278,8 +278,8 @@ gfc_build_addr_expr (tree type, tree t) ...@@ -278,8 +278,8 @@ gfc_build_addr_expr (tree type, tree t)
tree type_domain = TYPE_DOMAIN (base_type); tree type_domain = TYPE_DOMAIN (base_type);
if (type_domain && TYPE_MIN_VALUE (type_domain)) if (type_domain && TYPE_MIN_VALUE (type_domain))
min_val = TYPE_MIN_VALUE (type_domain); min_val = TYPE_MIN_VALUE (type_domain);
t = build4 (ARRAY_REF, TREE_TYPE (type), t, min_val, t = fold (build4 (ARRAY_REF, TREE_TYPE (type),
NULL_TREE, NULL_TREE); t, min_val, NULL_TREE, NULL_TREE));
natural_type = type; natural_type = type;
} }
else else
...@@ -296,7 +296,7 @@ gfc_build_addr_expr (tree type, tree t) ...@@ -296,7 +296,7 @@ gfc_build_addr_expr (tree type, tree t)
{ {
if (DECL_P (t)) if (DECL_P (t))
TREE_ADDRESSABLE (t) = 1; TREE_ADDRESSABLE (t) = 1;
t = build1 (ADDR_EXPR, natural_type, t); t = fold_build1 (ADDR_EXPR, natural_type, t);
} }
if (type && natural_type != type) if (type && natural_type != type)
...@@ -414,9 +414,9 @@ gfc_trans_runtime_check (tree cond, stmtblock_t * pblock, locus * where, ...@@ -414,9 +414,9 @@ gfc_trans_runtime_check (tree cond, stmtblock_t * pblock, locus * where,
number of arguments, we can't use build_call_expr directly. */ number of arguments, we can't use build_call_expr directly. */
fntype = TREE_TYPE (gfor_fndecl_runtime_error_at); fntype = TREE_TYPE (gfor_fndecl_runtime_error_at);
tmp = fold_builtin_call_array (TREE_TYPE (fntype), tmp = fold_builtin_call_array (TREE_TYPE (fntype),
build1 (ADDR_EXPR, fold_build1 (ADDR_EXPR,
build_pointer_type (fntype), build_pointer_type (fntype),
gfor_fndecl_runtime_error_at), gfor_fndecl_runtime_error_at),
nargs + 2, argarray); nargs + 2, argarray);
gfc_add_expr_to_block (&block, tmp); gfc_add_expr_to_block (&block, tmp);
...@@ -553,7 +553,7 @@ gfc_allocate_with_status (stmtblock_t * block, tree size, tree status) ...@@ -553,7 +553,7 @@ gfc_allocate_with_status (stmtblock_t * block, tree size, tree status)
if (status != NULL_TREE && !integer_zerop (status)) if (status != NULL_TREE && !integer_zerop (status))
{ {
tmp = fold_build2 (MODIFY_EXPR, status_type, tmp = fold_build2 (MODIFY_EXPR, status_type,
build1 (INDIRECT_REF, status_type, status), fold_build1 (INDIRECT_REF, status_type, status),
build_int_cst (status_type, 0)); build_int_cst (status_type, 0));
tmp = fold_build3 (COND_EXPR, void_type_node, tmp = fold_build3 (COND_EXPR, void_type_node,
fold_build2 (NE_EXPR, boolean_type_node, fold_build2 (NE_EXPR, boolean_type_node,
...@@ -575,7 +575,7 @@ gfc_allocate_with_status (stmtblock_t * block, tree size, tree status) ...@@ -575,7 +575,7 @@ gfc_allocate_with_status (stmtblock_t * block, tree size, tree status)
gfc_start_block (&set_status_block); gfc_start_block (&set_status_block);
gfc_add_modify_expr (&set_status_block, gfc_add_modify_expr (&set_status_block,
build1 (INDIRECT_REF, status_type, status), fold_build1 (INDIRECT_REF, status_type, status),
build_int_cst (status_type, LIBERROR_ALLOCATION)); build_int_cst (status_type, LIBERROR_ALLOCATION));
gfc_add_modify_expr (&set_status_block, res, gfc_add_modify_expr (&set_status_block, res,
build_int_cst (pvoid_type_node, 0)); build_int_cst (pvoid_type_node, 0));
...@@ -606,7 +606,7 @@ gfc_allocate_with_status (stmtblock_t * block, tree size, tree status) ...@@ -606,7 +606,7 @@ gfc_allocate_with_status (stmtblock_t * block, tree size, tree status)
cond = fold_build2 (EQ_EXPR, boolean_type_node, status, cond = fold_build2 (EQ_EXPR, boolean_type_node, status,
build_int_cst (status_type, 0)); build_int_cst (status_type, 0));
tmp2 = fold_build2 (MODIFY_EXPR, status_type, tmp2 = fold_build2 (MODIFY_EXPR, status_type,
build1 (INDIRECT_REF, status_type, status), fold_build1 (INDIRECT_REF, status_type, status),
build_int_cst (status_type, LIBERROR_ALLOCATION)); build_int_cst (status_type, LIBERROR_ALLOCATION));
tmp = fold_build3 (COND_EXPR, void_type_node, cond, tmp, tmp = fold_build3 (COND_EXPR, void_type_node, cond, tmp,
tmp2); tmp2);
...@@ -692,7 +692,7 @@ gfc_allocate_array_with_status (stmtblock_t * block, tree mem, tree size, ...@@ -692,7 +692,7 @@ gfc_allocate_array_with_status (stmtblock_t * block, tree mem, tree size,
gfc_add_modify_expr (&set_status_block, res, fold_convert (type, tmp)); gfc_add_modify_expr (&set_status_block, res, fold_convert (type, tmp));
gfc_add_modify_expr (&set_status_block, gfc_add_modify_expr (&set_status_block,
build1 (INDIRECT_REF, status_type, status), fold_build1 (INDIRECT_REF, status_type, status),
build_int_cst (status_type, LIBERROR_ALLOCATION)); build_int_cst (status_type, LIBERROR_ALLOCATION));
tmp = fold_build2 (EQ_EXPR, boolean_type_node, status, tmp = fold_build2 (EQ_EXPR, boolean_type_node, status,
...@@ -787,7 +787,7 @@ gfc_deallocate_with_status (tree pointer, tree status, bool can_fail) ...@@ -787,7 +787,7 @@ gfc_deallocate_with_status (tree pointer, tree status, bool can_fail)
cond2 = fold_build2 (NE_EXPR, boolean_type_node, status, cond2 = fold_build2 (NE_EXPR, boolean_type_node, status,
build_int_cst (TREE_TYPE (status), 0)); build_int_cst (TREE_TYPE (status), 0));
tmp = fold_build2 (MODIFY_EXPR, status_type, tmp = fold_build2 (MODIFY_EXPR, status_type,
build1 (INDIRECT_REF, status_type, status), fold_build1 (INDIRECT_REF, status_type, status),
build_int_cst (status_type, 1)); build_int_cst (status_type, 1));
error = fold_build3 (COND_EXPR, void_type_node, cond2, tmp, error); error = fold_build3 (COND_EXPR, void_type_node, cond2, tmp, error);
} }
...@@ -809,7 +809,7 @@ gfc_deallocate_with_status (tree pointer, tree status, bool can_fail) ...@@ -809,7 +809,7 @@ gfc_deallocate_with_status (tree pointer, tree status, bool can_fail)
cond2 = fold_build2 (NE_EXPR, boolean_type_node, status, cond2 = fold_build2 (NE_EXPR, boolean_type_node, status,
build_int_cst (TREE_TYPE (status), 0)); build_int_cst (TREE_TYPE (status), 0));
tmp = fold_build2 (MODIFY_EXPR, status_type, tmp = fold_build2 (MODIFY_EXPR, status_type,
build1 (INDIRECT_REF, status_type, status), fold_build1 (INDIRECT_REF, status_type, status),
build_int_cst (status_type, 0)); build_int_cst (status_type, 0));
tmp = fold_build3 (COND_EXPR, void_type_node, cond2, tmp, tmp = fold_build3 (COND_EXPR, void_type_node, cond2, tmp,
build_empty_stmt ()); build_empty_stmt ());
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment