Skip to content

R
riscv-gcc-1
Commit 44855d8c by Tobias Schlüter
Options

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
Showing with 290 additions and 257 deletions
gcc/fortran/convert.c
/* 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. */
......
gcc/fortran/f95-lang.c
/* 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,15 +220,16 @@ gfc_truthvalue_conversion (tree expr) ...@@ -220,15 +220,16 @@ 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:
......
gcc/fortran/trans-array.c
/* Array translation routines /* Array translation routines
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>
...@@ -149,7 +149,7 @@ gfc_conv_descriptor_data_get (tree desc) ...@@ -149,7 +149,7 @@ gfc_conv_descriptor_data_get (tree desc)
field = TYPE_FIELDS (type); field = TYPE_FIELDS (type);
gcc_assert (DATA_FIELD == 0); gcc_assert (DATA_FIELD == 0);
t = build3 (COMPONENT_REF, TREE_TYPE (field), desc, field, NULL_TREE); t = fold_build3 (COMPONENT_REF, TREE_TYPE (field), desc, field, NULL_TREE);
t = fold_convert (GFC_TYPE_ARRAY_DATAPTR_TYPE (type), t); t = fold_convert (GFC_TYPE_ARRAY_DATAPTR_TYPE (type), t);
return t; return t;
...@@ -176,7 +176,7 @@ gfc_conv_descriptor_data_set_internal (stmtblock_t *block, ...@@ -176,7 +176,7 @@ gfc_conv_descriptor_data_set_internal (stmtblock_t *block,
field = TYPE_FIELDS (type); field = TYPE_FIELDS (type);
gcc_assert (DATA_FIELD == 0); gcc_assert (DATA_FIELD == 0);
t = build3 (COMPONENT_REF, TREE_TYPE (field), desc, field, NULL_TREE); t = fold_build3 (COMPONENT_REF, TREE_TYPE (field), desc, field, NULL_TREE);
gfc_add_modify (block, t, fold_convert (TREE_TYPE (field), value), tuples_p); gfc_add_modify (block, t, fold_convert (TREE_TYPE (field), value), tuples_p);
} }
...@@ -195,7 +195,7 @@ gfc_conv_descriptor_data_addr (tree desc) ...@@ -195,7 +195,7 @@ gfc_conv_descriptor_data_addr (tree desc)
field = TYPE_FIELDS (type); field = TYPE_FIELDS (type);
gcc_assert (DATA_FIELD == 0); gcc_assert (DATA_FIELD == 0);
t = build3 (COMPONENT_REF, TREE_TYPE (field), desc, field, NULL_TREE); t = fold_build3 (COMPONENT_REF, TREE_TYPE (field), desc, field, NULL_TREE);
return build_fold_addr_expr (t); return build_fold_addr_expr (t);
} }
...@@ -211,7 +211,8 @@ gfc_conv_descriptor_offset (tree desc) ...@@ -211,7 +211,8 @@ gfc_conv_descriptor_offset (tree desc)
field = gfc_advance_chain (TYPE_FIELDS (type), OFFSET_FIELD); field = gfc_advance_chain (TYPE_FIELDS (type), OFFSET_FIELD);
gcc_assert (field != NULL_TREE && TREE_TYPE (field) == gfc_array_index_type); gcc_assert (field != NULL_TREE && TREE_TYPE (field) == gfc_array_index_type);
return build3 (COMPONENT_REF, TREE_TYPE (field), desc, field, NULL_TREE); return fold_build3 (COMPONENT_REF, TREE_TYPE (field),
desc, field, NULL_TREE);
} }
tree tree
...@@ -226,7 +227,8 @@ gfc_conv_descriptor_dtype (tree desc) ...@@ -226,7 +227,8 @@ gfc_conv_descriptor_dtype (tree desc)
field = gfc_advance_chain (TYPE_FIELDS (type), DTYPE_FIELD); field = gfc_advance_chain (TYPE_FIELDS (type), DTYPE_FIELD);
gcc_assert (field != NULL_TREE && TREE_TYPE (field) == gfc_array_index_type); gcc_assert (field != NULL_TREE && TREE_TYPE (field) == gfc_array_index_type);
return build3 (COMPONENT_REF, TREE_TYPE (field), desc, field, NULL_TREE); return fold_build3 (COMPONENT_REF, TREE_TYPE (field),
desc, field, NULL_TREE);
} }
static tree static tree
...@@ -244,7 +246,8 @@ gfc_conv_descriptor_dimension (tree desc, tree dim) ...@@ -244,7 +246,8 @@ gfc_conv_descriptor_dimension (tree desc, tree dim)
&& TREE_CODE (TREE_TYPE (field)) == ARRAY_TYPE && TREE_CODE (TREE_TYPE (field)) == ARRAY_TYPE
&& TREE_CODE (TREE_TYPE (TREE_TYPE (field))) == RECORD_TYPE); && TREE_CODE (TREE_TYPE (TREE_TYPE (field))) == RECORD_TYPE);
tmp = build3 (COMPONENT_REF, TREE_TYPE (field), desc, field, NULL_TREE); tmp = fold_build3 (COMPONENT_REF, TREE_TYPE (field),
desc, field, NULL_TREE);
tmp = gfc_build_array_ref (tmp, dim, NULL); tmp = gfc_build_array_ref (tmp, dim, NULL);
return tmp; return tmp;
} }
...@@ -260,7 +263,8 @@ gfc_conv_descriptor_stride (tree desc, tree dim) ...@@ -260,7 +263,8 @@ gfc_conv_descriptor_stride (tree desc, tree dim)
field = gfc_advance_chain (field, STRIDE_SUBFIELD); field = gfc_advance_chain (field, STRIDE_SUBFIELD);
gcc_assert (field != NULL_TREE && TREE_TYPE (field) == gfc_array_index_type); gcc_assert (field != NULL_TREE && TREE_TYPE (field) == gfc_array_index_type);
tmp = build3 (COMPONENT_REF, TREE_TYPE (field), tmp, field, NULL_TREE); tmp = fold_build3 (COMPONENT_REF, TREE_TYPE (field),
tmp, field, NULL_TREE);
return tmp; return tmp;
} }
...@@ -275,7 +279,8 @@ gfc_conv_descriptor_lbound (tree desc, tree dim) ...@@ -275,7 +279,8 @@ gfc_conv_descriptor_lbound (tree desc, tree dim)
field = gfc_advance_chain (field, LBOUND_SUBFIELD); field = gfc_advance_chain (field, LBOUND_SUBFIELD);
gcc_assert (field != NULL_TREE && TREE_TYPE (field) == gfc_array_index_type); gcc_assert (field != NULL_TREE && TREE_TYPE (field) == gfc_array_index_type);
tmp = build3 (COMPONENT_REF, TREE_TYPE (field), tmp, field, NULL_TREE); tmp = fold_build3 (COMPONENT_REF, TREE_TYPE (field),
tmp, field, NULL_TREE);
return tmp; return tmp;
} }
...@@ -290,7 +295,8 @@ gfc_conv_descriptor_ubound (tree desc, tree dim) ...@@ -290,7 +295,8 @@ gfc_conv_descriptor_ubound (tree desc, tree dim)
field = gfc_advance_chain (field, UBOUND_SUBFIELD); field = gfc_advance_chain (field, UBOUND_SUBFIELD);
gcc_assert (field != NULL_TREE && TREE_TYPE (field) == gfc_array_index_type); gcc_assert (field != NULL_TREE && TREE_TYPE (field) == gfc_array_index_type);
tmp = build3 (COMPONENT_REF, TREE_TYPE (field), tmp, field, NULL_TREE); tmp = fold_build3 (COMPONENT_REF, TREE_TYPE (field),
tmp, field, NULL_TREE);
return tmp; return tmp;
} }
...@@ -641,7 +647,8 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, ...@@ -641,7 +647,8 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post,
{ {
/* For a callee allocated array express the loop bounds in terms /* For a callee allocated array express the loop bounds in terms
of the descriptor fields. */ of the descriptor fields. */
tmp = build2 (MINUS_EXPR, gfc_array_index_type, tmp =
fold_build2 (MINUS_EXPR, gfc_array_index_type,
gfc_conv_descriptor_ubound (desc, gfc_rank_cst[n]), gfc_conv_descriptor_ubound (desc, gfc_rank_cst[n]),
gfc_conv_descriptor_lbound (desc, gfc_rank_cst[n])); gfc_conv_descriptor_lbound (desc, gfc_rank_cst[n]));
loop->to[n] = tmp; loop->to[n] = tmp;
...@@ -774,7 +781,8 @@ gfc_conv_array_transpose (gfc_se * se, gfc_expr * expr) ...@@ -774,7 +781,8 @@ gfc_conv_array_transpose (gfc_se * se, gfc_expr * expr)
if (!loop->to[n]) if (!loop->to[n])
{ {
gcc_assert (integer_zerop (loop->from[n])); gcc_assert (integer_zerop (loop->from[n]));
loop->to[n] = build2 (MINUS_EXPR, gfc_array_index_type, loop->to[n] =
fold_build2 (MINUS_EXPR, gfc_array_index_type,
gfc_conv_descriptor_ubound (dest, dest_index), gfc_conv_descriptor_ubound (dest, dest_index),
gfc_conv_descriptor_lbound (dest, dest_index)); gfc_conv_descriptor_lbound (dest, dest_index));
} }
...@@ -835,7 +843,7 @@ gfc_grow_array (stmtblock_t * pblock, tree desc, tree extra) ...@@ -835,7 +843,7 @@ gfc_grow_array (stmtblock_t * pblock, tree desc, tree extra)
ubound = gfc_conv_descriptor_ubound (desc, gfc_rank_cst[0]); ubound = gfc_conv_descriptor_ubound (desc, gfc_rank_cst[0]);
/* Add EXTRA to the upper bound. */ /* Add EXTRA to the upper bound. */
tmp = build2 (PLUS_EXPR, gfc_array_index_type, ubound, extra); tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type, ubound, extra);
gfc_add_modify_expr (pblock, ubound, tmp); gfc_add_modify_expr (pblock, ubound, tmp);
/* Get the value of the current data pointer. */ /* Get the value of the current data pointer. */
...@@ -843,8 +851,10 @@ gfc_grow_array (stmtblock_t * pblock, tree desc, tree extra) ...@@ -843,8 +851,10 @@ gfc_grow_array (stmtblock_t * pblock, tree desc, tree extra)
/* Calculate the new array size. */ /* Calculate the new array size. */
size = TYPE_SIZE_UNIT (gfc_get_element_type (TREE_TYPE (desc))); size = TYPE_SIZE_UNIT (gfc_get_element_type (TREE_TYPE (desc)));
tmp = build2 (PLUS_EXPR, gfc_array_index_type, ubound, gfc_index_one_node); tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type,
arg1 = build2 (MULT_EXPR, size_type_node, fold_convert (size_type_node, tmp), ubound, gfc_index_one_node);
arg1 = fold_build2 (MULT_EXPR, size_type_node,
fold_convert (size_type_node, tmp),
fold_convert (size_type_node, size)); fold_convert (size_type_node, size));
/* Call the realloc() function. */ /* Call the realloc() function. */
...@@ -1084,7 +1094,8 @@ gfc_trans_array_constructor_subarray (stmtblock_t * pblock, ...@@ -1084,7 +1094,8 @@ gfc_trans_array_constructor_subarray (stmtblock_t * pblock,
gcc_assert (se.ss == gfc_ss_terminator); gcc_assert (se.ss == gfc_ss_terminator);
/* Increment the offset. */ /* Increment the offset. */
tmp = build2 (PLUS_EXPR, gfc_array_index_type, *poffset, gfc_index_one_node); tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type,
*poffset, gfc_index_one_node);
gfc_add_modify_expr (&body, *poffset, tmp); gfc_add_modify_expr (&body, *poffset, tmp);
/* Finish the loop. */ /* Finish the loop. */
...@@ -1317,9 +1328,9 @@ gfc_trans_array_constructor_value (stmtblock_t * pblock, tree type, ...@@ -1317,9 +1328,9 @@ gfc_trans_array_constructor_value (stmtblock_t * pblock, tree type,
tmp = fold_build2 (GT_EXPR, boolean_type_node, step, tmp = fold_build2 (GT_EXPR, boolean_type_node, step,
build_int_cst (TREE_TYPE (step), 0)); build_int_cst (TREE_TYPE (step), 0));
cond = fold_build3 (COND_EXPR, boolean_type_node, tmp, cond = fold_build3 (COND_EXPR, boolean_type_node, tmp,
build2 (GT_EXPR, boolean_type_node, fold_build2 (GT_EXPR, boolean_type_node,
loopvar, end), loopvar, end),
build2 (LT_EXPR, boolean_type_node, fold_build2 (LT_EXPR, boolean_type_node,
loopvar, end)); loopvar, end));
tmp = build1_v (GOTO_EXPR, exit_label); tmp = build1_v (GOTO_EXPR, exit_label);
TREE_USED (exit_label) = 1; TREE_USED (exit_label) = 1;
...@@ -1330,7 +1341,7 @@ gfc_trans_array_constructor_value (stmtblock_t * pblock, tree type, ...@@ -1330,7 +1341,7 @@ gfc_trans_array_constructor_value (stmtblock_t * pblock, tree type,
gfc_add_expr_to_block (&body, loopbody); gfc_add_expr_to_block (&body, loopbody);
/* Increase loop variable by step. */ /* Increase loop variable by step. */
tmp = build2 (PLUS_EXPR, TREE_TYPE (loopvar), loopvar, step); tmp = fold_build2 (PLUS_EXPR, TREE_TYPE (loopvar), loopvar, step);
gfc_add_modify_expr (&body, loopvar, tmp); gfc_add_modify_expr (&body, loopvar, tmp);
/* Finish the loop. */ /* Finish the loop. */
...@@ -2568,7 +2579,8 @@ gfc_trans_scalarized_loop_end (gfc_loopinfo * loop, int n, ...@@ -2568,7 +2579,8 @@ gfc_trans_scalarized_loop_end (gfc_loopinfo * loop, int n,
gfc_init_block (&block); gfc_init_block (&block);
/* The exit condition. */ /* The exit condition. */
cond = build2 (GT_EXPR, boolean_type_node, loop->loopvar[n], loop->to[n]); cond = fold_build2 (GT_EXPR, boolean_type_node,
loop->loopvar[n], loop->to[n]);
tmp = build1_v (GOTO_EXPR, exit_label); tmp = build1_v (GOTO_EXPR, exit_label);
TREE_USED (exit_label) = 1; TREE_USED (exit_label) = 1;
tmp = build3_v (COND_EXPR, cond, tmp, build_empty_stmt ()); tmp = build3_v (COND_EXPR, cond, tmp, build_empty_stmt ());
...@@ -2578,7 +2590,7 @@ gfc_trans_scalarized_loop_end (gfc_loopinfo * loop, int n, ...@@ -2578,7 +2590,7 @@ gfc_trans_scalarized_loop_end (gfc_loopinfo * loop, int n,
gfc_add_expr_to_block (&block, loopbody); gfc_add_expr_to_block (&block, loopbody);
/* Increment the loopvar. */ /* Increment the loopvar. */
tmp = build2 (PLUS_EXPR, gfc_array_index_type, tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type,
loop->loopvar[n], gfc_index_one_node); loop->loopvar[n], gfc_index_one_node);
gfc_add_modify_expr (&block, loop->loopvar[n], tmp); gfc_add_modify_expr (&block, loop->loopvar[n], tmp);
...@@ -3563,7 +3575,7 @@ gfc_array_init_size (tree descriptor, int rank, tree * poffset, ...@@ -3563,7 +3575,7 @@ gfc_array_init_size (tree descriptor, int rank, tree * poffset,
offset = fold_build2 (MINUS_EXPR, gfc_array_index_type, offset, tmp); offset = fold_build2 (MINUS_EXPR, gfc_array_index_type, offset, tmp);
/* Start the calculation for the size of this dimension. */ /* Start the calculation for the size of this dimension. */
size = build2 (MINUS_EXPR, gfc_array_index_type, size = fold_build2 (MINUS_EXPR, gfc_array_index_type,
gfc_index_one_node, se.expr); gfc_index_one_node, se.expr);
/* Set upper bound. */ /* Set upper bound. */
...@@ -3700,7 +3712,7 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree pstat) ...@@ -3700,7 +3712,7 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree pstat)
tmp = gfc_allocate_array_with_status (&se->pre, pointer, size, pstat); tmp = gfc_allocate_array_with_status (&se->pre, pointer, size, pstat);
else else
tmp = gfc_allocate_with_status (&se->pre, size, pstat); tmp = gfc_allocate_with_status (&se->pre, size, pstat);
tmp = build2 (MODIFY_EXPR, void_type_node, pointer, tmp); tmp = fold_build2 (MODIFY_EXPR, void_type_node, pointer, tmp);
gfc_add_expr_to_block (&se->pre, tmp); gfc_add_expr_to_block (&se->pre, tmp);
tmp = gfc_conv_descriptor_offset (se->expr); tmp = gfc_conv_descriptor_offset (se->expr);
...@@ -3739,7 +3751,7 @@ gfc_array_deallocate (tree descriptor, tree pstat) ...@@ -3739,7 +3751,7 @@ gfc_array_deallocate (tree descriptor, tree pstat)
gfc_add_expr_to_block (&block, tmp); gfc_add_expr_to_block (&block, tmp);
/* Zero the data pointer. */ /* Zero the data pointer. */
tmp = build2 (MODIFY_EXPR, void_type_node, tmp = fold_build2 (MODIFY_EXPR, void_type_node,
var, build_int_cst (TREE_TYPE (var), 0)); var, build_int_cst (TREE_TYPE (var), 0));
gfc_add_expr_to_block (&block, tmp); gfc_add_expr_to_block (&block, tmp);
...@@ -3825,7 +3837,7 @@ gfc_conv_array_initializer (tree type, gfc_expr * expr) ...@@ -3825,7 +3837,7 @@ gfc_conv_array_initializer (tree type, gfc_expr * expr)
else else
tmp1 = gfc_conv_mpz_to_tree (c->n.offset, gfc_index_integer_kind); tmp1 = gfc_conv_mpz_to_tree (c->n.offset, gfc_index_integer_kind);
range = build2 (RANGE_EXPR, integer_type_node, tmp1, tmp2); range = fold_build2 (RANGE_EXPR, integer_type_node, tmp1, tmp2);
} }
else else
range = NULL; range = NULL;
...@@ -3937,9 +3949,9 @@ gfc_trans_array_bounds (tree type, gfc_symbol * sym, tree * poffset, ...@@ -3937,9 +3949,9 @@ gfc_trans_array_bounds (tree type, gfc_symbol * sym, tree * poffset,
/* Make sure that negative size arrays are translated /* Make sure that negative size arrays are translated
to being zero size. */ to being zero size. */
tmp = build2 (GE_EXPR, boolean_type_node, tmp = fold_build2 (GE_EXPR, boolean_type_node,
stride, gfc_index_zero_node); stride, gfc_index_zero_node);
tmp = build3 (COND_EXPR, gfc_array_index_type, tmp, tmp = fold_build3 (COND_EXPR, gfc_array_index_type, tmp,
stride, gfc_index_zero_node); stride, gfc_index_zero_node);
gfc_add_modify_expr (pblock, stride, tmp); gfc_add_modify_expr (pblock, stride, tmp);
} }
...@@ -3988,7 +4000,7 @@ gfc_trans_auto_array_allocation (tree decl, gfc_symbol * sym, tree fnbody) ...@@ -3988,7 +4000,7 @@ gfc_trans_auto_array_allocation (tree decl, 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 (&block, tmp); gfc_add_expr_to_block (&block, tmp);
} }
...@@ -4195,8 +4207,9 @@ gfc_trans_dummy_array_bias (gfc_symbol * sym, tree tmpdesc, tree body) ...@@ -4195,8 +4207,9 @@ gfc_trans_dummy_array_bias (gfc_symbol * sym, tree tmpdesc, tree body)
stride = gfc_conv_descriptor_stride (dumdesc, gfc_rank_cst[0]); stride = gfc_conv_descriptor_stride (dumdesc, gfc_rank_cst[0]);
stride = gfc_evaluate_now (stride, &block); stride = gfc_evaluate_now (stride, &block);
tmp = build2 (EQ_EXPR, boolean_type_node, stride, gfc_index_zero_node); tmp = fold_build2 (EQ_EXPR, boolean_type_node,
tmp = build3 (COND_EXPR, gfc_array_index_type, tmp, stride, gfc_index_zero_node);
tmp = fold_build3 (COND_EXPR, gfc_array_index_type, tmp,
gfc_index_one_node, stride); gfc_index_one_node, stride);
stride = GFC_TYPE_ARRAY_STRIDE (type, 0); stride = GFC_TYPE_ARRAY_STRIDE (type, 0);
gfc_add_modify_expr (&block, stride, tmp); gfc_add_modify_expr (&block, stride, tmp);
...@@ -4225,8 +4238,8 @@ gfc_trans_dummy_array_bias (gfc_symbol * sym, tree tmpdesc, tree body) ...@@ -4225,8 +4238,8 @@ gfc_trans_dummy_array_bias (gfc_symbol * sym, tree tmpdesc, tree body)
if (stmt_packed != NULL_TREE && stmt_unpacked != NULL_TREE) if (stmt_packed != NULL_TREE && stmt_unpacked != NULL_TREE)
{ {
/* Don't repack unknown shape arrays when the first stride is 1. */ /* Don't repack unknown shape arrays when the first stride is 1. */
tmp = build3 (COND_EXPR, TREE_TYPE (stmt_packed), partial, tmp = fold_build3 (COND_EXPR, TREE_TYPE (stmt_packed),
stmt_packed, stmt_unpacked); partial, stmt_packed, stmt_unpacked);
} }
else else
tmp = stmt_packed != NULL_TREE ? stmt_packed : stmt_unpacked; tmp = stmt_packed != NULL_TREE ? stmt_packed : stmt_unpacked;
...@@ -4282,7 +4295,7 @@ gfc_trans_dummy_array_bias (gfc_symbol * sym, tree tmpdesc, tree body) ...@@ -4282,7 +4295,7 @@ gfc_trans_dummy_array_bias (gfc_symbol * sym, tree tmpdesc, tree body)
tmp = fold_build2 (MINUS_EXPR, gfc_array_index_type, tmp = fold_build2 (MINUS_EXPR, gfc_array_index_type,
ubound, lbound); ubound, lbound);
stride2 = build2 (MINUS_EXPR, gfc_array_index_type, stride2 = fold_build2 (MINUS_EXPR, gfc_array_index_type,
dubound, dlbound); dubound, dlbound);
tmp = fold_build2 (NE_EXPR, gfc_array_index_type, tmp, stride2); tmp = fold_build2 (NE_EXPR, gfc_array_index_type, tmp, stride2);
asprintf (&msg, "%s for dimension %d of array '%s'", asprintf (&msg, "%s for dimension %d of array '%s'",
...@@ -4295,7 +4308,8 @@ gfc_trans_dummy_array_bias (gfc_symbol * sym, tree tmpdesc, tree body) ...@@ -4295,7 +4308,8 @@ gfc_trans_dummy_array_bias (gfc_symbol * sym, tree tmpdesc, tree body)
{ {
/* For assumed shape arrays move the upper bound by the same amount /* For assumed shape arrays move the upper bound by the same amount
as the lower bound. */ as the lower bound. */
tmp = build2 (MINUS_EXPR, gfc_array_index_type, dubound, dlbound); tmp = fold_build2 (MINUS_EXPR, gfc_array_index_type,
dubound, dlbound);
tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type, tmp, lbound); tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type, tmp, lbound);
gfc_add_modify_expr (&block, ubound, tmp); gfc_add_modify_expr (&block, ubound, tmp);
} }
...@@ -4333,7 +4347,7 @@ gfc_trans_dummy_array_bias (gfc_symbol * sym, tree tmpdesc, tree body) ...@@ -4333,7 +4347,7 @@ gfc_trans_dummy_array_bias (gfc_symbol * sym, tree tmpdesc, tree body)
/* Assign the stride. */ /* Assign the stride. */
if (stmt_packed != NULL_TREE && stmt_unpacked != NULL_TREE) if (stmt_packed != NULL_TREE && stmt_unpacked != NULL_TREE)
tmp = build3 (COND_EXPR, gfc_array_index_type, partial, tmp = fold_build3 (COND_EXPR, gfc_array_index_type, partial,
stmt_unpacked, stmt_packed); stmt_unpacked, stmt_packed);
else else
tmp = (stmt_packed != NULL_TREE) ? stmt_packed : stmt_unpacked; tmp = (stmt_packed != NULL_TREE) ? stmt_packed : stmt_unpacked;
...@@ -4404,7 +4418,7 @@ gfc_trans_dummy_array_bias (gfc_symbol * sym, tree tmpdesc, tree body) ...@@ -4404,7 +4418,7 @@ gfc_trans_dummy_array_bias (gfc_symbol * sym, tree tmpdesc, tree body)
/* Only do the cleanup if the array was repacked. */ /* Only do the cleanup if the array was repacked. */
tmp = build_fold_indirect_ref (dumdesc); tmp = build_fold_indirect_ref (dumdesc);
tmp = gfc_conv_descriptor_data_get (tmp); tmp = gfc_conv_descriptor_data_get (tmp);
tmp = build2 (NE_EXPR, boolean_type_node, tmp, tmpdesc); tmp = fold_build2 (NE_EXPR, boolean_type_node, tmp, tmpdesc);
stmt = build3_v (COND_EXPR, tmp, stmt, build_empty_stmt ()); stmt = build3_v (COND_EXPR, tmp, stmt, build_empty_stmt ());
if (optional_arg) if (optional_arg)
...@@ -4468,7 +4482,8 @@ gfc_get_dataptr_offset (stmtblock_t *block, tree parm, tree desc, tree offset, ...@@ -4468,7 +4482,8 @@ gfc_get_dataptr_offset (stmtblock_t *block, tree parm, tree desc, tree offset,
case REF_COMPONENT: case REF_COMPONENT:
field = ref->u.c.component->backend_decl; field = ref->u.c.component->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), tmp, field, NULL_TREE); tmp = fold_build3 (COMPONENT_REF, TREE_TYPE (field),
tmp, field, NULL_TREE);
break; break;
case REF_SUBSTRING: case REF_SUBSTRING:
...@@ -5151,7 +5166,7 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, gfc_ss * ss, int g77) ...@@ -5151,7 +5166,7 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, gfc_ss * ss, int g77)
loop cleanup code. */ loop cleanup code. */
tmp = build_fold_indirect_ref (desc); tmp = build_fold_indirect_ref (desc);
tmp = gfc_conv_array_data (tmp); tmp = gfc_conv_array_data (tmp);
tmp = build2 (NE_EXPR, boolean_type_node, tmp = fold_build2 (NE_EXPR, boolean_type_node,
fold_convert (TREE_TYPE (tmp), ptr), tmp); fold_convert (TREE_TYPE (tmp), ptr), tmp);
tmp = build3_v (COND_EXPR, tmp, stmt, build_empty_stmt ()); tmp = build3_v (COND_EXPR, tmp, stmt, build_empty_stmt ());
...@@ -5185,7 +5200,7 @@ gfc_trans_dealloc_allocated (tree descriptor) ...@@ -5185,7 +5200,7 @@ gfc_trans_dealloc_allocated (tree descriptor)
gfc_add_expr_to_block (&block, tmp); gfc_add_expr_to_block (&block, tmp);
/* Zero the data pointer. */ /* Zero the data pointer. */
tmp = build2 (MODIFY_EXPR, void_type_node, tmp = fold_build2 (MODIFY_EXPR, void_type_node,
var, build_int_cst (TREE_TYPE (var), 0)); var, build_int_cst (TREE_TYPE (var), 0));
gfc_add_expr_to_block (&block, tmp); gfc_add_expr_to_block (&block, tmp);
...@@ -5204,13 +5219,13 @@ get_full_array_size (stmtblock_t *block, tree decl, int rank) ...@@ -5204,13 +5219,13 @@ get_full_array_size (stmtblock_t *block, tree decl, int rank)
idx = gfc_rank_cst[rank - 1]; idx = gfc_rank_cst[rank - 1];
nelems = gfc_conv_descriptor_ubound (decl, idx); nelems = gfc_conv_descriptor_ubound (decl, idx);
tmp = gfc_conv_descriptor_lbound (decl, idx); tmp = gfc_conv_descriptor_lbound (decl, idx);
tmp = build2 (MINUS_EXPR, gfc_array_index_type, nelems, tmp); tmp = fold_build2 (MINUS_EXPR, gfc_array_index_type, nelems, tmp);
tmp = build2 (PLUS_EXPR, gfc_array_index_type, tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type,
tmp, gfc_index_one_node); tmp, gfc_index_one_node);
tmp = gfc_evaluate_now (tmp, block); tmp = gfc_evaluate_now (tmp, block);
nelems = gfc_conv_descriptor_stride (decl, idx); nelems = gfc_conv_descriptor_stride (decl, idx);
tmp = build2 (MULT_EXPR, gfc_array_index_type, nelems, tmp); tmp = fold_build2 (MULT_EXPR, gfc_array_index_type, nelems, tmp);
return gfc_evaluate_now (tmp, block); return gfc_evaluate_now (tmp, block);
} }
...@@ -5256,8 +5271,8 @@ gfc_duplicate_allocatable(tree dest, tree src, tree type, int rank) ...@@ -5256,8 +5271,8 @@ gfc_duplicate_allocatable(tree dest, tree src, tree type, int rank)
the allocate and copy. */ the allocate and copy. */
null_cond = gfc_conv_descriptor_data_get (src); null_cond = gfc_conv_descriptor_data_get (src);
null_cond = convert (pvoid_type_node, null_cond); null_cond = convert (pvoid_type_node, null_cond);
null_cond = build2 (NE_EXPR, boolean_type_node, null_cond, null_cond = fold_build2 (NE_EXPR, boolean_type_node,
null_pointer_node); null_cond, null_pointer_node);
return build3_v (COND_EXPR, null_cond, tmp, null_data); return build3_v (COND_EXPR, null_cond, tmp, null_data);
} }
...@@ -5307,11 +5322,11 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, ...@@ -5307,11 +5322,11 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl,
is a full array reference, we only need the descriptor is a full array reference, we only need the descriptor
information from dimension = rank. */ information from dimension = rank. */
tmp = get_full_array_size (&fnblock, decl, rank); tmp = get_full_array_size (&fnblock, decl, rank);
tmp = build2 (MINUS_EXPR, gfc_array_index_type, tmp = fold_build2 (MINUS_EXPR, gfc_array_index_type,
tmp, gfc_index_one_node); tmp, gfc_index_one_node);
null_cond = gfc_conv_descriptor_data_get (decl); null_cond = gfc_conv_descriptor_data_get (decl);
null_cond = build2 (NE_EXPR, boolean_type_node, null_cond, null_cond = fold_build2 (NE_EXPR, boolean_type_node, null_cond,
build_int_cst (TREE_TYPE (null_cond), 0)); build_int_cst (TREE_TYPE (null_cond), 0));
} }
else else
...@@ -5376,7 +5391,8 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, ...@@ -5376,7 +5391,8 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl,
components. */ components. */
if (cmp_has_alloc_comps && !c->pointer) if (cmp_has_alloc_comps && !c->pointer)
{ {
comp = build3 (COMPONENT_REF, ctype, decl, cdecl, NULL_TREE); comp = fold_build3 (COMPONENT_REF, ctype,
decl, cdecl, NULL_TREE);
rank = c->as ? c->as->rank : 0; rank = c->as ? c->as->rank : 0;
tmp = structure_alloc_comps (c->ts.derived, comp, NULL_TREE, tmp = structure_alloc_comps (c->ts.derived, comp, NULL_TREE,
rank, purpose); rank, purpose);
...@@ -5385,7 +5401,8 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, ...@@ -5385,7 +5401,8 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl,
if (c->allocatable) if (c->allocatable)
{ {
comp = build3 (COMPONENT_REF, ctype, decl, cdecl, NULL_TREE); comp = fold_build3 (COMPONENT_REF, ctype,
decl, cdecl, NULL_TREE);
tmp = gfc_trans_dealloc_allocated (comp); tmp = gfc_trans_dealloc_allocated (comp);
gfc_add_expr_to_block (&fnblock, tmp); gfc_add_expr_to_block (&fnblock, tmp);
} }
...@@ -5396,12 +5413,14 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, ...@@ -5396,12 +5413,14 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl,
continue; continue;
else if (c->allocatable) else if (c->allocatable)
{ {
comp = build3 (COMPONENT_REF, ctype, decl, cdecl, NULL_TREE); comp = fold_build3 (COMPONENT_REF, ctype,
decl, cdecl, NULL_TREE);
gfc_conv_descriptor_data_set (&fnblock, comp, null_pointer_node); gfc_conv_descriptor_data_set (&fnblock, comp, null_pointer_node);
} }
else if (cmp_has_alloc_comps) else if (cmp_has_alloc_comps)
{ {
comp = build3 (COMPONENT_REF, ctype, decl, cdecl, NULL_TREE); comp = fold_build3 (COMPONENT_REF, ctype,
decl, cdecl, NULL_TREE);
rank = c->as ? c->as->rank : 0; rank = c->as ? c->as->rank : 0;
tmp = structure_alloc_comps (c->ts.derived, comp, NULL_TREE, tmp = structure_alloc_comps (c->ts.derived, comp, NULL_TREE,
rank, purpose); rank, purpose);
...@@ -5414,8 +5433,8 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, ...@@ -5414,8 +5433,8 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl,
continue; continue;
/* We need source and destination components. */ /* We need source and destination components. */
comp = build3 (COMPONENT_REF, ctype, decl, cdecl, NULL_TREE); comp = fold_build3 (COMPONENT_REF, ctype, decl, cdecl, NULL_TREE);
dcmp = build3 (COMPONENT_REF, ctype, dest, cdecl, NULL_TREE); dcmp = fold_build3 (COMPONENT_REF, ctype, dest, cdecl, NULL_TREE);
dcmp = fold_convert (TREE_TYPE (comp), dcmp); dcmp = fold_convert (TREE_TYPE (comp), dcmp);
if (c->allocatable && !cmp_has_alloc_comps) if (c->allocatable && !cmp_has_alloc_comps)
......
gcc/fortran/trans-common.c
/* 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,7 +693,7 @@ create_common (gfc_common_head *com, segment_info *head, bool saw_equiv) ...@@ -693,7 +693,7 @@ 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;
......
gcc/fortran/trans-const.c
/* 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,7 +215,7 @@ gfc_conv_constant_to_tree (gfc_expr * expr) ...@@ -215,7 +215,7 @@ 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));
...@@ -224,7 +224,7 @@ gfc_conv_constant_to_tree (gfc_expr * expr) ...@@ -224,7 +224,7 @@ gfc_conv_constant_to_tree (gfc_expr * expr)
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));
...@@ -233,7 +233,7 @@ gfc_conv_constant_to_tree (gfc_expr * expr) ...@@ -233,7 +233,7 @@ gfc_conv_constant_to_tree (gfc_expr * expr)
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));
...@@ -243,7 +243,7 @@ gfc_conv_constant_to_tree (gfc_expr * expr) ...@@ -243,7 +243,7 @@ gfc_conv_constant_to_tree (gfc_expr * expr)
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));
......
gcc/fortran/trans-decl.c
/* 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,7 +689,7 @@ gfc_build_qualified_array (tree decl, gfc_symbol * sym) ...@@ -689,7 +689,7 @@ 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);
...@@ -1729,8 +1729,7 @@ build_entry_thunks (gfc_namespace * ns) ...@@ -1729,8 +1729,7 @@ 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);
...@@ -1740,9 +1739,9 @@ build_entry_thunks (gfc_namespace * ns) ...@@ -1740,9 +1739,9 @@ 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);
...@@ -1750,7 +1749,7 @@ build_entry_thunks (gfc_namespace * ns) ...@@ -1750,7 +1749,7 @@ build_entry_thunks (gfc_namespace * ns)
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);
...@@ -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,7 +3317,7 @@ gfc_generate_function_code (gfc_namespace * ns) ...@@ -3318,7 +3317,7 @@ 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);
......
gcc/fortran/trans-expr.c
/* 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,7 +139,7 @@ gfc_conv_expr_present (gfc_symbol * sym) ...@@ -139,7 +139,7 @@ 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,
tmp, build_int_cst (type, 1),
build_int_cst (type, 0)); 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,7 +2308,7 @@ gfc_conv_function_call (gfc_se * se, gfc_symbol * sym, ...@@ -2306,7 +2308,7 @@ 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
...@@ -2321,15 +2323,15 @@ gfc_conv_function_call (gfc_se * se, gfc_symbol * sym, ...@@ -2321,15 +2323,15 @@ 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);
} }
...@@ -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);
} }
......
gcc/fortran/trans-intrinsic.c
/* Intrinsic translation /* Intrinsic translation
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>
...@@ -274,7 +274,7 @@ gfc_conv_intrinsic_conversion (gfc_se * se, gfc_expr * expr) ...@@ -274,7 +274,7 @@ gfc_conv_intrinsic_conversion (gfc_se * se, gfc_expr * expr)
tree artype; tree artype;
artype = TREE_TYPE (TREE_TYPE (args[0])); artype = TREE_TYPE (TREE_TYPE (args[0]));
args[0] = build1 (REALPART_EXPR, artype, args[0]); args[0] = fold_build1 (REALPART_EXPR, artype, args[0]);
} }
se->expr = convert (type, args[0]); se->expr = convert (type, args[0]);
...@@ -300,11 +300,11 @@ build_fixbound_expr (stmtblock_t * pblock, tree arg, tree type, int up) ...@@ -300,11 +300,11 @@ build_fixbound_expr (stmtblock_t * pblock, tree arg, tree type, int up)
intval = gfc_evaluate_now (intval, pblock); intval = gfc_evaluate_now (intval, pblock);
tmp = convert (argtype, intval); tmp = convert (argtype, intval);
cond = build2 (up ? GE_EXPR : LE_EXPR, boolean_type_node, tmp, arg); cond = fold_build2 (up ? GE_EXPR : LE_EXPR, boolean_type_node, tmp, arg);
tmp = build2 (up ? PLUS_EXPR : MINUS_EXPR, type, intval, tmp = fold_build2 (up ? PLUS_EXPR : MINUS_EXPR, type, intval,
build_int_cst (type, 1)); build_int_cst (type, 1));
tmp = build3 (COND_EXPR, type, cond, intval, tmp); tmp = fold_build3 (COND_EXPR, type, cond, intval, tmp);
return tmp; return tmp;
} }
...@@ -370,7 +370,7 @@ build_fix_expr (stmtblock_t * pblock, tree arg, tree type, ...@@ -370,7 +370,7 @@ build_fix_expr (stmtblock_t * pblock, tree arg, tree type,
break; break;
case RND_TRUNC: case RND_TRUNC:
return build1 (FIX_TRUNC_EXPR, type, arg); return fold_build1 (FIX_TRUNC_EXPR, type, arg);
break; break;
default: default:
...@@ -470,17 +470,17 @@ gfc_conv_intrinsic_aint (gfc_se * se, gfc_expr * expr, enum rounding_mode op) ...@@ -470,17 +470,17 @@ gfc_conv_intrinsic_aint (gfc_se * se, gfc_expr * expr, enum rounding_mode op)
n = gfc_validate_kind (BT_INTEGER, kind, false); n = gfc_validate_kind (BT_INTEGER, kind, false);
mpfr_set_z (huge, gfc_integer_kinds[n].huge, GFC_RND_MODE); mpfr_set_z (huge, gfc_integer_kinds[n].huge, GFC_RND_MODE);
tmp = gfc_conv_mpfr_to_tree (huge, kind); tmp = gfc_conv_mpfr_to_tree (huge, kind);
cond = build2 (LT_EXPR, boolean_type_node, arg[0], tmp); cond = fold_build2 (LT_EXPR, boolean_type_node, arg[0], tmp);
mpfr_neg (huge, huge, GFC_RND_MODE); mpfr_neg (huge, huge, GFC_RND_MODE);
tmp = gfc_conv_mpfr_to_tree (huge, kind); tmp = gfc_conv_mpfr_to_tree (huge, kind);
tmp = build2 (GT_EXPR, boolean_type_node, arg[0], tmp); tmp = fold_build2 (GT_EXPR, boolean_type_node, arg[0], tmp);
cond = build2 (TRUTH_AND_EXPR, boolean_type_node, cond, tmp); cond = fold_build2 (TRUTH_AND_EXPR, boolean_type_node, cond, tmp);
itype = gfc_get_int_type (kind); itype = gfc_get_int_type (kind);
tmp = build_fix_expr (&se->pre, arg[0], itype, op); tmp = build_fix_expr (&se->pre, arg[0], itype, op);
tmp = convert (type, tmp); tmp = convert (type, tmp);
se->expr = build3 (COND_EXPR, type, cond, tmp, arg[0]); se->expr = fold_build3 (COND_EXPR, type, cond, tmp, arg[0]);
mpfr_clear (huge); mpfr_clear (huge);
} }
...@@ -518,7 +518,7 @@ gfc_conv_intrinsic_int (gfc_se * se, gfc_expr * expr, enum rounding_mode op) ...@@ -518,7 +518,7 @@ gfc_conv_intrinsic_int (gfc_se * se, gfc_expr * expr, enum rounding_mode op)
tree artype; tree artype;
artype = TREE_TYPE (TREE_TYPE (args[0])); artype = TREE_TYPE (TREE_TYPE (args[0]));
args[0] = build1 (REALPART_EXPR, artype, args[0]); args[0] = fold_build1 (REALPART_EXPR, artype, args[0]);
} }
se->expr = build_fix_expr (&se->pre, args[0], type, op); se->expr = build_fix_expr (&se->pre, args[0], type, op);
...@@ -534,7 +534,7 @@ gfc_conv_intrinsic_imagpart (gfc_se * se, gfc_expr * expr) ...@@ -534,7 +534,7 @@ gfc_conv_intrinsic_imagpart (gfc_se * se, gfc_expr * expr)
tree arg; tree arg;
gfc_conv_intrinsic_function_args (se, expr, &arg, 1); gfc_conv_intrinsic_function_args (se, expr, &arg, 1);
se->expr = build1 (IMAGPART_EXPR, TREE_TYPE (TREE_TYPE (arg)), arg); se->expr = fold_build1 (IMAGPART_EXPR, TREE_TYPE (TREE_TYPE (arg)), arg);
} }
...@@ -546,7 +546,7 @@ gfc_conv_intrinsic_conjg (gfc_se * se, gfc_expr * expr) ...@@ -546,7 +546,7 @@ gfc_conv_intrinsic_conjg (gfc_se * se, gfc_expr * expr)
tree arg; tree arg;
gfc_conv_intrinsic_function_args (se, expr, &arg, 1); gfc_conv_intrinsic_function_args (se, expr, &arg, 1);
se->expr = build1 (CONJ_EXPR, TREE_TYPE (arg), arg); se->expr = fold_build1 (CONJ_EXPR, TREE_TYPE (arg), arg);
} }
...@@ -971,7 +971,7 @@ gfc_conv_intrinsic_abs (gfc_se * se, gfc_expr * expr) ...@@ -971,7 +971,7 @@ gfc_conv_intrinsic_abs (gfc_se * se, gfc_expr * expr)
{ {
case BT_INTEGER: case BT_INTEGER:
case BT_REAL: case BT_REAL:
se->expr = build1 (ABS_EXPR, TREE_TYPE (arg), arg); se->expr = fold_build1 (ABS_EXPR, TREE_TYPE (arg), arg);
break; break;
case BT_COMPLEX: case BT_COMPLEX:
...@@ -1020,7 +1020,8 @@ gfc_conv_intrinsic_cmplx (gfc_se * se, gfc_expr * expr, int both) ...@@ -1020,7 +1020,8 @@ gfc_conv_intrinsic_cmplx (gfc_se * se, gfc_expr * expr, int both)
imag = convert (TREE_TYPE (type), args[1]); imag = convert (TREE_TYPE (type), args[1]);
else if (TREE_CODE (TREE_TYPE (args[0])) == COMPLEX_TYPE) else if (TREE_CODE (TREE_TYPE (args[0])) == COMPLEX_TYPE)
{ {
imag = build1 (IMAGPART_EXPR, TREE_TYPE (TREE_TYPE (args[0])), args[0]); imag = fold_build1 (IMAGPART_EXPR, TREE_TYPE (TREE_TYPE (args[0])),
args[0]);
imag = convert (TREE_TYPE (type), imag); imag = convert (TREE_TYPE (type), imag);
} }
else else
...@@ -1054,9 +1055,9 @@ gfc_conv_intrinsic_mod (gfc_se * se, gfc_expr * expr, int modulo) ...@@ -1054,9 +1055,9 @@ gfc_conv_intrinsic_mod (gfc_se * se, gfc_expr * expr, int modulo)
type = TREE_TYPE (args[0]); type = TREE_TYPE (args[0]);
if (modulo) if (modulo)
se->expr = build2 (FLOOR_MOD_EXPR, type, args[0], args[1]); se->expr = fold_build2 (FLOOR_MOD_EXPR, type, args[0], args[1]);
else else
se->expr = build2 (TRUNC_MOD_EXPR, type, args[0], args[1]); se->expr = fold_build2 (TRUNC_MOD_EXPR, type, args[0], args[1]);
break; break;
case BT_REAL: case BT_REAL:
...@@ -1107,20 +1108,21 @@ gfc_conv_intrinsic_mod (gfc_se * se, gfc_expr * expr, int modulo) ...@@ -1107,20 +1108,21 @@ gfc_conv_intrinsic_mod (gfc_se * se, gfc_expr * expr, int modulo)
{ {
tree zero = gfc_build_const (type, integer_zero_node); tree zero = gfc_build_const (type, integer_zero_node);
tmp = gfc_evaluate_now (se->expr, &se->pre); tmp = gfc_evaluate_now (se->expr, &se->pre);
test = build2 (LT_EXPR, boolean_type_node, args[0], zero); test = fold_build2 (LT_EXPR, boolean_type_node, args[0], zero);
test2 = build2 (LT_EXPR, boolean_type_node, args[1], zero); test2 = fold_build2 (LT_EXPR, boolean_type_node, args[1], zero);
test2 = build2 (TRUTH_XOR_EXPR, boolean_type_node, test, test2); test2 = fold_build2 (TRUTH_XOR_EXPR, boolean_type_node, test, test2);
test = build2 (NE_EXPR, boolean_type_node, tmp, zero); test = fold_build2 (NE_EXPR, boolean_type_node, tmp, zero);
test = build2 (TRUTH_AND_EXPR, boolean_type_node, test, test2); test = fold_build2 (TRUTH_AND_EXPR, boolean_type_node, test, test2);
test = gfc_evaluate_now (test, &se->pre); test = gfc_evaluate_now (test, &se->pre);
se->expr = build3 (COND_EXPR, type, test, se->expr = fold_build3 (COND_EXPR, type, test,
build2 (PLUS_EXPR, type, tmp, args[1]), tmp); fold_build2 (PLUS_EXPR, type, tmp, args[1]),
tmp);
return; return;
} }
/* If we do not have a built_in fmod, the calculation is going to /* If we do not have a built_in fmod, the calculation is going to
have to be done longhand. */ have to be done longhand. */
tmp = build2 (RDIV_EXPR, type, args[0], args[1]); tmp = fold_build2 (RDIV_EXPR, type, args[0], args[1]);
/* Test if the value is too large to handle sensibly. */ /* Test if the value is too large to handle sensibly. */
gfc_set_model_kind (expr->ts.kind); gfc_set_model_kind (expr->ts.kind);
...@@ -1134,12 +1136,12 @@ gfc_conv_intrinsic_mod (gfc_se * se, gfc_expr * expr, int modulo) ...@@ -1134,12 +1136,12 @@ gfc_conv_intrinsic_mod (gfc_se * se, gfc_expr * expr, int modulo)
} }
mpfr_set_z (huge, gfc_integer_kinds[n].huge, GFC_RND_MODE); mpfr_set_z (huge, gfc_integer_kinds[n].huge, GFC_RND_MODE);
test = gfc_conv_mpfr_to_tree (huge, expr->ts.kind); test = gfc_conv_mpfr_to_tree (huge, expr->ts.kind);
test2 = build2 (LT_EXPR, boolean_type_node, tmp, test); test2 = fold_build2 (LT_EXPR, boolean_type_node, tmp, test);
mpfr_neg (huge, huge, GFC_RND_MODE); mpfr_neg (huge, huge, GFC_RND_MODE);
test = gfc_conv_mpfr_to_tree (huge, expr->ts.kind); test = gfc_conv_mpfr_to_tree (huge, expr->ts.kind);
test = build2 (GT_EXPR, boolean_type_node, tmp, test); test = fold_build2 (GT_EXPR, boolean_type_node, tmp, test);
test2 = build2 (TRUTH_AND_EXPR, boolean_type_node, test, test2); test2 = fold_build2 (TRUTH_AND_EXPR, boolean_type_node, test, test2);
itype = gfc_get_int_type (ikind); itype = gfc_get_int_type (ikind);
if (modulo) if (modulo)
...@@ -1147,9 +1149,9 @@ gfc_conv_intrinsic_mod (gfc_se * se, gfc_expr * expr, int modulo) ...@@ -1147,9 +1149,9 @@ gfc_conv_intrinsic_mod (gfc_se * se, gfc_expr * expr, int modulo)
else else
tmp = build_fix_expr (&se->pre, tmp, itype, RND_TRUNC); tmp = build_fix_expr (&se->pre, tmp, itype, RND_TRUNC);
tmp = convert (type, tmp); tmp = convert (type, tmp);
tmp = build3 (COND_EXPR, type, test2, tmp, args[0]); tmp = fold_build3 (COND_EXPR, type, test2, tmp, args[0]);
tmp = build2 (MULT_EXPR, type, tmp, args[1]); tmp = fold_build2 (MULT_EXPR, type, tmp, args[1]);
se->expr = build2 (MINUS_EXPR, type, args[0], tmp); se->expr = fold_build2 (MINUS_EXPR, type, args[0], tmp);
mpfr_clear (huge); mpfr_clear (huge);
break; break;
...@@ -1172,12 +1174,12 @@ gfc_conv_intrinsic_dim (gfc_se * se, gfc_expr * expr) ...@@ -1172,12 +1174,12 @@ gfc_conv_intrinsic_dim (gfc_se * se, gfc_expr * expr)
gfc_conv_intrinsic_function_args (se, expr, args, 2); gfc_conv_intrinsic_function_args (se, expr, args, 2);
type = TREE_TYPE (args[0]); type = TREE_TYPE (args[0]);
val = build2 (MINUS_EXPR, type, args[0], args[1]); val = fold_build2 (MINUS_EXPR, type, args[0], args[1]);
val = gfc_evaluate_now (val, &se->pre); val = gfc_evaluate_now (val, &se->pre);
zero = gfc_build_const (type, integer_zero_node); zero = gfc_build_const (type, integer_zero_node);
tmp = build2 (LE_EXPR, boolean_type_node, val, zero); tmp = fold_build2 (LE_EXPR, boolean_type_node, val, zero);
se->expr = build3 (COND_EXPR, type, tmp, zero, val); se->expr = fold_build3 (COND_EXPR, type, tmp, zero, val);
} }
...@@ -1266,7 +1268,7 @@ gfc_conv_intrinsic_dprod (gfc_se * se, gfc_expr * expr) ...@@ -1266,7 +1268,7 @@ gfc_conv_intrinsic_dprod (gfc_se * se, gfc_expr * expr)
type = gfc_typenode_for_spec (&expr->ts); type = gfc_typenode_for_spec (&expr->ts);
args[0] = convert (type, args[0]); args[0] = convert (type, args[0]);
args[1] = convert (type, args[1]); args[1] = convert (type, args[1]);
se->expr = build2 (MULT_EXPR, type, args[0], args[1]); se->expr = fold_build2 (MULT_EXPR, type, args[0], args[1]);
} }
...@@ -1323,8 +1325,8 @@ gfc_conv_intrinsic_ctime (gfc_se * se, gfc_expr * expr) ...@@ -1323,8 +1325,8 @@ gfc_conv_intrinsic_ctime (gfc_se * se, gfc_expr * expr)
gfc_add_expr_to_block (&se->pre, tmp); gfc_add_expr_to_block (&se->pre, tmp);
/* Free the temporary afterwards, if necessary. */ /* Free the temporary afterwards, if necessary. */
cond = build2 (GT_EXPR, boolean_type_node, len, cond = fold_build2 (GT_EXPR, boolean_type_node,
build_int_cst (TREE_TYPE (len), 0)); len, build_int_cst (TREE_TYPE (len), 0));
tmp = gfc_call_free (var); tmp = gfc_call_free (var);
tmp = build3_v (COND_EXPR, cond, tmp, build_empty_stmt ()); tmp = build3_v (COND_EXPR, cond, tmp, build_empty_stmt ());
gfc_add_expr_to_block (&se->post, tmp); gfc_add_expr_to_block (&se->post, tmp);
...@@ -1364,8 +1366,8 @@ gfc_conv_intrinsic_fdate (gfc_se * se, gfc_expr * expr) ...@@ -1364,8 +1366,8 @@ gfc_conv_intrinsic_fdate (gfc_se * se, gfc_expr * expr)
gfc_add_expr_to_block (&se->pre, tmp); gfc_add_expr_to_block (&se->pre, tmp);
/* Free the temporary afterwards, if necessary. */ /* Free the temporary afterwards, if necessary. */
cond = build2 (GT_EXPR, boolean_type_node, len, cond = fold_build2 (GT_EXPR, boolean_type_node,
build_int_cst (TREE_TYPE (len), 0)); len, build_int_cst (TREE_TYPE (len), 0));
tmp = gfc_call_free (var); tmp = gfc_call_free (var);
tmp = build3_v (COND_EXPR, cond, tmp, build_empty_stmt ()); tmp = build3_v (COND_EXPR, cond, tmp, build_empty_stmt ());
gfc_add_expr_to_block (&se->post, tmp); gfc_add_expr_to_block (&se->post, tmp);
...@@ -1407,8 +1409,8 @@ gfc_conv_intrinsic_ttynam (gfc_se * se, gfc_expr * expr) ...@@ -1407,8 +1409,8 @@ gfc_conv_intrinsic_ttynam (gfc_se * se, gfc_expr * expr)
gfc_add_expr_to_block (&se->pre, tmp); gfc_add_expr_to_block (&se->pre, tmp);
/* Free the temporary afterwards, if necessary. */ /* Free the temporary afterwards, if necessary. */
cond = build2 (GT_EXPR, boolean_type_node, len, cond = fold_build2 (GT_EXPR, boolean_type_node,
build_int_cst (TREE_TYPE (len), 0)); len, build_int_cst (TREE_TYPE (len), 0));
tmp = gfc_call_free (var); tmp = gfc_call_free (var);
tmp = build3_v (COND_EXPR, cond, tmp, build_empty_stmt ()); tmp = build3_v (COND_EXPR, cond, tmp, build_empty_stmt ());
gfc_add_expr_to_block (&se->post, tmp); gfc_add_expr_to_block (&se->post, tmp);
...@@ -1470,7 +1472,8 @@ gfc_conv_intrinsic_minmax (gfc_se * se, gfc_expr * expr, int op) ...@@ -1470,7 +1472,8 @@ gfc_conv_intrinsic_minmax (gfc_se * se, gfc_expr * expr, int op)
if (argexpr->expr->expr_type == EXPR_VARIABLE if (argexpr->expr->expr_type == EXPR_VARIABLE
&& argexpr->expr->symtree->n.sym->attr.optional && argexpr->expr->symtree->n.sym->attr.optional
&& TREE_CODE (val) == INDIRECT_REF) && TREE_CODE (val) == INDIRECT_REF)
cond = build2 (NE_EXPR, boolean_type_node, TREE_OPERAND (val, 0), cond = fold_build2
(NE_EXPR, boolean_type_node, TREE_OPERAND (val, 0),
build_int_cst (TREE_TYPE (TREE_OPERAND (val, 0)), 0)); build_int_cst (TREE_TYPE (TREE_OPERAND (val, 0)), 0));
else else
{ {
...@@ -1483,7 +1486,7 @@ gfc_conv_intrinsic_minmax (gfc_se * se, gfc_expr * expr, int op) ...@@ -1483,7 +1486,7 @@ gfc_conv_intrinsic_minmax (gfc_se * se, gfc_expr * expr, int op)
thencase = build2_v (MODIFY_EXPR, mvar, convert (type, val)); thencase = build2_v (MODIFY_EXPR, mvar, convert (type, val));
tmp = build2 (op, boolean_type_node, convert (type, val), mvar); tmp = fold_build2 (op, boolean_type_node, convert (type, val), mvar);
/* FIXME: When the IEEE_ARITHMETIC module is implemented, the call to /* FIXME: When the IEEE_ARITHMETIC module is implemented, the call to
__builtin_isnan might be made dependent on that module being loaded, __builtin_isnan might be made dependent on that module being loaded,
...@@ -1534,8 +1537,8 @@ gfc_conv_intrinsic_minmax_char (gfc_se * se, gfc_expr * expr, int op) ...@@ -1534,8 +1537,8 @@ gfc_conv_intrinsic_minmax_char (gfc_se * se, gfc_expr * expr, int op)
gfc_add_expr_to_block (&se->pre, tmp); gfc_add_expr_to_block (&se->pre, tmp);
/* Free the temporary afterwards, if necessary. */ /* Free the temporary afterwards, if necessary. */
cond = build2 (GT_EXPR, boolean_type_node, len, cond = fold_build2 (GT_EXPR, boolean_type_node,
build_int_cst (TREE_TYPE (len), 0)); len, build_int_cst (TREE_TYPE (len), 0));
tmp = gfc_call_free (var); tmp = gfc_call_free (var);
tmp = build3_v (COND_EXPR, cond, tmp, build_empty_stmt ()); tmp = build3_v (COND_EXPR, cond, tmp, build_empty_stmt ());
gfc_add_expr_to_block (&se->post, tmp); gfc_add_expr_to_block (&se->post, tmp);
...@@ -1792,8 +1795,8 @@ gfc_conv_intrinsic_count (gfc_se * se, gfc_expr * expr) ...@@ -1792,8 +1795,8 @@ gfc_conv_intrinsic_count (gfc_se * se, gfc_expr * expr)
/* Generate the loop body. */ /* Generate the loop body. */
gfc_start_scalarized_body (&loop, &body); gfc_start_scalarized_body (&loop, &body);
tmp = build2 (PLUS_EXPR, TREE_TYPE (resvar), resvar, tmp = fold_build2 (PLUS_EXPR, TREE_TYPE (resvar),
build_int_cst (TREE_TYPE (resvar), 1)); resvar, build_int_cst (TREE_TYPE (resvar), 1));
tmp = build2_v (MODIFY_EXPR, resvar, tmp); tmp = build2_v (MODIFY_EXPR, resvar, tmp);
gfc_init_se (&arrayse, NULL); gfc_init_se (&arrayse, NULL);
...@@ -1903,7 +1906,7 @@ gfc_conv_intrinsic_arith (gfc_se * se, gfc_expr * expr, int op) ...@@ -1903,7 +1906,7 @@ gfc_conv_intrinsic_arith (gfc_se * se, gfc_expr * expr, int op)
gfc_conv_expr_val (&arrayse, arrayexpr); gfc_conv_expr_val (&arrayse, arrayexpr);
gfc_add_block_to_block (&block, &arrayse.pre); gfc_add_block_to_block (&block, &arrayse.pre);
tmp = build2 (op, type, resvar, arrayse.expr); tmp = fold_build2 (op, type, resvar, arrayse.expr);
gfc_add_modify_expr (&block, resvar, tmp); gfc_add_modify_expr (&block, resvar, tmp);
gfc_add_block_to_block (&block, &arrayse.post); gfc_add_block_to_block (&block, &arrayse.post);
...@@ -2007,7 +2010,7 @@ gfc_conv_intrinsic_dot_product (gfc_se * se, gfc_expr * expr) ...@@ -2007,7 +2010,7 @@ gfc_conv_intrinsic_dot_product (gfc_se * se, gfc_expr * expr)
arrayse1.ss = arrayss1; arrayse1.ss = arrayss1;
gfc_conv_expr_val (&arrayse1, arrayexpr1); gfc_conv_expr_val (&arrayse1, arrayexpr1);
if (expr->ts.type == BT_COMPLEX) if (expr->ts.type == BT_COMPLEX)
arrayse1.expr = build1 (CONJ_EXPR, type, arrayse1.expr); arrayse1.expr = fold_build1 (CONJ_EXPR, type, arrayse1.expr);
gfc_add_block_to_block (&block, &arrayse1.pre); gfc_add_block_to_block (&block, &arrayse1.pre);
/* Make the tree expression for array2. */ /* Make the tree expression for array2. */
...@@ -2020,13 +2023,13 @@ gfc_conv_intrinsic_dot_product (gfc_se * se, gfc_expr * expr) ...@@ -2020,13 +2023,13 @@ gfc_conv_intrinsic_dot_product (gfc_se * se, gfc_expr * expr)
/* Do the actual product and sum. */ /* Do the actual product and sum. */
if (expr->ts.type == BT_LOGICAL) if (expr->ts.type == BT_LOGICAL)
{ {
tmp = build2 (TRUTH_AND_EXPR, type, arrayse1.expr, arrayse2.expr); tmp = fold_build2 (TRUTH_AND_EXPR, type, arrayse1.expr, arrayse2.expr);
tmp = build2 (TRUTH_OR_EXPR, type, resvar, tmp); tmp = fold_build2 (TRUTH_OR_EXPR, type, resvar, tmp);
} }
else else
{ {
tmp = build2 (MULT_EXPR, type, arrayse1.expr, arrayse2.expr); tmp = fold_build2 (MULT_EXPR, type, arrayse1.expr, arrayse2.expr);
tmp = build2 (PLUS_EXPR, type, resvar, tmp); tmp = fold_build2 (PLUS_EXPR, type, resvar, tmp);
} }
gfc_add_modify_expr (&block, resvar, tmp); gfc_add_modify_expr (&block, resvar, tmp);
...@@ -2121,7 +2124,7 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr * expr, int op) ...@@ -2121,7 +2124,7 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr * expr, int op)
gfc_add_modify_expr (&se->pre, limit, tmp); gfc_add_modify_expr (&se->pre, limit, tmp);
if (op == GT_EXPR && expr->ts.type == BT_INTEGER) if (op == GT_EXPR && expr->ts.type == BT_INTEGER)
tmp = build2 (MINUS_EXPR, TREE_TYPE (tmp), tmp, tmp = fold_build2 (MINUS_EXPR, TREE_TYPE (tmp), tmp,
build_int_cst (type, 1)); build_int_cst (type, 1));
/* Initialize the scalarizer. */ /* Initialize the scalarizer. */
...@@ -2183,7 +2186,7 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr * expr, int op) ...@@ -2183,7 +2186,7 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr * expr, int op)
gfc_index_one_node, loop.from[0]); gfc_index_one_node, loop.from[0]);
gfc_add_modify_expr (&block, offset, tmp); gfc_add_modify_expr (&block, offset, tmp);
tmp = build2 (PLUS_EXPR, TREE_TYPE (pos), tmp = fold_build2 (PLUS_EXPR, TREE_TYPE (pos),
loop.loopvar[0], offset); loop.loopvar[0], offset);
gfc_add_modify_expr (&ifblock, pos, tmp); gfc_add_modify_expr (&ifblock, pos, tmp);
...@@ -2191,11 +2194,14 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr * expr, int op) ...@@ -2191,11 +2194,14 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr * expr, int op)
/* If it is a more extreme value or pos is still zero and the value /* If it is a more extreme value or pos is still zero and the value
equal to the limit. */ equal to the limit. */
tmp = build2 (TRUTH_AND_EXPR, boolean_type_node, tmp = fold_build2 (TRUTH_AND_EXPR, boolean_type_node,
build2 (EQ_EXPR, boolean_type_node, pos, gfc_index_zero_node), fold_build2 (EQ_EXPR, boolean_type_node,
build2 (EQ_EXPR, boolean_type_node, arrayse.expr, limit)); pos, gfc_index_zero_node),
tmp = build2 (TRUTH_OR_EXPR, boolean_type_node, fold_build2 (EQ_EXPR, boolean_type_node,
build2 (op, boolean_type_node, arrayse.expr, limit), tmp); arrayse.expr, limit));
tmp = fold_build2 (TRUTH_OR_EXPR, boolean_type_node,
fold_build2 (op, boolean_type_node,
arrayse.expr, limit), tmp);
tmp = build3_v (COND_EXPR, tmp, ifbody, build_empty_stmt ()); tmp = build3_v (COND_EXPR, tmp, ifbody, build_empty_stmt ());
gfc_add_expr_to_block (&block, tmp); gfc_add_expr_to_block (&block, tmp);
...@@ -2294,8 +2300,8 @@ gfc_conv_intrinsic_minmaxval (gfc_se * se, gfc_expr * expr, int op) ...@@ -2294,8 +2300,8 @@ gfc_conv_intrinsic_minmaxval (gfc_se * se, gfc_expr * expr, int op)
tmp = fold_build1 (NEGATE_EXPR, TREE_TYPE (tmp), tmp); tmp = fold_build1 (NEGATE_EXPR, TREE_TYPE (tmp), tmp);
if (op == GT_EXPR && expr->ts.type == BT_INTEGER) if (op == GT_EXPR && expr->ts.type == BT_INTEGER)
tmp = build2 (MINUS_EXPR, TREE_TYPE (tmp), tmp, tmp = fold_build2 (MINUS_EXPR, TREE_TYPE (tmp),
build_int_cst (type, 1)); tmp, build_int_cst (type, 1));
gfc_add_modify_expr (&se->pre, limit, tmp); gfc_add_modify_expr (&se->pre, limit, tmp);
...@@ -2357,7 +2363,7 @@ gfc_conv_intrinsic_minmaxval (gfc_se * se, gfc_expr * expr, int op) ...@@ -2357,7 +2363,7 @@ gfc_conv_intrinsic_minmaxval (gfc_se * se, gfc_expr * expr, int op)
ifbody = build2_v (MODIFY_EXPR, limit, arrayse.expr); ifbody = build2_v (MODIFY_EXPR, limit, arrayse.expr);
/* If it is a more extreme value. */ /* If it is a more extreme value. */
tmp = build2 (op, boolean_type_node, arrayse.expr, limit); tmp = fold_build2 (op, boolean_type_node, arrayse.expr, limit);
tmp = build3_v (COND_EXPR, tmp, ifbody, build_empty_stmt ()); tmp = build3_v (COND_EXPR, tmp, ifbody, build_empty_stmt ());
gfc_add_expr_to_block (&block, tmp); gfc_add_expr_to_block (&block, tmp);
gfc_add_block_to_block (&block, &arrayse.post); gfc_add_block_to_block (&block, &arrayse.post);
...@@ -2406,8 +2412,8 @@ gfc_conv_intrinsic_btest (gfc_se * se, gfc_expr * expr) ...@@ -2406,8 +2412,8 @@ gfc_conv_intrinsic_btest (gfc_se * se, gfc_expr * expr)
gfc_conv_intrinsic_function_args (se, expr, args, 2); gfc_conv_intrinsic_function_args (se, expr, args, 2);
type = TREE_TYPE (args[0]); type = TREE_TYPE (args[0]);
tmp = build2 (LSHIFT_EXPR, type, build_int_cst (type, 1), args[1]); tmp = fold_build2 (LSHIFT_EXPR, type, build_int_cst (type, 1), args[1]);
tmp = build2 (BIT_AND_EXPR, type, args[0], tmp); tmp = fold_build2 (BIT_AND_EXPR, type, args[0], tmp);
tmp = fold_build2 (NE_EXPR, boolean_type_node, tmp, tmp = fold_build2 (NE_EXPR, boolean_type_node, tmp,
build_int_cst (type, 0)); build_int_cst (type, 0));
type = gfc_typenode_for_spec (&expr->ts); type = gfc_typenode_for_spec (&expr->ts);
...@@ -2431,7 +2437,7 @@ gfc_conv_intrinsic_not (gfc_se * se, gfc_expr * expr) ...@@ -2431,7 +2437,7 @@ gfc_conv_intrinsic_not (gfc_se * se, gfc_expr * expr)
tree arg; tree arg;
gfc_conv_intrinsic_function_args (se, expr, &arg, 1); gfc_conv_intrinsic_function_args (se, expr, &arg, 1);
se->expr = build1 (BIT_NOT_EXPR, TREE_TYPE (arg), arg); se->expr = fold_build1 (BIT_NOT_EXPR, TREE_TYPE (arg), arg);
} }
/* Set or clear a single bit. */ /* Set or clear a single bit. */
...@@ -2471,10 +2477,10 @@ gfc_conv_intrinsic_ibits (gfc_se * se, gfc_expr * expr) ...@@ -2471,10 +2477,10 @@ gfc_conv_intrinsic_ibits (gfc_se * se, gfc_expr * expr)
type = TREE_TYPE (args[0]); type = TREE_TYPE (args[0]);
mask = build_int_cst (type, -1); mask = build_int_cst (type, -1);
mask = build2 (LSHIFT_EXPR, type, mask, args[2]); mask = fold_build2 (LSHIFT_EXPR, type, mask, args[2]);
mask = build1 (BIT_NOT_EXPR, type, mask); mask = fold_build1 (BIT_NOT_EXPR, type, mask);
tmp = build2 (RSHIFT_EXPR, type, args[0], args[1]); tmp = fold_build2 (RSHIFT_EXPR, type, args[0], args[1]);
se->expr = fold_build2 (BIT_AND_EXPR, type, tmp, mask); se->expr = fold_build2 (BIT_AND_EXPR, type, tmp, mask);
} }
...@@ -2523,7 +2529,7 @@ gfc_conv_intrinsic_ishft (gfc_se * se, gfc_expr * expr) ...@@ -2523,7 +2529,7 @@ gfc_conv_intrinsic_ishft (gfc_se * se, gfc_expr * expr)
The standard doesn't define the case of shifting negative The standard doesn't define the case of shifting negative
numbers, and we try to be compatible with other compilers, most numbers, and we try to be compatible with other compilers, most
notably g77, here. */ notably g77, here. */
rshift = fold_convert (type, build2 (RSHIFT_EXPR, utype, rshift = fold_convert (type, fold_build2 (RSHIFT_EXPR, utype,
convert (utype, args[0]), width)); convert (utype, args[0]), width));
tmp = fold_build2 (GE_EXPR, boolean_type_node, args[1], tmp = fold_build2 (GE_EXPR, boolean_type_node, args[1],
...@@ -2740,7 +2746,7 @@ gfc_conv_intrinsic_ichar (gfc_se * se, gfc_expr * expr) ...@@ -2740,7 +2746,7 @@ gfc_conv_intrinsic_ichar (gfc_se * se, gfc_expr * expr)
gfc_conv_intrinsic_function_args (se, expr, args, 2); gfc_conv_intrinsic_function_args (se, expr, args, 2);
gcc_assert (POINTER_TYPE_P (TREE_TYPE (args[1]))); gcc_assert (POINTER_TYPE_P (TREE_TYPE (args[1])));
args[1] = build1 (NOP_EXPR, pchar_type_node, args[1]); args[1] = fold_build1 (NOP_EXPR, pchar_type_node, args[1]);
type = gfc_typenode_for_spec (&expr->ts); type = gfc_typenode_for_spec (&expr->ts);
se->expr = build_fold_indirect_ref (args[1]); se->expr = build_fold_indirect_ref (args[1]);
...@@ -2868,10 +2874,10 @@ gfc_conv_intrinsic_size (gfc_se * se, gfc_expr * expr) ...@@ -2868,10 +2874,10 @@ gfc_conv_intrinsic_size (gfc_se * se, gfc_expr * expr)
argse.data_not_needed = 1; argse.data_not_needed = 1;
gfc_conv_expr (&argse, actual->expr); gfc_conv_expr (&argse, actual->expr);
gfc_add_block_to_block (&se->pre, &argse.pre); gfc_add_block_to_block (&se->pre, &argse.pre);
tmp = build2 (NE_EXPR, boolean_type_node, argse.expr, tmp = fold_build2 (NE_EXPR, boolean_type_node,
null_pointer_node); argse.expr, null_pointer_node);
tmp = gfc_evaluate_now (tmp, &se->pre); tmp = gfc_evaluate_now (tmp, &se->pre);
se->expr = build3 (COND_EXPR, pvoid_type_node, se->expr = fold_build3 (COND_EXPR, pvoid_type_node,
tmp, fncall1, fncall0); tmp, fncall1, fncall0);
} }
else else
...@@ -3079,7 +3085,7 @@ gfc_conv_intrinsic_array_transfer (gfc_se * se, gfc_expr * expr) ...@@ -3079,7 +3085,7 @@ gfc_conv_intrinsic_array_transfer (gfc_se * se, gfc_expr * expr)
/* Clean up if it was repacked. */ /* Clean up if it was repacked. */
gfc_init_block (&block); gfc_init_block (&block);
tmp = gfc_conv_array_data (argse.expr); tmp = gfc_conv_array_data (argse.expr);
tmp = build2 (NE_EXPR, boolean_type_node, source, tmp); tmp = fold_build2 (NE_EXPR, boolean_type_node, source, tmp);
tmp = build3_v (COND_EXPR, tmp, stmt, build_empty_stmt ()); tmp = build3_v (COND_EXPR, tmp, stmt, build_empty_stmt ());
gfc_add_expr_to_block (&block, tmp); gfc_add_expr_to_block (&block, tmp);
gfc_add_block_to_block (&block, &se->post); gfc_add_block_to_block (&block, &se->post);
...@@ -3284,7 +3290,7 @@ gfc_conv_intrinsic_transfer (gfc_se * se, gfc_expr * expr) ...@@ -3284,7 +3290,7 @@ gfc_conv_intrinsic_transfer (gfc_se * se, gfc_expr * expr)
moldsize = size_in_bytes (type); moldsize = size_in_bytes (type);
/* Use memcpy to do the transfer. */ /* Use memcpy to do the transfer. */
tmp = build1 (ADDR_EXPR, build_pointer_type (type), tmpdecl); tmp = fold_build1 (ADDR_EXPR, build_pointer_type (type), tmpdecl);
tmp = build_call_expr (built_in_decls[BUILT_IN_MEMCPY], 3, tmp = build_call_expr (built_in_decls[BUILT_IN_MEMCPY], 3,
fold_convert (pvoid_type_node, tmp), fold_convert (pvoid_type_node, tmp),
fold_convert (pvoid_type_node, ptr), fold_convert (pvoid_type_node, ptr),
...@@ -3314,8 +3320,8 @@ gfc_conv_allocated (gfc_se *se, gfc_expr *expr) ...@@ -3314,8 +3320,8 @@ gfc_conv_allocated (gfc_se *se, gfc_expr *expr)
gfc_conv_expr_descriptor (&arg1se, arg1->expr, ss1); gfc_conv_expr_descriptor (&arg1se, arg1->expr, ss1);
tmp = gfc_conv_descriptor_data_get (arg1se.expr); tmp = gfc_conv_descriptor_data_get (arg1se.expr);
tmp = build2 (NE_EXPR, boolean_type_node, tmp, tmp = fold_build2 (NE_EXPR, boolean_type_node,
fold_convert (TREE_TYPE (tmp), null_pointer_node)); tmp, fold_convert (TREE_TYPE (tmp), null_pointer_node));
se->expr = convert (gfc_typenode_for_spec (&expr->ts), tmp); se->expr = convert (gfc_typenode_for_spec (&expr->ts), tmp);
} }
...@@ -3363,7 +3369,7 @@ gfc_conv_associated (gfc_se *se, gfc_expr *expr) ...@@ -3363,7 +3369,7 @@ gfc_conv_associated (gfc_se *se, gfc_expr *expr)
} }
gfc_add_block_to_block (&se->pre, &arg1se.pre); gfc_add_block_to_block (&se->pre, &arg1se.pre);
gfc_add_block_to_block (&se->post, &arg1se.post); gfc_add_block_to_block (&se->post, &arg1se.post);
tmp = build2 (NE_EXPR, boolean_type_node, tmp2, tmp = fold_build2 (NE_EXPR, boolean_type_node, tmp2,
fold_convert (TREE_TYPE (tmp2), null_pointer_node)); fold_convert (TREE_TYPE (tmp2), null_pointer_node));
se->expr = tmp; se->expr = tmp;
} }
...@@ -3374,7 +3380,7 @@ gfc_conv_associated (gfc_se *se, gfc_expr *expr) ...@@ -3374,7 +3380,7 @@ gfc_conv_associated (gfc_se *se, gfc_expr *expr)
nonzero_charlen = NULL_TREE; nonzero_charlen = NULL_TREE;
if (arg1->expr->ts.type == BT_CHARACTER) if (arg1->expr->ts.type == BT_CHARACTER)
nonzero_charlen = build2 (NE_EXPR, boolean_type_node, nonzero_charlen = fold_build2 (NE_EXPR, boolean_type_node,
arg1->expr->ts.cl->backend_decl, arg1->expr->ts.cl->backend_decl,
integer_zero_node); integer_zero_node);
...@@ -3388,10 +3394,12 @@ gfc_conv_associated (gfc_se *se, gfc_expr *expr) ...@@ -3388,10 +3394,12 @@ gfc_conv_associated (gfc_se *se, gfc_expr *expr)
gfc_conv_expr (&arg2se, arg2->expr); gfc_conv_expr (&arg2se, arg2->expr);
gfc_add_block_to_block (&se->pre, &arg1se.pre); gfc_add_block_to_block (&se->pre, &arg1se.pre);
gfc_add_block_to_block (&se->post, &arg1se.post); gfc_add_block_to_block (&se->post, &arg1se.post);
tmp = build2 (EQ_EXPR, boolean_type_node, arg1se.expr, arg2se.expr); tmp = fold_build2 (EQ_EXPR, boolean_type_node,
tmp2 = build2 (NE_EXPR, boolean_type_node, arg1se.expr, arg1se.expr, arg2se.expr);
null_pointer_node); tmp2 = fold_build2 (NE_EXPR, boolean_type_node,
se->expr = build2 (TRUTH_AND_EXPR, boolean_type_node, tmp, tmp2); arg1se.expr, null_pointer_node);
se->expr = fold_build2 (TRUTH_AND_EXPR, boolean_type_node,
tmp, tmp2);
} }
else else
{ {
...@@ -3401,8 +3409,8 @@ gfc_conv_associated (gfc_se *se, gfc_expr *expr) ...@@ -3401,8 +3409,8 @@ gfc_conv_associated (gfc_se *se, gfc_expr *expr)
gfc_conv_expr_lhs (&arg1se, arg1->expr); gfc_conv_expr_lhs (&arg1se, arg1->expr);
tmp = gfc_conv_descriptor_stride (arg1se.expr, tmp = gfc_conv_descriptor_stride (arg1se.expr,
gfc_rank_cst[arg1->expr->rank - 1]); gfc_rank_cst[arg1->expr->rank - 1]);
nonzero_arraylen = build2 (NE_EXPR, boolean_type_node, nonzero_arraylen = fold_build2 (NE_EXPR, boolean_type_node, tmp,
tmp, build_int_cst (TREE_TYPE (tmp), 0)); build_int_cst (TREE_TYPE (tmp), 0));
/* A pointer to an array, call library function _gfor_associated. */ /* A pointer to an array, call library function _gfor_associated. */
gcc_assert (ss2 != gfc_ss_terminator); gcc_assert (ss2 != gfc_ss_terminator);
...@@ -3416,14 +3424,14 @@ gfc_conv_associated (gfc_se *se, gfc_expr *expr) ...@@ -3416,14 +3424,14 @@ gfc_conv_associated (gfc_se *se, gfc_expr *expr)
se->expr = build_call_expr (gfor_fndecl_associated, 2, se->expr = build_call_expr (gfor_fndecl_associated, 2,
arg1se.expr, arg2se.expr); arg1se.expr, arg2se.expr);
se->expr = convert (boolean_type_node, se->expr); se->expr = convert (boolean_type_node, se->expr);
se->expr = build2 (TRUTH_AND_EXPR, boolean_type_node, se->expr = fold_build2 (TRUTH_AND_EXPR, boolean_type_node,
se->expr, nonzero_arraylen); se->expr, nonzero_arraylen);
} }
/* If target is present zero character length pointers cannot /* If target is present zero character length pointers cannot
be associated. */ be associated. */
if (nonzero_charlen != NULL_TREE) if (nonzero_charlen != NULL_TREE)
se->expr = build2 (TRUTH_AND_EXPR, boolean_type_node, se->expr = fold_build2 (TRUTH_AND_EXPR, boolean_type_node,
se->expr, nonzero_charlen); se->expr, nonzero_charlen);
} }
...@@ -3527,8 +3535,8 @@ gfc_conv_intrinsic_trim (gfc_se * se, gfc_expr * expr) ...@@ -3527,8 +3535,8 @@ gfc_conv_intrinsic_trim (gfc_se * se, gfc_expr * expr)
gfc_add_expr_to_block (&se->pre, tmp); gfc_add_expr_to_block (&se->pre, tmp);
/* Free the temporary afterwards, if necessary. */ /* Free the temporary afterwards, if necessary. */
cond = build2 (GT_EXPR, boolean_type_node, len, cond = fold_build2 (GT_EXPR, boolean_type_node,
build_int_cst (TREE_TYPE (len), 0)); len, build_int_cst (TREE_TYPE (len), 0));
tmp = gfc_call_free (var); tmp = gfc_call_free (var);
tmp = build3_v (COND_EXPR, cond, tmp, build_empty_stmt ()); tmp = build3_v (COND_EXPR, cond, tmp, build_empty_stmt ());
gfc_add_expr_to_block (&se->post, tmp); gfc_add_expr_to_block (&se->post, tmp);
...@@ -3632,8 +3640,8 @@ gfc_conv_intrinsic_repeat (gfc_se * se, gfc_expr * expr) ...@@ -3632,8 +3640,8 @@ gfc_conv_intrinsic_repeat (gfc_se * se, gfc_expr * expr)
gfc_add_expr_to_block (&body, tmp); gfc_add_expr_to_block (&body, tmp);
/* Increment count. */ /* Increment count. */
tmp = build2 (PLUS_EXPR, ncopies_type, count, tmp = fold_build2 (PLUS_EXPR, ncopies_type,
build_int_cst (TREE_TYPE (count), 1)); count, build_int_cst (TREE_TYPE (count), 1));
gfc_add_modify_expr (&body, count, tmp); gfc_add_modify_expr (&body, count, tmp);
/* Build the loop. */ /* Build the loop. */
......
gcc/fortran/trans-io.c
/* 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,9 +429,9 @@ set_parameter_const (stmtblock_t *block, tree var, enum iofield type, ...@@ -429,9 +429,9 @@ 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,
st_parameter[IOPARM_ptype_common].type,
var, TYPE_FIELDS (TREE_TYPE (var)), NULL_TREE); var, TYPE_FIELDS (TREE_TYPE (var)), NULL_TREE);
locus_file = build3 (COMPONENT_REF, TREE_TYPE (p->field), locus_file, locus_file = fold_build3 (COMPONENT_REF, TREE_TYPE (p->field),
p->field, NULL_TREE); 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,7 +1359,7 @@ nml_get_addr_expr (gfc_symbol * sym, gfc_component * c, ...@@ -1357,7 +1359,7 @@ 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
...@@ -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)
{ {
......
gcc/fortran/trans-openmp.c
/* 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,7 +961,7 @@ gfc_trans_omp_do (gfc_code *code, stmtblock_t *pblock, ...@@ -961,7 +961,7 @@ 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);
...@@ -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);
} }
......
gcc/fortran/trans-stmt.c
/* 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,7 +444,7 @@ gfc_trans_return (gfc_code * code ATTRIBUTE_UNUSED) ...@@ -444,7 +444,7 @@ 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);
...@@ -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,7 +1374,7 @@ gfc_trans_character_select (gfc_code *code) ...@@ -1373,7 +1374,7 @@ 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,13 +1784,13 @@ gfc_trans_forall_loop (forall_info *forall_tmp, tree body, ...@@ -1783,13 +1784,13 @@ 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);
...@@ -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,7 +2818,7 @@ gfc_trans_forall_1 (gfc_code * code, forall_info * nested_forall_info) ...@@ -2817,7 +2818,7 @@ 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);
...@@ -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,7 +3816,7 @@ gfc_trans_allocate (gfc_code * code) ...@@ -3815,7 +3816,7 @@ 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);
...@@ -3944,7 +3945,7 @@ gfc_trans_deallocate (gfc_code * code) ...@@ -3944,7 +3945,7 @@ 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));
} }
...@@ -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);
} }
......
gcc/fortran/trans.c
/* 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,7 +414,7 @@ gfc_trans_runtime_check (tree cond, stmtblock_t * pblock, locus * where, ...@@ -414,7 +414,7 @@ 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);
...@@ -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