Skip to content

R
riscv-gcc-1
Commit 65a9ca82 by Tobias Burnus Committed by Tobias Burnus
Options

re PR fortran/45186 (Gfortran 4.5.0 emits wrong linenumbers) 

2010-09-03  Tobias Burnus  <burnus@net-b.de>

        PR fortran/45186
        * trans-intrinsic.c (gfc_conv_intrinsic_sign,
        gfc_conv_intrinsic_leadz): Use build_call_expr_loc instead
        of build_call_expr.
        * trans-expr.c (gfc_conv_expr_present, gfc_conv_missing_dummy,
        gfc_conv_string_length, gfc_conv_substring,
        gfc_conv_component_ref, gfc_conv_unary_op, gfc_conv_powi,
        gfc_conv_cst_int_power, gfc_conv_string_tmp, gfc_conv_concat_op,
        gfc_conv_expr_op, gfc_build_compare_string,
        gfc_set_interface_mapping_bounds, gfc_conv_subref_array_arg,
        gfc_conv_derived_to_class, conv_isocbinding_procedure,
        gfc_conv_procedure_call, fill_with_spaces,
        gfc_trans_string_copy, gfc_trans_alloc_subarray_assign,
        gfc_trans_structure_assign, gfc_trans_pointer_assignment,
        gfc_trans_scalar_assign, gfc_trans_zero_assign,
        gfc_trans_array_copy, gfc_trans_array_constructor_copy): Change
        fold_build[0-9] to fold_build[0-9]_loc.
        * trans-io.c (set_parameter_const, set_parameter_value,
        set_parameter_ref, gfc_convert_array_to_string, set_string,
        set_internal_unit, io_result, set_error_locus,
        nml_get_addr_expr, build_dt): Ditto.
        * trans-openmp.c (gfc_omp_clause_default_ctor,
        gfc_omp_clause_copy_ctor, gfc_omp_clause_assign_op,
        gfc_trans_omp_array_reduction, gfc_trans_omp_atomic,
        gfc_trans_omp_do): Ditto.
        * trans.c (gfc_add_modify, gfc_build_addr_expr,
        gfc_build_array_ref, gfc_trans_runtime_error_vararg,
        gfc_trans_runtime_check, gfc_call_malloc,
        gfc_allocate_with_status, gfc_allocate_array_with_status,
        gfc_call_free, gfc_deallocate_with_status,
        gfc_call_realloc): Ditto.

From-SVN: r163838
parent d7830142
Showing with 415 additions and 274 deletions
gcc/fortran/ChangeLog
2010-09-03 Tobias Burnus <burnus@net-b.de>
PR fortran/45186
* trans-intrinsic.c (gfc_conv_intrinsic_sign,
gfc_conv_intrinsic_leadz): Use build_call_expr_loc instead
of build_call_expr.
* trans-expr.c (gfc_conv_expr_present, gfc_conv_missing_dummy,
gfc_conv_string_length, gfc_conv_substring,
gfc_conv_component_ref, gfc_conv_unary_op, gfc_conv_powi,
gfc_conv_cst_int_power, gfc_conv_string_tmp, gfc_conv_concat_op,
gfc_conv_expr_op, gfc_build_compare_string,
gfc_set_interface_mapping_bounds, gfc_conv_subref_array_arg,
gfc_conv_derived_to_class, conv_isocbinding_procedure,
gfc_conv_procedure_call, fill_with_spaces,
gfc_trans_string_copy, gfc_trans_alloc_subarray_assign,
gfc_trans_structure_assign, gfc_trans_pointer_assignment,
gfc_trans_scalar_assign, gfc_trans_zero_assign,
gfc_trans_array_copy, gfc_trans_array_constructor_copy): Change
fold_build[0-9] to fold_build[0-9]_loc.
* trans-io.c (set_parameter_const, set_parameter_value,
set_parameter_ref, gfc_convert_array_to_string, set_string,
set_internal_unit, io_result, set_error_locus,
nml_get_addr_expr, build_dt): Ditto.
* trans-openmp.c (gfc_omp_clause_default_ctor,
gfc_omp_clause_copy_ctor, gfc_omp_clause_assign_op,
gfc_trans_omp_array_reduction, gfc_trans_omp_atomic,
gfc_trans_omp_do): Ditto.
* trans.c (gfc_add_modify, gfc_build_addr_expr,
gfc_build_array_ref, gfc_trans_runtime_error_vararg,
gfc_trans_runtime_check, gfc_call_malloc,
gfc_allocate_with_status, gfc_allocate_array_with_status,
gfc_call_free, gfc_deallocate_with_status,
gfc_call_realloc): Ditto.
2010-09-03 Thomas Koenig <tkoenig@gcc.gnu.org> 2010-09-03 Thomas Koenig <tkoenig@gcc.gnu.org>
PR fortran/45159 PR fortran/45159
......
gcc/fortran/trans-expr.c
...@@ -137,7 +137,7 @@ gfc_conv_expr_present (gfc_symbol * sym) ...@@ -137,7 +137,7 @@ gfc_conv_expr_present (gfc_symbol * sym)
decl = GFC_DECL_SAVED_DESCRIPTOR (decl); decl = GFC_DECL_SAVED_DESCRIPTOR (decl);
} }
cond = fold_build2 (NE_EXPR, boolean_type_node, decl, cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, decl,
fold_convert (TREE_TYPE (decl), null_pointer_node)); fold_convert (TREE_TYPE (decl), null_pointer_node));
/* Fortran 2008 allows to pass null pointers and non-associated pointers /* Fortran 2008 allows to pass null pointers and non-associated pointers
...@@ -150,9 +150,10 @@ gfc_conv_expr_present (gfc_symbol * sym) ...@@ -150,9 +150,10 @@ gfc_conv_expr_present (gfc_symbol * sym)
tree tmp; tree tmp;
tmp = build_fold_indirect_ref_loc (input_location, decl); tmp = build_fold_indirect_ref_loc (input_location, decl);
tmp = gfc_conv_array_data (tmp); tmp = gfc_conv_array_data (tmp);
tmp = fold_build2 (NE_EXPR, boolean_type_node, tmp, tmp = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, tmp,
fold_convert (TREE_TYPE (tmp), null_pointer_node)); fold_convert (TREE_TYPE (tmp), null_pointer_node));
cond = fold_build2 (TRUTH_ANDIF_EXPR, boolean_type_node, cond, tmp); cond = fold_build2_loc (input_location, TRUTH_ANDIF_EXPR,
boolean_type_node, cond, tmp);
} }
return cond; return cond;
...@@ -193,7 +194,7 @@ gfc_conv_missing_dummy (gfc_se * se, gfc_expr * arg, gfc_typespec ts, int kind) ...@@ -193,7 +194,7 @@ 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 = fold_build3 (COND_EXPR, gfc_charlen_type_node, tmp = fold_build3_loc (input_location, COND_EXPR, gfc_charlen_type_node,
present, 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;
...@@ -358,8 +359,8 @@ gfc_conv_string_length (gfc_charlen * cl, gfc_expr * expr, stmtblock_t * pblock) ...@@ -358,8 +359,8 @@ gfc_conv_string_length (gfc_charlen * cl, gfc_expr * expr, stmtblock_t * pblock)
gcc_assert (cl->length); gcc_assert (cl->length);
gfc_conv_expr_type (&se, cl->length, gfc_charlen_type_node); gfc_conv_expr_type (&se, cl->length, gfc_charlen_type_node);
se.expr = fold_build2 (MAX_EXPR, gfc_charlen_type_node, se.expr, se.expr = fold_build2_loc (input_location, MAX_EXPR, gfc_charlen_type_node,
build_int_cst (gfc_charlen_type_node, 0)); se.expr, build_int_cst (gfc_charlen_type_node, 0));
gfc_add_block_to_block (pblock, &se.pre); gfc_add_block_to_block (pblock, &se.pre);
if (cl->backend_decl) if (cl->backend_decl)
...@@ -423,14 +424,16 @@ gfc_conv_substring (gfc_se * se, gfc_ref * ref, int kind, ...@@ -423,14 +424,16 @@ gfc_conv_substring (gfc_se * se, gfc_ref * ref, int kind,
if (gfc_option.rtcheck & GFC_RTCHECK_BOUNDS) if (gfc_option.rtcheck & GFC_RTCHECK_BOUNDS)
{ {
tree nonempty = fold_build2 (LE_EXPR, boolean_type_node, tree nonempty = fold_build2_loc (input_location, LE_EXPR,
start.expr, end.expr); boolean_type_node, start.expr,
end.expr);
/* Check lower bound. */ /* Check lower bound. */
fault = fold_build2 (LT_EXPR, boolean_type_node, start.expr, fault = fold_build2_loc (input_location, LT_EXPR, boolean_type_node,
start.expr,
build_int_cst (gfc_charlen_type_node, 1)); build_int_cst (gfc_charlen_type_node, 1));
fault = fold_build2 (TRUTH_ANDIF_EXPR, boolean_type_node, fault = fold_build2_loc (input_location, TRUTH_ANDIF_EXPR,
nonempty, fault); boolean_type_node, nonempty, fault);
if (name) if (name)
asprintf (&msg, "Substring out of bounds: lower bound (%%ld) of '%s' " asprintf (&msg, "Substring out of bounds: lower bound (%%ld) of '%s' "
"is less than one", name); "is less than one", name);
...@@ -443,10 +446,10 @@ gfc_conv_substring (gfc_se * se, gfc_ref * ref, int kind, ...@@ -443,10 +446,10 @@ gfc_conv_substring (gfc_se * se, gfc_ref * ref, int kind,
gfc_free (msg); gfc_free (msg);
/* Check upper bound. */ /* Check upper bound. */
fault = fold_build2 (GT_EXPR, boolean_type_node, end.expr, fault = fold_build2_loc (input_location, GT_EXPR, boolean_type_node,
se->string_length); end.expr, se->string_length);
fault = fold_build2 (TRUTH_ANDIF_EXPR, boolean_type_node, fault = fold_build2_loc (input_location, TRUTH_ANDIF_EXPR,
nonempty, fault); boolean_type_node, nonempty, fault);
if (name) if (name)
asprintf (&msg, "Substring out of bounds: upper bound (%%ld) of '%s' " asprintf (&msg, "Substring out of bounds: upper bound (%%ld) of '%s' "
"exceeds string length (%%ld)", name); "exceeds string length (%%ld)", name);
...@@ -460,11 +463,11 @@ gfc_conv_substring (gfc_se * se, gfc_ref * ref, int kind, ...@@ -460,11 +463,11 @@ gfc_conv_substring (gfc_se * se, gfc_ref * ref, int kind,
gfc_free (msg); gfc_free (msg);
} }
tmp = fold_build2 (MINUS_EXPR, gfc_charlen_type_node, tmp = fold_build2_loc (input_location, MINUS_EXPR, gfc_charlen_type_node,
end.expr, start.expr); end.expr, start.expr);
tmp = fold_build2 (PLUS_EXPR, gfc_charlen_type_node, tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_charlen_type_node,
build_int_cst (gfc_charlen_type_node, 1), tmp); build_int_cst (gfc_charlen_type_node, 1), tmp);
tmp = fold_build2 (MAX_EXPR, gfc_charlen_type_node, tmp, tmp = fold_build2_loc (input_location, MAX_EXPR, gfc_charlen_type_node, tmp,
build_int_cst (gfc_charlen_type_node, 0)); build_int_cst (gfc_charlen_type_node, 0));
se->string_length = tmp; se->string_length = tmp;
} }
...@@ -487,7 +490,8 @@ gfc_conv_component_ref (gfc_se * se, gfc_ref * ref) ...@@ -487,7 +490,8 @@ 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 = fold_build3 (COMPONENT_REF, TREE_TYPE (field), decl, field, NULL_TREE); tmp = fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (field),
decl, field, NULL_TREE);
se->expr = tmp; se->expr = tmp;
...@@ -769,10 +773,10 @@ gfc_conv_unary_op (enum tree_code code, gfc_se * se, gfc_expr * expr) ...@@ -769,10 +773,10 @@ gfc_conv_unary_op (enum tree_code code, gfc_se * se, gfc_expr * expr)
We must convert it to a compare to 0 (e.g. EQ_EXPR (op1, 0)). We must convert it to a compare to 0 (e.g. EQ_EXPR (op1, 0)).
All other unary operators have an equivalent GIMPLE unary operator. */ All other unary operators have an equivalent GIMPLE unary operator. */
if (code == TRUTH_NOT_EXPR) if (code == TRUTH_NOT_EXPR)
se->expr = fold_build2 (EQ_EXPR, type, operand.expr, se->expr = fold_build2_loc (input_location, EQ_EXPR, type, operand.expr,
build_int_cst (type, 0)); build_int_cst (type, 0));
else else
se->expr = fold_build1 (code, type, operand.expr); se->expr = fold_build1_loc (input_location, code, type, operand.expr);
} }
...@@ -859,7 +863,7 @@ gfc_conv_powi (gfc_se * se, unsigned HOST_WIDE_INT n, tree * tmpvar) ...@@ -859,7 +863,7 @@ gfc_conv_powi (gfc_se * se, unsigned HOST_WIDE_INT n, tree * tmpvar)
op1 = op0; op1 = op0;
} }
tmp = fold_build2 (MULT_EXPR, TREE_TYPE (op0), op0, op1); tmp = fold_build2_loc (input_location, MULT_EXPR, TREE_TYPE (op0), op0, op1);
tmp = gfc_evaluate_now (tmp, &se->pre); tmp = gfc_evaluate_now (tmp, &se->pre);
if (n < POWI_TABLE_SIZE) if (n < POWI_TABLE_SIZE)
...@@ -910,26 +914,28 @@ gfc_conv_cst_int_power (gfc_se * se, tree lhs, tree rhs) ...@@ -910,26 +914,28 @@ 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 = fold_build2 (EQ_EXPR, boolean_type_node, tmp = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
lhs, build_int_cst (TREE_TYPE (lhs), -1)); lhs, build_int_cst (TREE_TYPE (lhs), -1));
cond = fold_build2 (EQ_EXPR, boolean_type_node, cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
lhs, 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 = fold_build2 (TRUTH_OR_EXPR, boolean_type_node, tmp, cond); tmp = fold_build2_loc (input_location, TRUTH_OR_EXPR,
se->expr = fold_build3 (COND_EXPR, type, boolean_type_node, tmp, cond);
se->expr = fold_build3_loc (input_location, COND_EXPR, type,
tmp, build_int_cst (type, 1), 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 = fold_build3 (COND_EXPR, type, tmp, build_int_cst (type, -1), tmp = fold_build3_loc (input_location, COND_EXPR, type, tmp,
build_int_cst (type, -1),
build_int_cst (type, 0)); build_int_cst (type, 0));
se->expr = fold_build3 (COND_EXPR, type, se->expr = fold_build3_loc (input_location, COND_EXPR, type,
cond, build_int_cst (type, 1), tmp); cond, build_int_cst (type, 1), tmp);
return 1; return 1;
} }
...@@ -939,7 +945,8 @@ gfc_conv_cst_int_power (gfc_se * se, tree lhs, tree rhs) ...@@ -939,7 +945,8 @@ 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] = fold_build2 (RDIV_EXPR, type, tmp, vartmp[1]); vartmp[1] = fold_build2_loc (input_location, RDIV_EXPR, type, tmp,
vartmp[1]);
} }
se->expr = gfc_conv_powi (se, n, vartmp); se->expr = gfc_conv_powi (se, n, vartmp);
...@@ -1115,7 +1122,8 @@ gfc_conv_string_tmp (gfc_se * se, tree type, tree len) ...@@ -1115,7 +1122,8 @@ gfc_conv_string_tmp (gfc_se * se, tree type, tree len)
if (gfc_can_put_var_on_stack (len)) if (gfc_can_put_var_on_stack (len))
{ {
/* Create a temporary variable to hold the result. */ /* Create a temporary variable to hold the result. */
tmp = fold_build2 (MINUS_EXPR, gfc_charlen_type_node, len, tmp = fold_build2_loc (input_location, MINUS_EXPR,
gfc_charlen_type_node, len,
build_int_cst (gfc_charlen_type_node, 1)); build_int_cst (gfc_charlen_type_node, 1));
tmp = build_range_type (gfc_array_index_type, gfc_index_zero_node, tmp); tmp = build_range_type (gfc_array_index_type, gfc_index_zero_node, tmp);
...@@ -1132,7 +1140,8 @@ gfc_conv_string_tmp (gfc_se * se, tree type, tree len) ...@@ -1132,7 +1140,8 @@ gfc_conv_string_tmp (gfc_se * se, tree type, tree len)
/* Allocate a temporary to hold the result. */ /* Allocate a temporary to hold the result. */
var = gfc_create_var (type, "pstr"); var = gfc_create_var (type, "pstr");
tmp = gfc_call_malloc (&se->pre, type, tmp = gfc_call_malloc (&se->pre, type,
fold_build2 (MULT_EXPR, TREE_TYPE (len), len, fold_build2_loc (input_location, MULT_EXPR,
TREE_TYPE (len), len,
fold_convert (TREE_TYPE (len), fold_convert (TREE_TYPE (len),
TYPE_SIZE (type)))); TYPE_SIZE (type))));
gfc_add_modify (&se->pre, var, tmp); gfc_add_modify (&se->pre, var, tmp);
...@@ -1173,7 +1182,8 @@ gfc_conv_concat_op (gfc_se * se, gfc_expr * expr) ...@@ -1173,7 +1182,8 @@ gfc_conv_concat_op (gfc_se * se, gfc_expr * expr)
len = TYPE_MAX_VALUE (TYPE_DOMAIN (type)); len = TYPE_MAX_VALUE (TYPE_DOMAIN (type));
if (len == NULL_TREE) if (len == NULL_TREE)
{ {
len = fold_build2 (PLUS_EXPR, TREE_TYPE (lse.string_length), len = fold_build2_loc (input_location, PLUS_EXPR,
TREE_TYPE (lse.string_length),
lse.string_length, rse.string_length); lse.string_length, rse.string_length);
} }
...@@ -1377,11 +1387,12 @@ gfc_conv_expr_op (gfc_se * se, gfc_expr * expr) ...@@ -1377,11 +1387,12 @@ gfc_conv_expr_op (gfc_se * se, gfc_expr * expr)
if (lop) if (lop)
{ {
/* The result of logical ops is always boolean_type_node. */ /* The result of logical ops is always boolean_type_node. */
tmp = fold_build2 (code, boolean_type_node, lse.expr, rse.expr); tmp = fold_build2_loc (input_location, code, boolean_type_node,
lse.expr, rse.expr);
se->expr = convert (type, tmp); se->expr = convert (type, tmp);
} }
else else
se->expr = fold_build2 (code, type, lse.expr, rse.expr); se->expr = fold_build2_loc (input_location, code, type, lse.expr, rse.expr);
/* Add the post blocks. */ /* Add the post blocks. */
gfc_add_block_to_block (&se->post, &rse.post); gfc_add_block_to_block (&se->post, &rse.post);
...@@ -1553,7 +1564,8 @@ gfc_build_compare_string (tree len1, tree str1, tree len2, tree str2, int kind, ...@@ -1553,7 +1564,8 @@ gfc_build_compare_string (tree len1, tree str1, tree len2, tree str2, int kind,
/* Deal with single character specially. */ /* Deal with single character specially. */
sc1 = fold_convert (integer_type_node, sc1); sc1 = fold_convert (integer_type_node, sc1);
sc2 = fold_convert (integer_type_node, sc2); sc2 = fold_convert (integer_type_node, sc2);
return fold_build2 (MINUS_EXPR, integer_type_node, sc1, sc2); return fold_build2_loc (input_location, MINUS_EXPR, integer_type_node,
sc1, sc2);
} }
if ((code == EQ_EXPR || code == NE_EXPR) if ((code == EQ_EXPR || code == NE_EXPR)
...@@ -1750,19 +1762,21 @@ gfc_set_interface_mapping_bounds (stmtblock_t * block, tree type, tree desc) ...@@ -1750,19 +1762,21 @@ gfc_set_interface_mapping_bounds (stmtblock_t * block, tree type, tree desc)
} }
else if (GFC_TYPE_ARRAY_UBOUND (type, n) == NULL_TREE) else if (GFC_TYPE_ARRAY_UBOUND (type, n) == NULL_TREE)
{ {
tmp = fold_build2 (MINUS_EXPR, gfc_array_index_type, tmp = fold_build2_loc (input_location, MINUS_EXPR,
gfc_array_index_type,
gfc_conv_descriptor_ubound_get (desc, dim), gfc_conv_descriptor_ubound_get (desc, dim),
gfc_conv_descriptor_lbound_get (desc, dim)); gfc_conv_descriptor_lbound_get (desc, dim));
tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type, tmp = fold_build2_loc (input_location, PLUS_EXPR,
GFC_TYPE_ARRAY_LBOUND (type, n), gfc_array_index_type,
tmp); GFC_TYPE_ARRAY_LBOUND (type, n), tmp);
tmp = gfc_evaluate_now (tmp, block); tmp = gfc_evaluate_now (tmp, block);
GFC_TYPE_ARRAY_UBOUND (type, n) = tmp; GFC_TYPE_ARRAY_UBOUND (type, n) = tmp;
} }
tmp = fold_build2 (MULT_EXPR, gfc_array_index_type, tmp = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
GFC_TYPE_ARRAY_LBOUND (type, n), GFC_TYPE_ARRAY_LBOUND (type, n),
GFC_TYPE_ARRAY_STRIDE (type, n)); GFC_TYPE_ARRAY_STRIDE (type, n));
offset = fold_build2 (MINUS_EXPR, gfc_array_index_type, offset, tmp); offset = fold_build2_loc (input_location, MINUS_EXPR,
gfc_array_index_type, offset, tmp);
} }
offset = gfc_evaluate_now (offset, block); offset = gfc_evaluate_now (offset, block);
GFC_TYPE_ARRAY_OFFSET (type) = offset; GFC_TYPE_ARRAY_OFFSET (type) = offset;
...@@ -2400,25 +2414,29 @@ gfc_conv_subref_array_arg (gfc_se * parmse, gfc_expr * expr, int g77, ...@@ -2400,25 +2414,29 @@ gfc_conv_subref_array_arg (gfc_se * parmse, gfc_expr * expr, int g77,
{ {
tree tmp_str; tree tmp_str;
tmp = rse.loop->loopvar[n]; tmp = rse.loop->loopvar[n];
tmp = fold_build2 (MINUS_EXPR, gfc_array_index_type, tmp = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
tmp, rse.loop->from[n]); tmp, rse.loop->from[n]);
tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type, tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
tmp, tmp_index); tmp, tmp_index);
tmp_str = fold_build2 (MINUS_EXPR, gfc_array_index_type, tmp_str = fold_build2_loc (input_location, MINUS_EXPR,
gfc_array_index_type,
rse.loop->to[n-1], rse.loop->from[n-1]); rse.loop->to[n-1], rse.loop->from[n-1]);
tmp_str = fold_build2 (PLUS_EXPR, gfc_array_index_type, tmp_str = fold_build2_loc (input_location, PLUS_EXPR,
gfc_array_index_type,
tmp_str, gfc_index_one_node); tmp_str, gfc_index_one_node);
tmp_index = fold_build2 (MULT_EXPR, gfc_array_index_type, tmp_index = fold_build2_loc (input_location, MULT_EXPR,
tmp, tmp_str); gfc_array_index_type, tmp, tmp_str);
} }
tmp_index = fold_build2 (MINUS_EXPR, gfc_array_index_type, tmp_index = fold_build2_loc (input_location, MINUS_EXPR,
gfc_array_index_type,
tmp_index, rse.loop->from[0]); tmp_index, rse.loop->from[0]);
gfc_add_modify (&rse.loop->code[0], offset, tmp_index); gfc_add_modify (&rse.loop->code[0], offset, tmp_index);
tmp_index = fold_build2 (PLUS_EXPR, gfc_array_index_type, tmp_index = fold_build2_loc (input_location, PLUS_EXPR,
gfc_array_index_type,
rse.loop->loopvar[0], offset); rse.loop->loopvar[0], offset);
/* Now use the offset for the reference. */ /* Now use the offset for the reference. */
...@@ -2467,8 +2485,9 @@ gfc_conv_subref_array_arg (gfc_se * parmse, gfc_expr * expr, int g77, ...@@ -2467,8 +2485,9 @@ gfc_conv_subref_array_arg (gfc_se * parmse, gfc_expr * expr, int g77,
{ {
tmp = gfc_conv_descriptor_ubound_get (parmse->expr, tmp = gfc_conv_descriptor_ubound_get (parmse->expr,
gfc_rank_cst[n]); gfc_rank_cst[n]);
tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type, tmp = fold_build2_loc (input_location, PLUS_EXPR,
tmp, gfc_index_one_node); gfc_array_index_type, tmp,
gfc_index_one_node);
gfc_conv_descriptor_ubound_set (&parmse->pre, gfc_conv_descriptor_ubound_set (&parmse->pre,
parmse->expr, parmse->expr,
gfc_rank_cst[n], gfc_rank_cst[n],
...@@ -2478,15 +2497,18 @@ gfc_conv_subref_array_arg (gfc_se * parmse, gfc_expr * expr, int g77, ...@@ -2478,15 +2497,18 @@ gfc_conv_subref_array_arg (gfc_se * parmse, gfc_expr * expr, int g77,
gfc_rank_cst[n], gfc_rank_cst[n],
gfc_index_one_node); gfc_index_one_node);
size = gfc_evaluate_now (size, &parmse->pre); size = gfc_evaluate_now (size, &parmse->pre);
offset = fold_build2 (MINUS_EXPR, gfc_array_index_type, offset = fold_build2_loc (input_location, MINUS_EXPR,
gfc_array_index_type,
offset, size); offset, size);
offset = gfc_evaluate_now (offset, &parmse->pre); offset = gfc_evaluate_now (offset, &parmse->pre);
tmp = fold_build2 (MINUS_EXPR, gfc_array_index_type, tmp = fold_build2_loc (input_location, MINUS_EXPR,
gfc_array_index_type,
rse.loop->to[n], rse.loop->from[n]); rse.loop->to[n], rse.loop->from[n]);
tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type, tmp = fold_build2_loc (input_location, PLUS_EXPR,
gfc_array_index_type,
tmp, gfc_index_one_node); tmp, gfc_index_one_node);
size = fold_build2 (MULT_EXPR, gfc_array_index_type, size = fold_build2_loc (input_location, MULT_EXPR,
size, tmp); gfc_array_index_type, size, tmp);
} }
gfc_conv_descriptor_offset_set (&parmse->pre, parmse->expr, gfc_conv_descriptor_offset_set (&parmse->pre, parmse->expr,
...@@ -2548,7 +2570,8 @@ gfc_conv_derived_to_class (gfc_se *parmse, gfc_expr *e, ...@@ -2548,7 +2570,8 @@ gfc_conv_derived_to_class (gfc_se *parmse, gfc_expr *e,
/* Set the vptr. */ /* Set the vptr. */
cmp = gfc_find_component (declared, "$vptr", true, true); cmp = gfc_find_component (declared, "$vptr", true, true);
ctree = fold_build3 (COMPONENT_REF, TREE_TYPE (cmp->backend_decl), ctree = fold_build3_loc (input_location, COMPONENT_REF,
TREE_TYPE (cmp->backend_decl),
var, cmp->backend_decl, NULL_TREE); var, cmp->backend_decl, NULL_TREE);
/* Remember the vtab corresponds to the derived type /* Remember the vtab corresponds to the derived type
...@@ -2561,7 +2584,8 @@ gfc_conv_derived_to_class (gfc_se *parmse, gfc_expr *e, ...@@ -2561,7 +2584,8 @@ gfc_conv_derived_to_class (gfc_se *parmse, gfc_expr *e,
/* Now set the data field. */ /* Now set the data field. */
cmp = gfc_find_component (declared, "$data", true, true); cmp = gfc_find_component (declared, "$data", true, true);
ctree = fold_build3 (COMPONENT_REF, TREE_TYPE (cmp->backend_decl), ctree = fold_build3_loc (input_location, COMPONENT_REF,
TREE_TYPE (cmp->backend_decl),
var, cmp->backend_decl, NULL_TREE); var, cmp->backend_decl, NULL_TREE);
ss = gfc_walk_expr (e); ss = gfc_walk_expr (e);
if (ss == gfc_ss_terminator) if (ss == gfc_ss_terminator)
...@@ -2668,7 +2692,8 @@ conv_isocbinding_procedure (gfc_se * se, gfc_symbol * sym, ...@@ -2668,7 +2692,8 @@ conv_isocbinding_procedure (gfc_se * se, gfc_symbol * sym,
fptrse.expr = build_fold_indirect_ref_loc (input_location, fptrse.expr = build_fold_indirect_ref_loc (input_location,
fptrse.expr); fptrse.expr);
se->expr = fold_build2 (MODIFY_EXPR, TREE_TYPE (fptrse.expr), se->expr = fold_build2_loc (input_location, MODIFY_EXPR,
TREE_TYPE (fptrse.expr),
fptrse.expr, fptrse.expr,
fold_convert (TREE_TYPE (fptrse.expr), fold_convert (TREE_TYPE (fptrse.expr),
cptrse.expr)); cptrse.expr));
...@@ -2692,7 +2717,8 @@ conv_isocbinding_procedure (gfc_se * se, gfc_symbol * sym, ...@@ -2692,7 +2717,8 @@ conv_isocbinding_procedure (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 = fold_build2 (NE_EXPR, boolean_type_node, arg1se.expr, se->expr = fold_build2_loc (input_location, 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
...@@ -2707,15 +2733,17 @@ conv_isocbinding_procedure (gfc_se * se, gfc_symbol * sym, ...@@ -2707,15 +2733,17 @@ conv_isocbinding_procedure (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 = fold_build2 (EQ_EXPR, boolean_type_node, eq_expr = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
arg1se.expr, 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 = fold_build2 (NE_EXPR, boolean_type_node, not_null_expr = fold_build2_loc (input_location, NE_EXPR,
boolean_type_node,
arg1se.expr, 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 = fold_build2 (TRUTH_AND_EXPR, boolean_type_node, se->expr = fold_build2_loc (input_location, TRUTH_AND_EXPR,
boolean_type_node,
not_null_expr, eq_expr); not_null_expr, eq_expr);
} }
...@@ -2947,15 +2975,17 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, ...@@ -2947,15 +2975,17 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
tmp = gfc_deallocate_with_status (parmse.expr, NULL_TREE, tmp = gfc_deallocate_with_status (parmse.expr, NULL_TREE,
true, NULL); true, NULL);
gfc_add_expr_to_block (&block, tmp); gfc_add_expr_to_block (&block, tmp);
tmp = fold_build2 (MODIFY_EXPR, void_type_node, tmp = fold_build2_loc (input_location, MODIFY_EXPR,
parmse.expr, null_pointer_node); void_type_node, parmse.expr,
null_pointer_node);
gfc_add_expr_to_block (&block, tmp); gfc_add_expr_to_block (&block, tmp);
if (fsym->attr.optional if (fsym->attr.optional
&& e->expr_type == EXPR_VARIABLE && e->expr_type == EXPR_VARIABLE
&& e->symtree->n.sym->attr.optional) && e->symtree->n.sym->attr.optional)
{ {
tmp = fold_build3 (COND_EXPR, void_type_node, tmp = fold_build3_loc (input_location, COND_EXPR,
void_type_node,
gfc_conv_expr_present (e->symtree->n.sym), gfc_conv_expr_present (e->symtree->n.sym),
gfc_finish_block (&block), gfc_finish_block (&block),
build_empty_stmt (input_location)); build_empty_stmt (input_location));
...@@ -3025,7 +3055,8 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, ...@@ -3025,7 +3055,8 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
if (fsym->attr.optional if (fsym->attr.optional
&& e->expr_type == EXPR_VARIABLE && e->expr_type == EXPR_VARIABLE
&& e->symtree->n.sym->attr.optional) && e->symtree->n.sym->attr.optional)
tmp = fold_build3 (COND_EXPR, void_type_node, tmp = fold_build3_loc (input_location, COND_EXPR,
void_type_node,
gfc_conv_expr_present (e->symtree->n.sym), gfc_conv_expr_present (e->symtree->n.sym),
tmp, build_empty_stmt (input_location)); tmp, build_empty_stmt (input_location));
gfc_add_expr_to_block (&se->pre, tmp); gfc_add_expr_to_block (&se->pre, tmp);
...@@ -3177,13 +3208,17 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, ...@@ -3177,13 +3208,17 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
present = gfc_conv_expr_present (e->symtree->n.sym); present = gfc_conv_expr_present (e->symtree->n.sym);
type = TREE_TYPE (present); type = TREE_TYPE (present);
present = fold_build2 (EQ_EXPR, boolean_type_node, present, present = fold_build2_loc (input_location, EQ_EXPR,
fold_convert (type, null_pointer_node)); boolean_type_node, present,
fold_convert (type,
null_pointer_node));
type = TREE_TYPE (parmse.expr); type = TREE_TYPE (parmse.expr);
null_ptr = fold_build2 (EQ_EXPR, boolean_type_node, parmse.expr, null_ptr = fold_build2_loc (input_location, EQ_EXPR,
fold_convert (type, null_pointer_node)); boolean_type_node, parmse.expr,
cond = fold_build2 (TRUTH_ORIF_EXPR, boolean_type_node, fold_convert (type,
present, null_ptr); null_pointer_node));
cond = fold_build2_loc (input_location, TRUTH_ORIF_EXPR,
boolean_type_node, present, null_ptr);
} }
else else
{ {
...@@ -3203,7 +3238,8 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, ...@@ -3203,7 +3238,8 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
goto end_pointer_check; goto end_pointer_check;
cond = fold_build2 (EQ_EXPR, boolean_type_node, parmse.expr, cond = fold_build2_loc (input_location, EQ_EXPR,
boolean_type_node, parmse.expr,
fold_convert (TREE_TYPE (parmse.expr), fold_convert (TREE_TYPE (parmse.expr),
null_pointer_node)); null_pointer_node));
} }
...@@ -3265,7 +3301,8 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, ...@@ -3265,7 +3301,8 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
gfc_add_block_to_block (&se->post, &parmse.post); gfc_add_block_to_block (&se->post, &parmse.post);
tmp = fold_convert (gfc_charlen_type_node, parmse.expr); tmp = fold_convert (gfc_charlen_type_node, parmse.expr);
tmp = fold_build2 (MAX_EXPR, gfc_charlen_type_node, tmp, tmp = fold_build2_loc (input_location, MAX_EXPR,
gfc_charlen_type_node, tmp,
build_int_cst (gfc_charlen_type_node, 0)); build_int_cst (gfc_charlen_type_node, 0));
cl.backend_decl = tmp; cl.backend_decl = tmp;
} }
...@@ -3470,7 +3507,8 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, ...@@ -3470,7 +3507,8 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
/* Check the data pointer hasn't been modified. This would /* Check the data pointer hasn't been modified. This would
happen in a function returning a pointer. */ happen in a function returning a pointer. */
tmp = gfc_conv_descriptor_data_get (info->descriptor); tmp = gfc_conv_descriptor_data_get (info->descriptor);
tmp = fold_build2 (NE_EXPR, boolean_type_node, tmp = fold_build2_loc (input_location, NE_EXPR,
boolean_type_node,
tmp, info->data); tmp, info->data);
gfc_trans_runtime_check (true, false, tmp, &se->pre, NULL, gfc_trans_runtime_check (true, false, tmp, &se->pre, NULL,
gfc_msg_fault); gfc_msg_fault);
...@@ -3572,24 +3610,25 @@ fill_with_spaces (tree start, tree type, tree size) ...@@ -3572,24 +3610,25 @@ fill_with_spaces (tree start, tree type, tree size)
gfc_init_block (&loop); gfc_init_block (&loop);
/* Exit condition. */ /* Exit condition. */
cond = fold_build2 (LE_EXPR, boolean_type_node, i, cond = fold_build2_loc (input_location, LE_EXPR, boolean_type_node, i,
fold_convert (sizetype, integer_zero_node)); fold_convert (sizetype, integer_zero_node));
tmp = build1_v (GOTO_EXPR, exit_label); tmp = build1_v (GOTO_EXPR, exit_label);
tmp = fold_build3 (COND_EXPR, void_type_node, cond, tmp, tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond, tmp,
build_empty_stmt (input_location)); build_empty_stmt (input_location));
gfc_add_expr_to_block (&loop, tmp); gfc_add_expr_to_block (&loop, tmp);
/* Assignment. */ /* Assignment. */
gfc_add_modify (&loop, fold_build1 (INDIRECT_REF, type, el), gfc_add_modify (&loop,
build_int_cst (type, fold_build1_loc (input_location, INDIRECT_REF, type, el),
lang_hooks.to_target_charset (' '))); build_int_cst (type, lang_hooks.to_target_charset (' ')));
/* Increment loop variables. */ /* Increment loop variables. */
gfc_add_modify (&loop, i, fold_build2 (MINUS_EXPR, sizetype, i, gfc_add_modify (&loop, i,
TYPE_SIZE_UNIT (type))); fold_build2_loc (input_location, MINUS_EXPR, sizetype, i,
gfc_add_modify (&loop, el, fold_build2 (POINTER_PLUS_EXPR,
TREE_TYPE (el), el,
TYPE_SIZE_UNIT (type))); TYPE_SIZE_UNIT (type)));
gfc_add_modify (&loop, el,
fold_build2_loc (input_location, POINTER_PLUS_EXPR,
TREE_TYPE (el), el, TYPE_SIZE_UNIT (type)));
/* Making the loop... actually loop! */ /* Making the loop... actually loop! */
tmp = gfc_finish_block (&loop); tmp = gfc_finish_block (&loop);
...@@ -3655,7 +3694,7 @@ gfc_trans_string_copy (stmtblock_t * block, tree dlength, tree dest, ...@@ -3655,7 +3694,7 @@ gfc_trans_string_copy (stmtblock_t * block, tree dlength, tree dest,
} }
/* Do nothing if the destination length is zero. */ /* Do nothing if the destination length is zero. */
cond = fold_build2 (GT_EXPR, boolean_type_node, dlen, cond = fold_build2_loc (input_location, GT_EXPR, boolean_type_node, dlen,
build_int_cst (size_type_node, 0)); build_int_cst (size_type_node, 0));
/* The following code was previously in _gfortran_copy_string: /* The following code was previously in _gfortran_copy_string:
...@@ -3684,12 +3723,14 @@ gfc_trans_string_copy (stmtblock_t * block, tree dlength, tree dest, ...@@ -3684,12 +3723,14 @@ gfc_trans_string_copy (stmtblock_t * block, tree dlength, tree dest,
/* For non-default character kinds, we have to multiply the string /* For non-default character kinds, we have to multiply the string
length by the base type size. */ length by the base type size. */
chartype = gfc_get_char_type (dkind); chartype = gfc_get_char_type (dkind);
slen = fold_build2 (MULT_EXPR, size_type_node, slen = fold_build2_loc (input_location, MULT_EXPR, size_type_node,
fold_convert (size_type_node, slen), fold_convert (size_type_node, slen),
fold_convert (size_type_node, TYPE_SIZE_UNIT (chartype))); fold_convert (size_type_node,
dlen = fold_build2 (MULT_EXPR, size_type_node, TYPE_SIZE_UNIT (chartype)));
dlen = fold_build2_loc (input_location, MULT_EXPR, size_type_node,
fold_convert (size_type_node, dlen), fold_convert (size_type_node, dlen),
fold_convert (size_type_node, TYPE_SIZE_UNIT (chartype))); fold_convert (size_type_node,
TYPE_SIZE_UNIT (chartype)));
if (dlength) if (dlength)
dest = fold_convert (pvoid_type_node, dest); dest = fold_convert (pvoid_type_node, dest);
...@@ -3702,7 +3743,8 @@ gfc_trans_string_copy (stmtblock_t * block, tree dlength, tree dest, ...@@ -3702,7 +3743,8 @@ gfc_trans_string_copy (stmtblock_t * block, tree dlength, tree dest,
src = gfc_build_addr_expr (pvoid_type_node, src); src = gfc_build_addr_expr (pvoid_type_node, src);
/* Truncate string if source is too long. */ /* Truncate string if source is too long. */
cond2 = fold_build2 (GE_EXPR, boolean_type_node, slen, dlen); cond2 = fold_build2_loc (input_location, GE_EXPR, boolean_type_node, slen,
dlen);
tmp2 = build_call_expr_loc (input_location, tmp2 = build_call_expr_loc (input_location,
built_in_decls[BUILT_IN_MEMMOVE], built_in_decls[BUILT_IN_MEMMOVE],
3, dest, src, dlen); 3, dest, src, dlen);
...@@ -3712,11 +3754,11 @@ gfc_trans_string_copy (stmtblock_t * block, tree dlength, tree dest, ...@@ -3712,11 +3754,11 @@ gfc_trans_string_copy (stmtblock_t * block, tree dlength, tree dest,
built_in_decls[BUILT_IN_MEMMOVE], built_in_decls[BUILT_IN_MEMMOVE],
3, dest, src, slen); 3, dest, src, slen);
tmp4 = fold_build2 (POINTER_PLUS_EXPR, TREE_TYPE (dest), dest, tmp4 = fold_build2_loc (input_location, POINTER_PLUS_EXPR, TREE_TYPE (dest),
fold_convert (sizetype, slen)); dest, fold_convert (sizetype, slen));
tmp4 = fill_with_spaces (tmp4, chartype, tmp4 = fill_with_spaces (tmp4, chartype,
fold_build2 (MINUS_EXPR, TREE_TYPE(dlen), fold_build2_loc (input_location, MINUS_EXPR,
dlen, slen)); TREE_TYPE(dlen), dlen, slen));
gfc_init_block (&tempblock); gfc_init_block (&tempblock);
gfc_add_expr_to_block (&tempblock, tmp3); gfc_add_expr_to_block (&tempblock, tmp3);
...@@ -3724,8 +3766,9 @@ gfc_trans_string_copy (stmtblock_t * block, tree dlength, tree dest, ...@@ -3724,8 +3766,9 @@ gfc_trans_string_copy (stmtblock_t * block, tree dlength, tree dest,
tmp3 = gfc_finish_block (&tempblock); tmp3 = gfc_finish_block (&tempblock);
/* The whole copy_string function is there. */ /* The whole copy_string function is there. */
tmp = fold_build3 (COND_EXPR, void_type_node, cond2, tmp2, tmp3); tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond2,
tmp = fold_build3 (COND_EXPR, void_type_node, cond, tmp, tmp2, tmp3);
tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond, tmp,
build_empty_stmt (input_location)); build_empty_stmt (input_location));
gfc_add_expr_to_block (block, tmp); gfc_add_expr_to_block (block, tmp);
} }
...@@ -4200,21 +4243,23 @@ gfc_trans_alloc_subarray_assign (tree dest, gfc_component * cm, ...@@ -4200,21 +4243,23 @@ gfc_trans_alloc_subarray_assign (tree dest, gfc_component * cm,
/* Shift the bounds and set the offset accordingly. */ /* Shift the bounds and set the offset accordingly. */
tmp = gfc_conv_descriptor_ubound_get (dest, gfc_rank_cst[n]); tmp = gfc_conv_descriptor_ubound_get (dest, gfc_rank_cst[n]);
span = fold_build2 (MINUS_EXPR, gfc_array_index_type, tmp, span = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
gfc_conv_descriptor_lbound_get (dest, gfc_rank_cst[n])); tmp, gfc_conv_descriptor_lbound_get (dest, gfc_rank_cst[n]));
tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type, span, lbound); tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
span, lbound);
gfc_conv_descriptor_ubound_set (&block, dest, gfc_conv_descriptor_ubound_set (&block, dest,
gfc_rank_cst[n], tmp); gfc_rank_cst[n], tmp);
gfc_conv_descriptor_lbound_set (&block, dest, gfc_conv_descriptor_lbound_set (&block, dest,
gfc_rank_cst[n], lbound); gfc_rank_cst[n], lbound);
tmp = fold_build2 (MULT_EXPR, gfc_array_index_type, tmp = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
gfc_conv_descriptor_lbound_get (dest, gfc_conv_descriptor_lbound_get (dest,
gfc_rank_cst[n]), gfc_rank_cst[n]),
gfc_conv_descriptor_stride_get (dest, gfc_conv_descriptor_stride_get (dest,
gfc_rank_cst[n])); gfc_rank_cst[n]));
gfc_add_modify (&block, tmp2, tmp); gfc_add_modify (&block, tmp2, tmp);
tmp = fold_build2 (MINUS_EXPR, gfc_array_index_type, offset, tmp2); tmp = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
offset, tmp2);
gfc_conv_descriptor_offset_set (&block, dest, tmp); gfc_conv_descriptor_offset_set (&block, dest, tmp);
} }
...@@ -4369,17 +4414,18 @@ gfc_trans_structure_assign (tree dest, gfc_expr * expr) ...@@ -4369,17 +4414,18 @@ gfc_trans_structure_assign (tree dest, gfc_expr * expr)
if (c && c->expr && c->expr->ts.is_iso_c) if (c && c->expr && c->expr->ts.is_iso_c)
{ {
field = cm->backend_decl; field = cm->backend_decl;
tmp = fold_build3 (COMPONENT_REF, TREE_TYPE (field), tmp = fold_build3_loc (input_location, COMPONENT_REF,
TREE_TYPE (field),
dest, field, NULL_TREE); dest, field, NULL_TREE);
tmp = fold_build2 (MODIFY_EXPR, TREE_TYPE (tmp), tmp, tmp = fold_build2_loc (input_location, MODIFY_EXPR, TREE_TYPE (tmp),
fold_convert (TREE_TYPE (tmp), tmp, fold_convert (TREE_TYPE (tmp),
null_pointer_node)); null_pointer_node));
gfc_add_expr_to_block (&block, tmp); gfc_add_expr_to_block (&block, tmp);
continue; continue;
} }
field = cm->backend_decl; field = cm->backend_decl;
tmp = fold_build3 (COMPONENT_REF, TREE_TYPE (field), tmp = fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (field),
dest, field, NULL_TREE); 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);
...@@ -4864,10 +4910,10 @@ gfc_trans_pointer_assignment (gfc_expr * expr1, gfc_expr * expr2) ...@@ -4864,10 +4910,10 @@ gfc_trans_pointer_assignment (gfc_expr * expr1, gfc_expr * expr2)
gfc_rank_cst[dim]); gfc_rank_cst[dim]);
lbound = gfc_conv_descriptor_lbound_get (rse.expr, lbound = gfc_conv_descriptor_lbound_get (rse.expr,
gfc_rank_cst[dim]); gfc_rank_cst[dim]);
tmp = fold_build2 (MULT_EXPR, gfc_array_index_type, tmp = fold_build2_loc (input_location, MULT_EXPR,
stride, lbound); gfc_array_index_type, stride, lbound);
offs = fold_build2 (PLUS_EXPR, gfc_array_index_type, offs = fold_build2_loc (input_location, PLUS_EXPR,
offs, tmp); gfc_array_index_type, offs, tmp);
} }
gfc_conv_descriptor_offset_set (&block, desc, offs); gfc_conv_descriptor_offset_set (&block, desc, offs);
...@@ -4913,17 +4959,17 @@ gfc_trans_pointer_assignment (gfc_expr * expr1, gfc_expr * expr2) ...@@ -4913,17 +4959,17 @@ gfc_trans_pointer_assignment (gfc_expr * expr1, gfc_expr * expr2)
/* Update offset. */ /* Update offset. */
offs = gfc_conv_descriptor_offset_get (desc); offs = gfc_conv_descriptor_offset_get (desc);
tmp = fold_build2 (MULT_EXPR, gfc_array_index_type, tmp = fold_build2_loc (input_location, MULT_EXPR,
lbound, stride); gfc_array_index_type, lbound, stride);
offs = fold_build2 (MINUS_EXPR, gfc_array_index_type, offs = fold_build2_loc (input_location, MINUS_EXPR,
offs, tmp); gfc_array_index_type, offs, tmp);
offs = gfc_evaluate_now (offs, &block); offs = gfc_evaluate_now (offs, &block);
gfc_conv_descriptor_offset_set (&block, desc, offs); gfc_conv_descriptor_offset_set (&block, desc, offs);
/* Update stride. */ /* Update stride. */
tmp = gfc_conv_array_extent_dim (lbound, ubound, NULL); tmp = gfc_conv_array_extent_dim (lbound, ubound, NULL);
stride = fold_build2 (MULT_EXPR, gfc_array_index_type, stride = fold_build2_loc (input_location, MULT_EXPR,
stride, tmp); gfc_array_index_type, stride, tmp);
} }
} }
else else
...@@ -4972,7 +5018,8 @@ gfc_trans_pointer_assignment (gfc_expr * expr1, gfc_expr * expr2) ...@@ -4972,7 +5018,8 @@ gfc_trans_pointer_assignment (gfc_expr * expr1, gfc_expr * expr2)
lsize = gfc_evaluate_now (lsize, &block); lsize = gfc_evaluate_now (lsize, &block);
rsize = gfc_evaluate_now (rsize, &block); rsize = gfc_evaluate_now (rsize, &block);
fault = fold_build2 (LT_EXPR, boolean_type_node, rsize, lsize); fault = fold_build2_loc (input_location, LT_EXPR, boolean_type_node,
rsize, lsize);
msg = _("Target of rank remapping is too small (%ld < %ld)"); msg = _("Target of rank remapping is too small (%ld < %ld)");
gfc_trans_runtime_check (true, false, fault, &block, &expr2->where, gfc_trans_runtime_check (true, false, fault, &block, &expr2->where,
...@@ -5069,7 +5116,7 @@ gfc_trans_scalar_assign (gfc_se * lse, gfc_se * rse, gfc_typespec ts, ...@@ -5069,7 +5116,7 @@ gfc_trans_scalar_assign (gfc_se * lse, gfc_se * rse, gfc_typespec ts,
/* Are the rhs and the lhs the same? */ /* Are the rhs and the lhs the same? */
if (r_is_var) if (r_is_var)
{ {
cond = fold_build2 (EQ_EXPR, boolean_type_node, cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
gfc_build_addr_expr (NULL_TREE, lse->expr), gfc_build_addr_expr (NULL_TREE, lse->expr),
gfc_build_addr_expr (NULL_TREE, rse->expr)); gfc_build_addr_expr (NULL_TREE, rse->expr));
cond = gfc_evaluate_now (cond, &lse->pre); cond = gfc_evaluate_now (cond, &lse->pre);
...@@ -5109,7 +5156,8 @@ gfc_trans_scalar_assign (gfc_se * lse, gfc_se * rse, gfc_typespec ts, ...@@ -5109,7 +5156,8 @@ gfc_trans_scalar_assign (gfc_se * lse, gfc_se * rse, gfc_typespec ts,
{ {
gfc_add_block_to_block (&block, &lse->pre); gfc_add_block_to_block (&block, &lse->pre);
gfc_add_block_to_block (&block, &rse->pre); gfc_add_block_to_block (&block, &rse->pre);
tmp = fold_build1 (VIEW_CONVERT_EXPR, TREE_TYPE (lse->expr), rse->expr); tmp = fold_build1_loc (input_location, VIEW_CONVERT_EXPR,
TREE_TYPE (lse->expr), rse->expr);
gfc_add_modify (&block, lse->expr, tmp); gfc_add_modify (&block, lse->expr, tmp);
} }
else else
...@@ -5322,7 +5370,7 @@ gfc_trans_zero_assign (gfc_expr * expr) ...@@ -5322,7 +5370,7 @@ gfc_trans_zero_assign (gfc_expr * expr)
return NULL_TREE; return NULL_TREE;
tmp = TYPE_SIZE_UNIT (gfc_get_element_type (type)); tmp = TYPE_SIZE_UNIT (gfc_get_element_type (type));
len = fold_build2 (MULT_EXPR, gfc_array_index_type, len, len = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type, len,
fold_convert (gfc_array_index_type, tmp)); fold_convert (gfc_array_index_type, tmp));
/* If we are zeroing a local array avoid taking its address by emitting /* If we are zeroing a local array avoid taking its address by emitting
...@@ -5401,15 +5449,15 @@ gfc_trans_array_copy (gfc_expr * expr1, gfc_expr * expr2) ...@@ -5401,15 +5449,15 @@ gfc_trans_array_copy (gfc_expr * expr1, gfc_expr * expr2)
if (!dlen || TREE_CODE (dlen) != INTEGER_CST) if (!dlen || TREE_CODE (dlen) != INTEGER_CST)
return NULL_TREE; return NULL_TREE;
tmp = TYPE_SIZE_UNIT (gfc_get_element_type (dtype)); tmp = TYPE_SIZE_UNIT (gfc_get_element_type (dtype));
dlen = fold_build2 (MULT_EXPR, gfc_array_index_type, dlen, dlen = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
fold_convert (gfc_array_index_type, tmp)); dlen, fold_convert (gfc_array_index_type, tmp));
slen = GFC_TYPE_ARRAY_SIZE (stype); slen = GFC_TYPE_ARRAY_SIZE (stype);
if (!slen || TREE_CODE (slen) != INTEGER_CST) if (!slen || TREE_CODE (slen) != INTEGER_CST)
return NULL_TREE; return NULL_TREE;
tmp = TYPE_SIZE_UNIT (gfc_get_element_type (stype)); tmp = TYPE_SIZE_UNIT (gfc_get_element_type (stype));
slen = fold_build2 (MULT_EXPR, gfc_array_index_type, slen, slen = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
fold_convert (gfc_array_index_type, tmp)); slen, fold_convert (gfc_array_index_type, tmp));
/* Sanity check that they are the same. This should always be /* Sanity check that they are the same. This should always be
the case, as we should already have checked for conformance. */ the case, as we should already have checked for conformance. */
...@@ -5454,7 +5502,7 @@ gfc_trans_array_constructor_copy (gfc_expr * expr1, gfc_expr * expr2) ...@@ -5454,7 +5502,7 @@ gfc_trans_array_constructor_copy (gfc_expr * expr1, gfc_expr * expr2)
return NULL_TREE; return NULL_TREE;
tmp = TYPE_SIZE_UNIT (gfc_get_element_type (dtype)); tmp = TYPE_SIZE_UNIT (gfc_get_element_type (dtype));
len = fold_build2 (MULT_EXPR, gfc_array_index_type, len, len = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type, len,
fold_convert (gfc_array_index_type, tmp)); fold_convert (gfc_array_index_type, tmp));
stype = gfc_typenode_for_spec (&expr2->ts); stype = gfc_typenode_for_spec (&expr2->ts);
......
gcc/fortran/trans-intrinsic.c
...@@ -1306,8 +1306,10 @@ gfc_conv_intrinsic_sign (gfc_se * se, gfc_expr * expr) ...@@ -1306,8 +1306,10 @@ gfc_conv_intrinsic_sign (gfc_se * se, gfc_expr * expr)
zero = build_real_from_int_cst (TREE_TYPE (args[1]), integer_zero_node); zero = build_real_from_int_cst (TREE_TYPE (args[1]), integer_zero_node);
cond = fold_build2 (EQ_EXPR, boolean_type_node, args[1], zero); cond = fold_build2 (EQ_EXPR, boolean_type_node, args[1], zero);
se->expr = fold_build3 (COND_EXPR, TREE_TYPE (args[0]), cond, se->expr = fold_build3 (COND_EXPR, TREE_TYPE (args[0]), cond,
build_call_expr (abs, 1, args[0]), build_call_expr_loc (input_location, abs, 1,
build_call_expr (tmp, 2, args[0], args[1])); args[0]),
build_call_expr_loc (input_location, tmp, 2,
args[0], args[1]));
} }
else else
se->expr = build_call_expr_loc (input_location, tmp, 2, se->expr = build_call_expr_loc (input_location, tmp, 2,
...@@ -3412,7 +3414,8 @@ gfc_conv_intrinsic_leadz (gfc_se * se, gfc_expr * expr) ...@@ -3412,7 +3414,8 @@ gfc_conv_intrinsic_leadz (gfc_se * se, gfc_expr * expr)
/* Compute LEADZ for the case i .ne. 0. */ /* Compute LEADZ for the case i .ne. 0. */
s = TYPE_PRECISION (arg_type) - argsize; s = TYPE_PRECISION (arg_type) - argsize;
tmp = fold_convert (result_type, build_call_expr (func, 1, arg)); tmp = fold_convert (result_type, build_call_expr_loc (input_location, func,
1, arg));
leadz = fold_build2 (MINUS_EXPR, result_type, leadz = fold_build2 (MINUS_EXPR, result_type,
tmp, build_int_cst (result_type, s)); tmp, build_int_cst (result_type, s));
......
gcc/fortran/trans-io.c
...@@ -428,10 +428,11 @@ set_parameter_const (stmtblock_t *block, tree var, enum iofield type, ...@@ -428,10 +428,11 @@ 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 = fold_build3 (COMPONENT_REF, st_parameter[IOPARM_ptype_common].type, var = fold_build3_loc (input_location, 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 = fold_build3 (COMPONENT_REF, TREE_TYPE (p->field), var, p->field, tmp = fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (p->field),
NULL_TREE); var, p->field, NULL_TREE);
gfc_add_modify (block, tmp, build_int_cst (TREE_TYPE (p->field), val)); gfc_add_modify (block, tmp, build_int_cst (TREE_TYPE (p->field), val));
return p->mask; return p->mask;
} }
...@@ -464,7 +465,8 @@ set_parameter_value (stmtblock_t *block, tree var, enum iofield type, ...@@ -464,7 +465,8 @@ set_parameter_value (stmtblock_t *block, tree var, enum iofield type,
/* UNIT numbers should be greater than the min. */ /* UNIT numbers should be greater than the min. */
i = gfc_validate_kind (BT_INTEGER, 4, false); i = gfc_validate_kind (BT_INTEGER, 4, false);
val = gfc_conv_mpz_to_tree (gfc_integer_kinds[i].pedantic_min_int, 4); val = gfc_conv_mpz_to_tree (gfc_integer_kinds[i].pedantic_min_int, 4);
cond = fold_build2 (LT_EXPR, boolean_type_node, se.expr, cond = fold_build2_loc (input_location, LT_EXPR, boolean_type_node,
se.expr,
fold_convert (TREE_TYPE (se.expr), val)); fold_convert (TREE_TYPE (se.expr), val));
gfc_trans_io_runtime_check (cond, var, LIBERROR_BAD_UNIT, gfc_trans_io_runtime_check (cond, var, LIBERROR_BAD_UNIT,
"Unit number in I/O statement too small", "Unit number in I/O statement too small",
...@@ -472,7 +474,8 @@ set_parameter_value (stmtblock_t *block, tree var, enum iofield type, ...@@ -472,7 +474,8 @@ set_parameter_value (stmtblock_t *block, tree var, enum iofield type,
/* UNIT numbers should be less than the max. */ /* UNIT numbers should be less than the max. */
val = gfc_conv_mpz_to_tree (gfc_integer_kinds[i].huge, 4); val = gfc_conv_mpz_to_tree (gfc_integer_kinds[i].huge, 4);
cond = fold_build2 (GT_EXPR, boolean_type_node, se.expr, cond = fold_build2_loc (input_location, GT_EXPR, boolean_type_node,
se.expr,
fold_convert (TREE_TYPE (se.expr), val)); fold_convert (TREE_TYPE (se.expr), val));
gfc_trans_io_runtime_check (cond, var, LIBERROR_BAD_UNIT, gfc_trans_io_runtime_check (cond, var, LIBERROR_BAD_UNIT,
"Unit number in I/O statement too large", "Unit number in I/O statement too large",
...@@ -484,10 +487,12 @@ set_parameter_value (stmtblock_t *block, tree var, enum iofield type, ...@@ -484,10 +487,12 @@ 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 = fold_build3 (COMPONENT_REF, st_parameter[IOPARM_ptype_common].type, var = fold_build3_loc (input_location, 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 = fold_build3 (COMPONENT_REF, dest_type, var, p->field, NULL_TREE); tmp = fold_build3_loc (input_location, COMPONENT_REF, dest_type, var,
p->field, NULL_TREE);
gfc_add_modify (block, tmp, se.expr); gfc_add_modify (block, tmp, se.expr);
return p->mask; return p->mask;
} }
...@@ -542,9 +547,10 @@ set_parameter_ref (stmtblock_t *block, stmtblock_t *postblock, ...@@ -542,9 +547,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 = fold_build3 (COMPONENT_REF, st_parameter[IOPARM_ptype_common].type, var = fold_build3_loc (input_location, 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 = fold_build3 (COMPONENT_REF, TREE_TYPE (p->field), tmp = fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (p->field),
var, p->field, NULL_TREE); var, p->field, NULL_TREE);
gfc_add_modify (block, tmp, addr); gfc_add_modify (block, tmp, addr);
return p->mask; return p->mask;
...@@ -583,20 +589,25 @@ gfc_convert_array_to_string (gfc_se * se, gfc_expr * e) ...@@ -583,20 +589,25 @@ gfc_convert_array_to_string (gfc_se * se, gfc_expr * e)
{ {
gcc_assert (GFC_DESCRIPTOR_TYPE_P (type)); gcc_assert (GFC_DESCRIPTOR_TYPE_P (type));
size = gfc_conv_array_stride (array, rank); size = gfc_conv_array_stride (array, rank);
tmp = fold_build2 (MINUS_EXPR, gfc_array_index_type, tmp = fold_build2_loc (input_location, MINUS_EXPR,
gfc_array_index_type,
gfc_conv_array_ubound (array, rank), gfc_conv_array_ubound (array, rank),
gfc_conv_array_lbound (array, rank)); gfc_conv_array_lbound (array, rank));
tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type, tmp, tmp = fold_build2_loc (input_location, PLUS_EXPR,
gfc_array_index_type, tmp,
gfc_index_one_node); gfc_index_one_node);
size = fold_build2 (MULT_EXPR, gfc_array_index_type, tmp, size); size = fold_build2_loc (input_location, MULT_EXPR,
gfc_array_index_type, tmp, size);
} }
gcc_assert (size); gcc_assert (size);
size = fold_build2 (MINUS_EXPR, gfc_array_index_type, size, size = fold_build2_loc (input_location, MINUS_EXPR,
gfc_array_index_type, size,
TREE_OPERAND (se->expr, 1)); TREE_OPERAND (se->expr, 1));
se->expr = gfc_build_addr_expr (NULL_TREE, se->expr); se->expr = gfc_build_addr_expr (NULL_TREE, se->expr);
tmp = TYPE_SIZE_UNIT (gfc_get_element_type (type)); tmp = TYPE_SIZE_UNIT (gfc_get_element_type (type));
size = fold_build2 (MULT_EXPR, gfc_array_index_type, size, size = fold_build2_loc (input_location, MULT_EXPR,
gfc_array_index_type, size,
fold_convert (gfc_array_index_type, tmp)); fold_convert (gfc_array_index_type, tmp));
se->string_length = fold_convert (gfc_charlen_type_node, size); se->string_length = fold_convert (gfc_charlen_type_node, size);
return; return;
...@@ -623,11 +634,13 @@ set_string (stmtblock_t * block, stmtblock_t * postblock, tree var, ...@@ -623,11 +634,13 @@ 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 = fold_build3 (COMPONENT_REF, st_parameter[IOPARM_ptype_common].type, var = fold_build3_loc (input_location, 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 = fold_build3 (COMPONENT_REF, TREE_TYPE (p->field), io = fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (p->field),
var, p->field, NULL_TREE); var, p->field, NULL_TREE);
len = fold_build3 (COMPONENT_REF, TREE_TYPE (p->field_len), len = fold_build3_loc (input_location, COMPONENT_REF,
TREE_TYPE (p->field_len),
var, p->field_len, NULL_TREE); var, p->field_len, NULL_TREE);
/* Integer variable assigned a format label. */ /* Integer variable assigned a format label. */
...@@ -640,7 +653,7 @@ set_string (stmtblock_t * block, stmtblock_t * postblock, tree var, ...@@ -640,7 +653,7 @@ set_string (stmtblock_t * block, stmtblock_t * postblock, tree var,
gfc_conv_label_variable (&se, e); gfc_conv_label_variable (&se, e);
tmp = GFC_DECL_STRING_LEN (se.expr); tmp = GFC_DECL_STRING_LEN (se.expr);
cond = fold_build2 (LT_EXPR, boolean_type_node, cond = fold_build2_loc (input_location, LT_EXPR, boolean_type_node,
tmp, build_int_cst (TREE_TYPE (tmp), 0)); tmp, build_int_cst (TREE_TYPE (tmp), 0));
asprintf(&msg, "Label assigned to variable '%s' (%%ld) is not a format " asprintf(&msg, "Label assigned to variable '%s' (%%ld) is not a format "
...@@ -694,12 +707,12 @@ set_internal_unit (stmtblock_t * block, stmtblock_t * post_block, ...@@ -694,12 +707,12 @@ 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 = fold_build3 (COMPONENT_REF, TREE_TYPE (p->field), io = fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (p->field),
var, p->field, NULL_TREE); var, p->field, NULL_TREE);
len = fold_build3 (COMPONENT_REF, TREE_TYPE (p->field_len), len = fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (p->field_len),
var, 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 = fold_build3 (COMPONENT_REF, TREE_TYPE (p->field), desc = fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (p->field),
var, p->field, NULL_TREE); var, p->field, NULL_TREE);
gcc_assert (e->ts.type == BT_CHARACTER); gcc_assert (e->ts.type == BT_CHARACTER);
...@@ -809,11 +822,12 @@ io_result (stmtblock_t * block, tree var, gfc_st_label * err_label, ...@@ -809,11 +822,12 @@ io_result (stmtblock_t * block, tree var, gfc_st_label * err_label,
tmp = gfc_finish_block (&body); tmp = gfc_finish_block (&body);
var = fold_build3 (COMPONENT_REF, st_parameter[IOPARM_ptype_common].type, var = fold_build3_loc (input_location, 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 = fold_build3 (COMPONENT_REF, TREE_TYPE (p->field), rc = fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (p->field),
var, p->field, NULL_TREE); var, p->field, NULL_TREE);
rc = fold_build2 (BIT_AND_EXPR, TREE_TYPE (rc), rc = fold_build2_loc (input_location, BIT_AND_EXPR, TREE_TYPE (rc),
rc, build_int_cst (TREE_TYPE (rc), rc, build_int_cst (TREE_TYPE (rc),
IOPARM_common_libreturn_mask)); IOPARM_common_libreturn_mask));
...@@ -834,11 +848,12 @@ set_error_locus (stmtblock_t * block, tree var, locus * where) ...@@ -834,11 +848,12 @@ 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 = fold_build3 (COMPONENT_REF, locus_file = fold_build3_loc (input_location, COMPONENT_REF,
st_parameter[IOPARM_ptype_common].type, st_parameter[IOPARM_ptype_common].type,
var, TYPE_FIELDS (TREE_TYPE (var)), NULL_TREE); var, TYPE_FIELDS (TREE_TYPE (var)), NULL_TREE);
locus_file = fold_build3 (COMPONENT_REF, TREE_TYPE (p->field), locus_file = fold_build3_loc (input_location, COMPONENT_REF,
locus_file, p->field, NULL_TREE); TREE_TYPE (p->field), locus_file,
p->field, NULL_TREE);
f = where->lb->file; f = where->lb->file;
str = gfc_build_cstring_const (f->filename); str = gfc_build_cstring_const (f->filename);
...@@ -1448,7 +1463,7 @@ nml_get_addr_expr (gfc_symbol * sym, gfc_component * c, ...@@ -1448,7 +1463,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 = fold_build3 (COMPONENT_REF, TREE_TYPE (tmp), tmp = fold_build3_loc (input_location, 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
...@@ -1786,11 +1801,13 @@ build_dt (tree function, gfc_code * code) ...@@ -1786,11 +1801,13 @@ build_dt (tree function, gfc_code * code)
{ {
gfc_st_parameter_field *p = &st_parameter_field[IOPARM_common_flags]; gfc_st_parameter_field *p = &st_parameter_field[IOPARM_common_flags];
tmp = fold_build3 (COMPONENT_REF, st_parameter[IOPARM_ptype_common].type, tmp = fold_build3_loc (input_location, COMPONENT_REF,
dt_parm, TYPE_FIELDS (TREE_TYPE (dt_parm)), NULL_TREE); st_parameter[IOPARM_ptype_common].type,
tmp = fold_build3 (COMPONENT_REF, TREE_TYPE (p->field), dt_parm, TYPE_FIELDS (TREE_TYPE (dt_parm)),
tmp, p->field, NULL_TREE); NULL_TREE);
tmp = fold_build2 (BIT_AND_EXPR, TREE_TYPE (tmp), tmp = fold_build3_loc (input_location, COMPONENT_REF,
TREE_TYPE (p->field), tmp, p->field, NULL_TREE);
tmp = fold_build2_loc (input_location, BIT_AND_EXPR, TREE_TYPE (tmp),
tmp, build_int_cst (TREE_TYPE (tmp), tmp, build_int_cst (TREE_TYPE (tmp),
IOPARM_common_libreturn_mask)); IOPARM_common_libreturn_mask));
} }
......
gcc/fortran/trans-openmp.c
...@@ -176,16 +176,17 @@ gfc_omp_clause_default_ctor (tree clause, tree decl, tree outer) ...@@ -176,16 +176,17 @@ gfc_omp_clause_default_ctor (tree clause, tree decl, tree outer)
gfc_add_modify (&cond_block, decl, outer); gfc_add_modify (&cond_block, decl, outer);
rank = gfc_rank_cst[GFC_TYPE_ARRAY_RANK (type) - 1]; rank = gfc_rank_cst[GFC_TYPE_ARRAY_RANK (type) - 1];
size = gfc_conv_descriptor_ubound_get (decl, rank); size = gfc_conv_descriptor_ubound_get (decl, rank);
size = fold_build2 (MINUS_EXPR, gfc_array_index_type, size, size = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
gfc_conv_descriptor_lbound_get (decl, rank)); size, gfc_conv_descriptor_lbound_get (decl, rank));
size = fold_build2 (PLUS_EXPR, gfc_array_index_type, size, size = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
gfc_index_one_node); size, gfc_index_one_node);
if (GFC_TYPE_ARRAY_RANK (type) > 1) if (GFC_TYPE_ARRAY_RANK (type) > 1)
size = fold_build2 (MULT_EXPR, gfc_array_index_type, size, size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
gfc_conv_descriptor_stride_get (decl, rank)); size, gfc_conv_descriptor_stride_get (decl, rank));
esize = fold_convert (gfc_array_index_type, esize = fold_convert (gfc_array_index_type,
TYPE_SIZE_UNIT (gfc_get_element_type (type))); TYPE_SIZE_UNIT (gfc_get_element_type (type)));
size = fold_build2 (MULT_EXPR, gfc_array_index_type, size, esize); size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
size, esize);
size = gfc_evaluate_now (fold_convert (size_type_node, size), &cond_block); size = gfc_evaluate_now (fold_convert (size_type_node, size), &cond_block);
ptr = gfc_allocate_array_with_status (&cond_block, ptr = gfc_allocate_array_with_status (&cond_block,
build_int_cst (pvoid_type_node, 0), build_int_cst (pvoid_type_node, 0),
...@@ -197,7 +198,7 @@ gfc_omp_clause_default_ctor (tree clause, tree decl, tree outer) ...@@ -197,7 +198,7 @@ gfc_omp_clause_default_ctor (tree clause, tree decl, tree outer)
gfc_conv_descriptor_data_set (&cond_block, decl, null_pointer_node); gfc_conv_descriptor_data_set (&cond_block, decl, null_pointer_node);
else_b = gfc_finish_block (&cond_block); else_b = gfc_finish_block (&cond_block);
cond = fold_build2 (NE_EXPR, boolean_type_node, cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
fold_convert (pvoid_type_node, fold_convert (pvoid_type_node,
gfc_conv_descriptor_data_get (outer)), gfc_conv_descriptor_data_get (outer)),
null_pointer_node); null_pointer_node);
...@@ -228,16 +229,17 @@ gfc_omp_clause_copy_ctor (tree clause, tree dest, tree src) ...@@ -228,16 +229,17 @@ gfc_omp_clause_copy_ctor (tree clause, tree dest, tree src)
gfc_add_modify (&block, dest, src); gfc_add_modify (&block, dest, src);
rank = gfc_rank_cst[GFC_TYPE_ARRAY_RANK (type) - 1]; rank = gfc_rank_cst[GFC_TYPE_ARRAY_RANK (type) - 1];
size = gfc_conv_descriptor_ubound_get (dest, rank); size = gfc_conv_descriptor_ubound_get (dest, rank);
size = fold_build2 (MINUS_EXPR, gfc_array_index_type, size, size = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
gfc_conv_descriptor_lbound_get (dest, rank)); size, gfc_conv_descriptor_lbound_get (dest, rank));
size = fold_build2 (PLUS_EXPR, gfc_array_index_type, size, size = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
gfc_index_one_node); size, gfc_index_one_node);
if (GFC_TYPE_ARRAY_RANK (type) > 1) if (GFC_TYPE_ARRAY_RANK (type) > 1)
size = fold_build2 (MULT_EXPR, gfc_array_index_type, size, size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
gfc_conv_descriptor_stride_get (dest, rank)); size, gfc_conv_descriptor_stride_get (dest, rank));
esize = fold_convert (gfc_array_index_type, esize = fold_convert (gfc_array_index_type,
TYPE_SIZE_UNIT (gfc_get_element_type (type))); TYPE_SIZE_UNIT (gfc_get_element_type (type)));
size = fold_build2 (MULT_EXPR, gfc_array_index_type, size, esize); size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
size, esize);
size = gfc_evaluate_now (fold_convert (size_type_node, size), &block); size = gfc_evaluate_now (fold_convert (size_type_node, size), &block);
ptr = gfc_allocate_array_with_status (&block, ptr = gfc_allocate_array_with_status (&block,
build_int_cst (pvoid_type_node, 0), build_int_cst (pvoid_type_node, 0),
...@@ -270,16 +272,17 @@ gfc_omp_clause_assign_op (tree clause ATTRIBUTE_UNUSED, tree dest, tree src) ...@@ -270,16 +272,17 @@ gfc_omp_clause_assign_op (tree clause ATTRIBUTE_UNUSED, tree dest, tree src)
rank = gfc_rank_cst[GFC_TYPE_ARRAY_RANK (type) - 1]; rank = gfc_rank_cst[GFC_TYPE_ARRAY_RANK (type) - 1];
size = gfc_conv_descriptor_ubound_get (dest, rank); size = gfc_conv_descriptor_ubound_get (dest, rank);
size = fold_build2 (MINUS_EXPR, gfc_array_index_type, size, size = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
gfc_conv_descriptor_lbound_get (dest, rank)); size, gfc_conv_descriptor_lbound_get (dest, rank));
size = fold_build2 (PLUS_EXPR, gfc_array_index_type, size, size = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
gfc_index_one_node); size, gfc_index_one_node);
if (GFC_TYPE_ARRAY_RANK (type) > 1) if (GFC_TYPE_ARRAY_RANK (type) > 1)
size = fold_build2 (MULT_EXPR, gfc_array_index_type, size, size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
gfc_conv_descriptor_stride_get (dest, rank)); size, gfc_conv_descriptor_stride_get (dest, rank));
esize = fold_convert (gfc_array_index_type, esize = fold_convert (gfc_array_index_type,
TYPE_SIZE_UNIT (gfc_get_element_type (type))); TYPE_SIZE_UNIT (gfc_get_element_type (type)));
size = fold_build2 (MULT_EXPR, gfc_array_index_type, size, esize); size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
size, esize);
size = gfc_evaluate_now (fold_convert (size_type_node, size), &block); size = gfc_evaluate_now (fold_convert (size_type_node, size), &block);
call = build_call_expr_loc (input_location, call = build_call_expr_loc (input_location,
built_in_decls[BUILT_IN_MEMCPY], 3, built_in_decls[BUILT_IN_MEMCPY], 3,
...@@ -634,16 +637,19 @@ gfc_trans_omp_array_reduction (tree c, gfc_symbol *sym, locus where) ...@@ -634,16 +637,19 @@ gfc_trans_omp_array_reduction (tree c, gfc_symbol *sym, locus where)
gfc_add_modify (&block, decl, outer_sym.backend_decl); gfc_add_modify (&block, decl, outer_sym.backend_decl);
rank = gfc_rank_cst[GFC_TYPE_ARRAY_RANK (type) - 1]; rank = gfc_rank_cst[GFC_TYPE_ARRAY_RANK (type) - 1];
size = gfc_conv_descriptor_ubound_get (decl, rank); size = gfc_conv_descriptor_ubound_get (decl, rank);
size = fold_build2 (MINUS_EXPR, gfc_array_index_type, size, size = fold_build2_loc (input_location, MINUS_EXPR,
gfc_array_index_type, size,
gfc_conv_descriptor_lbound_get (decl, rank)); gfc_conv_descriptor_lbound_get (decl, rank));
size = fold_build2 (PLUS_EXPR, gfc_array_index_type, size, size = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
gfc_index_one_node); size, gfc_index_one_node);
if (GFC_TYPE_ARRAY_RANK (type) > 1) if (GFC_TYPE_ARRAY_RANK (type) > 1)
size = fold_build2 (MULT_EXPR, gfc_array_index_type, size, size = fold_build2_loc (input_location, MULT_EXPR,
gfc_array_index_type, size,
gfc_conv_descriptor_stride_get (decl, rank)); gfc_conv_descriptor_stride_get (decl, rank));
esize = fold_convert (gfc_array_index_type, esize = fold_convert (gfc_array_index_type,
TYPE_SIZE_UNIT (gfc_get_element_type (type))); TYPE_SIZE_UNIT (gfc_get_element_type (type)));
size = fold_build2 (MULT_EXPR, gfc_array_index_type, size, esize); size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
size, esize);
size = gfc_evaluate_now (fold_convert (size_type_node, size), &block); size = gfc_evaluate_now (fold_convert (size_type_node, size), &block);
ptr = gfc_allocate_array_with_status (&block, ptr = gfc_allocate_array_with_status (&block,
build_int_cst (pvoid_type_node, 0), build_int_cst (pvoid_type_node, 0),
...@@ -1100,7 +1106,8 @@ gfc_trans_omp_atomic (gfc_code *code) ...@@ -1100,7 +1106,8 @@ gfc_trans_omp_atomic (gfc_code *code)
gfc_init_block (&rse.pre); gfc_init_block (&rse.pre);
gfc_conv_expr (&rse, arg->expr); gfc_conv_expr (&rse, arg->expr);
gfc_add_block_to_block (&block, &rse.pre); gfc_add_block_to_block (&block, &rse.pre);
x = fold_build2 (op, TREE_TYPE (accum), accum, rse.expr); x = fold_build2_loc (input_location, op, TREE_TYPE (accum),
accum, rse.expr);
gfc_add_modify (&block, accum, x); gfc_add_modify (&block, accum, x);
} }
...@@ -1116,13 +1123,14 @@ gfc_trans_omp_atomic (gfc_code *code) ...@@ -1116,13 +1123,14 @@ gfc_trans_omp_atomic (gfc_code *code)
lhsaddr)); lhsaddr));
if (var_on_left) if (var_on_left)
x = fold_build2 (op, TREE_TYPE (rhs), x, rhs); x = fold_build2_loc (input_location, op, TREE_TYPE (rhs), x, rhs);
else else
x = fold_build2 (op, TREE_TYPE (rhs), rhs, x); x = fold_build2_loc (input_location, op, TREE_TYPE (rhs), rhs, x);
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 = fold_build1 (REALPART_EXPR, TREE_TYPE (TREE_TYPE (rhs)), x); x = fold_build1_loc (input_location, 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);
...@@ -1254,10 +1262,15 @@ gfc_trans_omp_do (gfc_code *code, stmtblock_t *pblock, ...@@ -1254,10 +1262,15 @@ gfc_trans_omp_do (gfc_code *code, stmtblock_t *pblock,
if (simple) if (simple)
{ {
TREE_VEC_ELT (init, i) = build2_v (MODIFY_EXPR, dovar, from); TREE_VEC_ELT (init, i) = build2_v (MODIFY_EXPR, dovar, from);
TREE_VEC_ELT (cond, i) = fold_build2 (simple > 0 ? LE_EXPR : GE_EXPR, TREE_VEC_ELT (cond, i) = fold_build2_loc (input_location, simple > 0
boolean_type_node, dovar, to); ? LE_EXPR : GE_EXPR,
TREE_VEC_ELT (incr, i) = fold_build2 (PLUS_EXPR, type, dovar, step); boolean_type_node, dovar,
TREE_VEC_ELT (incr, i) = fold_build2 (MODIFY_EXPR, type, dovar, to);
TREE_VEC_ELT (incr, i) = fold_build2_loc (input_location, PLUS_EXPR,
type, dovar, step);
TREE_VEC_ELT (incr, i) = fold_build2_loc (input_location,
MODIFY_EXPR,
type, dovar,
TREE_VEC_ELT (incr, i)); TREE_VEC_ELT (incr, i));
} }
else else
...@@ -1269,23 +1282,27 @@ gfc_trans_omp_do (gfc_code *code, stmtblock_t *pblock, ...@@ -1269,23 +1282,27 @@ gfc_trans_omp_do (gfc_code *code, stmtblock_t *pblock,
body; body;
cycle_label:; cycle_label:;
} */ } */
tmp = fold_build2 (MINUS_EXPR, type, step, from); tmp = fold_build2_loc (input_location, MINUS_EXPR, type, step, from);
tmp = fold_build2 (PLUS_EXPR, type, to, tmp); tmp = fold_build2_loc (input_location, PLUS_EXPR, type, to, tmp);
tmp = fold_build2 (TRUNC_DIV_EXPR, type, tmp, step); tmp = fold_build2_loc (input_location, TRUNC_DIV_EXPR, type, tmp,
step);
tmp = gfc_evaluate_now (tmp, pblock); tmp = gfc_evaluate_now (tmp, pblock);
count = gfc_create_var (type, "count"); count = gfc_create_var (type, "count");
TREE_VEC_ELT (init, i) = build2_v (MODIFY_EXPR, count, TREE_VEC_ELT (init, i) = build2_v (MODIFY_EXPR, count,
build_int_cst (type, 0)); build_int_cst (type, 0));
TREE_VEC_ELT (cond, i) = fold_build2 (LT_EXPR, boolean_type_node, TREE_VEC_ELT (cond, i) = fold_build2_loc (input_location, LT_EXPR,
boolean_type_node,
count, tmp); count, tmp);
TREE_VEC_ELT (incr, i) = fold_build2 (PLUS_EXPR, type, count, TREE_VEC_ELT (incr, i) = fold_build2_loc (input_location, PLUS_EXPR,
type, count,
build_int_cst (type, 1)); build_int_cst (type, 1));
TREE_VEC_ELT (incr, i) = fold_build2 (MODIFY_EXPR, type, TREE_VEC_ELT (incr, i) = fold_build2_loc (input_location,
count, TREE_VEC_ELT (incr, i)); MODIFY_EXPR, type, count,
TREE_VEC_ELT (incr, i));
/* Initialize DOVAR. */ /* Initialize DOVAR. */
tmp = fold_build2 (MULT_EXPR, type, count, step); tmp = fold_build2_loc (input_location, MULT_EXPR, type, count, step);
tmp = fold_build2 (PLUS_EXPR, type, from, tmp); tmp = fold_build2_loc (input_location, PLUS_EXPR, type, from, tmp);
di = VEC_safe_push (dovar_init, heap, inits, NULL); di = VEC_safe_push (dovar_init, heap, inits, NULL);
di->var = dovar; di->var = dovar;
di->init = tmp; di->init = tmp;
...@@ -1310,8 +1327,10 @@ gfc_trans_omp_do (gfc_code *code, stmtblock_t *pblock, ...@@ -1310,8 +1327,10 @@ gfc_trans_omp_do (gfc_code *code, stmtblock_t *pblock,
will have the value on entry of the last loop, rather will have the value on entry of the last loop, rather
than value after iterator increment. */ than value after iterator increment. */
tmp = gfc_evaluate_now (step, pblock); tmp = gfc_evaluate_now (step, pblock);
tmp = fold_build2 (PLUS_EXPR, type, dovar, tmp); tmp = fold_build2_loc (input_location, PLUS_EXPR, type, dovar,
tmp = fold_build2 (MODIFY_EXPR, type, dovar, tmp); tmp);
tmp = fold_build2_loc (input_location, MODIFY_EXPR, type,
dovar, tmp);
for (c = omp_clauses; c ; c = OMP_CLAUSE_CHAIN (c)) for (c = omp_clauses; c ; c = OMP_CLAUSE_CHAIN (c))
if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_LASTPRIVATE if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_LASTPRIVATE
&& OMP_CLAUSE_DECL (c) == dovar_decl) && OMP_CLAUSE_DECL (c) == dovar_decl)
......
gcc/fortran/trans.c
...@@ -167,7 +167,8 @@ gfc_add_modify (stmtblock_t * pblock, tree lhs, tree rhs) ...@@ -167,7 +167,8 @@ gfc_add_modify (stmtblock_t * pblock, tree lhs, tree rhs)
|| AGGREGATE_TYPE_P (TREE_TYPE (lhs))); || AGGREGATE_TYPE_P (TREE_TYPE (lhs)));
#endif #endif
tmp = fold_build2 (MODIFY_EXPR, void_type_node, lhs, rhs); tmp = fold_build2_loc (input_location, MODIFY_EXPR, void_type_node, lhs,
rhs);
gfc_add_expr_to_block (pblock, tmp); gfc_add_expr_to_block (pblock, tmp);
} }
...@@ -296,7 +297,7 @@ gfc_build_addr_expr (tree type, tree t) ...@@ -296,7 +297,7 @@ gfc_build_addr_expr (tree type, tree t)
tree base = get_base_address (t); tree base = get_base_address (t);
if (base && DECL_P (base)) if (base && DECL_P (base))
TREE_ADDRESSABLE (base) = 1; TREE_ADDRESSABLE (base) = 1;
t = fold_build1 (ADDR_EXPR, natural_type, t); t = fold_build1_loc (input_location, ADDR_EXPR, natural_type, t);
} }
if (type && natural_type != type) if (type && natural_type != type)
...@@ -332,11 +333,13 @@ gfc_build_array_ref (tree base, tree offset, tree decl) ...@@ -332,11 +333,13 @@ gfc_build_array_ref (tree base, tree offset, tree decl)
&& GFC_DECL_SUBREF_ARRAY_P (decl) && GFC_DECL_SUBREF_ARRAY_P (decl)
&& !integer_zerop (GFC_DECL_SPAN(decl))) && !integer_zerop (GFC_DECL_SPAN(decl)))
{ {
offset = fold_build2 (MULT_EXPR, gfc_array_index_type, offset = fold_build2_loc (input_location, MULT_EXPR,
gfc_array_index_type,
offset, GFC_DECL_SPAN(decl)); offset, GFC_DECL_SPAN(decl));
tmp = gfc_build_addr_expr (pvoid_type_node, base); tmp = gfc_build_addr_expr (pvoid_type_node, base);
tmp = fold_build2 (POINTER_PLUS_EXPR, pvoid_type_node, tmp = fold_build2_loc (input_location, POINTER_PLUS_EXPR,
tmp, fold_convert (sizetype, offset)); pvoid_type_node, tmp,
fold_convert (sizetype, offset));
tmp = fold_convert (build_pointer_type (type), tmp); tmp = fold_convert (build_pointer_type (type), tmp);
if (!TYPE_STRING_FLAG (type)) if (!TYPE_STRING_FLAG (type))
tmp = build_fold_indirect_ref_loc (input_location, tmp); tmp = build_fold_indirect_ref_loc (input_location, tmp);
...@@ -421,7 +424,7 @@ gfc_trans_runtime_error_vararg (bool error, locus* where, const char* msgid, ...@@ -421,7 +424,7 @@ gfc_trans_runtime_error_vararg (bool error, locus* where, const char* msgid,
fntype = TREE_TYPE (gfor_fndecl_runtime_warning_at); fntype = TREE_TYPE (gfor_fndecl_runtime_warning_at);
tmp = fold_builtin_call_array (input_location, TREE_TYPE (fntype), tmp = fold_builtin_call_array (input_location, TREE_TYPE (fntype),
fold_build1 (ADDR_EXPR, fold_build1_loc (input_location, ADDR_EXPR,
build_pointer_type (fntype), build_pointer_type (fntype),
error error
? gfor_fndecl_runtime_error_at ? gfor_fndecl_runtime_error_at
...@@ -477,8 +480,8 @@ gfc_trans_runtime_check (bool error, bool once, tree cond, stmtblock_t * pblock, ...@@ -477,8 +480,8 @@ gfc_trans_runtime_check (bool error, bool once, tree cond, stmtblock_t * pblock,
{ {
/* Tell the compiler that this isn't likely. */ /* Tell the compiler that this isn't likely. */
if (once) if (once)
cond = fold_build2 (TRUTH_AND_EXPR, long_integer_type_node, tmpvar, cond = fold_build2_loc (input_location, TRUTH_AND_EXPR,
cond); long_integer_type_node, tmpvar, cond);
else else
cond = fold_convert (long_integer_type_node, cond); cond = fold_convert (long_integer_type_node, cond);
...@@ -513,7 +516,7 @@ gfc_call_malloc (stmtblock_t * block, tree type, tree size) ...@@ -513,7 +516,7 @@ gfc_call_malloc (stmtblock_t * block, tree type, tree size)
/* Call malloc. */ /* Call malloc. */
gfc_start_block (&block2); gfc_start_block (&block2);
size = fold_build2 (MAX_EXPR, size_type_node, size, size = fold_build2_loc (input_location, MAX_EXPR, size_type_node, size,
build_int_cst (size_type_node, 1)); build_int_cst (size_type_node, 1));
gfc_add_modify (&block2, res, gfc_add_modify (&block2, res,
...@@ -524,11 +527,13 @@ gfc_call_malloc (stmtblock_t * block, tree type, tree size) ...@@ -524,11 +527,13 @@ gfc_call_malloc (stmtblock_t * block, tree type, tree size)
/* Optionally check whether malloc was successful. */ /* Optionally check whether malloc was successful. */
if (gfc_option.rtcheck & GFC_RTCHECK_MEM) if (gfc_option.rtcheck & GFC_RTCHECK_MEM)
{ {
null_result = fold_build2 (EQ_EXPR, boolean_type_node, res, null_result = fold_build2_loc (input_location, EQ_EXPR,
boolean_type_node, res,
build_int_cst (pvoid_type_node, 0)); build_int_cst (pvoid_type_node, 0));
msg = gfc_build_addr_expr (pchar_type_node, msg = gfc_build_addr_expr (pchar_type_node,
gfc_build_localized_cstring_const ("Memory allocation failed")); gfc_build_localized_cstring_const ("Memory allocation failed"));
tmp = fold_build3 (COND_EXPR, void_type_node, null_result, tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node,
null_result,
build_call_expr_loc (input_location, build_call_expr_loc (input_location,
gfor_fndecl_os_error, 1, msg), gfor_fndecl_os_error, 1, msg),
build_empty_stmt (input_location)); build_empty_stmt (input_location));
...@@ -601,11 +606,13 @@ gfc_allocate_with_status (stmtblock_t * block, tree size, tree status) ...@@ -601,11 +606,13 @@ gfc_allocate_with_status (stmtblock_t * block, tree size, tree status)
/* Set the optional status variable to zero. */ /* Set the optional status variable to zero. */
if (status != NULL_TREE && !integer_zerop (status)) if (status != NULL_TREE && !integer_zerop (status))
{ {
tmp = fold_build2 (MODIFY_EXPR, status_type, tmp = fold_build2_loc (input_location, MODIFY_EXPR, status_type,
fold_build1 (INDIRECT_REF, status_type, status), fold_build1_loc (input_location, 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_loc (input_location, COND_EXPR, void_type_node,
fold_build2 (NE_EXPR, boolean_type_node, status, fold_build2_loc (input_location, NE_EXPR,
boolean_type_node, status,
build_int_cst (TREE_TYPE (status), 0)), build_int_cst (TREE_TYPE (status), 0)),
tmp, build_empty_stmt (input_location)); tmp, build_empty_stmt (input_location));
gfc_add_expr_to_block (block, tmp); gfc_add_expr_to_block (block, tmp);
...@@ -625,15 +632,16 @@ gfc_allocate_with_status (stmtblock_t * block, tree size, tree status) ...@@ -625,15 +632,16 @@ 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 (&set_status_block, gfc_add_modify (&set_status_block,
fold_build1 (INDIRECT_REF, status_type, status), fold_build1_loc (input_location, INDIRECT_REF,
status_type, status),
build_int_cst (status_type, LIBERROR_ALLOCATION)); build_int_cst (status_type, LIBERROR_ALLOCATION));
gfc_add_modify (&set_status_block, res, gfc_add_modify (&set_status_block, res,
build_int_cst (prvoid_type_node, 0)); build_int_cst (prvoid_type_node, 0));
tmp = fold_build2 (EQ_EXPR, boolean_type_node, status, tmp = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
build_int_cst (TREE_TYPE (status), 0)); status, build_int_cst (TREE_TYPE (status), 0));
error = fold_build3 (COND_EXPR, void_type_node, tmp, error, error = fold_build3_loc (input_location, COND_EXPR, void_type_node, tmp,
gfc_finish_block (&set_status_block)); error, gfc_finish_block (&set_status_block));
} }
/* The allocation itself. */ /* The allocation itself. */
...@@ -642,9 +650,10 @@ gfc_allocate_with_status (stmtblock_t * block, tree size, tree status) ...@@ -642,9 +650,10 @@ gfc_allocate_with_status (stmtblock_t * block, tree size, tree status)
fold_convert (prvoid_type_node, fold_convert (prvoid_type_node,
build_call_expr_loc (input_location, build_call_expr_loc (input_location,
built_in_decls[BUILT_IN_MALLOC], 1, built_in_decls[BUILT_IN_MALLOC], 1,
fold_build2 (MAX_EXPR, size_type_node, fold_build2_loc (input_location,
size, MAX_EXPR, size_type_node, size,
build_int_cst (size_type_node, 1))))); build_int_cst (size_type_node,
1)))));
msg = gfc_build_addr_expr (pchar_type_node, gfc_build_localized_cstring_const msg = gfc_build_addr_expr (pchar_type_node, gfc_build_localized_cstring_const
("Out of memory")); ("Out of memory"));
...@@ -656,24 +665,26 @@ gfc_allocate_with_status (stmtblock_t * block, tree size, tree status) ...@@ -656,24 +665,26 @@ gfc_allocate_with_status (stmtblock_t * block, tree size, tree status)
/* Set the status variable if it's present. */ /* Set the status variable if it's present. */
tree tmp2; tree tmp2;
cond = fold_build2 (EQ_EXPR, boolean_type_node, status, cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
build_int_cst (TREE_TYPE (status), 0)); status, build_int_cst (TREE_TYPE (status), 0));
tmp2 = fold_build2 (MODIFY_EXPR, status_type, tmp2 = fold_build2_loc (input_location, MODIFY_EXPR, status_type,
fold_build1 (INDIRECT_REF, status_type, status), fold_build1_loc (input_location, 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_loc (input_location, COND_EXPR, void_type_node, cond,
tmp2); tmp, tmp2);
} }
tmp = fold_build3 (COND_EXPR, void_type_node, tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node,
fold_build2 (EQ_EXPR, boolean_type_node, res, fold_build2_loc (input_location, EQ_EXPR,
boolean_type_node, res,
build_int_cst (prvoid_type_node, 0)), build_int_cst (prvoid_type_node, 0)),
tmp, build_empty_stmt (input_location)); tmp, build_empty_stmt (input_location));
gfc_add_expr_to_block (&alloc_block, tmp); gfc_add_expr_to_block (&alloc_block, tmp);
cond = fold_build2 (LT_EXPR, boolean_type_node, size, cond = fold_build2_loc (input_location, LT_EXPR, boolean_type_node, size,
build_int_cst (TREE_TYPE (size), 0)); build_int_cst (TREE_TYPE (size), 0));
tmp = fold_build3 (COND_EXPR, void_type_node, cond, error, tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond, error,
gfc_finish_block (&alloc_block)); gfc_finish_block (&alloc_block));
gfc_add_expr_to_block (block, tmp); gfc_add_expr_to_block (block, tmp);
...@@ -721,7 +732,7 @@ gfc_allocate_array_with_status (stmtblock_t * block, tree mem, tree size, ...@@ -721,7 +732,7 @@ gfc_allocate_array_with_status (stmtblock_t * block, tree mem, tree size,
/* Create a variable to hold the result. */ /* Create a variable to hold the result. */
res = gfc_create_var (type, NULL); res = gfc_create_var (type, NULL);
null_mem = fold_build2 (EQ_EXPR, boolean_type_node, mem, null_mem = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, mem,
build_int_cst (type, 0)); build_int_cst (type, 0));
/* If mem is NULL, we call gfc_allocate_with_status. */ /* If mem is NULL, we call gfc_allocate_with_status. */
...@@ -764,16 +775,18 @@ gfc_allocate_array_with_status (stmtblock_t * block, tree mem, tree size, ...@@ -764,16 +775,18 @@ gfc_allocate_array_with_status (stmtblock_t * block, tree mem, tree size,
gfc_add_modify (&set_status_block, res, fold_convert (type, tmp)); gfc_add_modify (&set_status_block, res, fold_convert (type, tmp));
gfc_add_modify (&set_status_block, gfc_add_modify (&set_status_block,
fold_build1 (INDIRECT_REF, status_type, status), fold_build1_loc (input_location, 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_loc (input_location, EQ_EXPR, boolean_type_node,
build_int_cst (status_type, 0)); status, build_int_cst (status_type, 0));
error = fold_build3 (COND_EXPR, void_type_node, tmp, error, error = fold_build3_loc (input_location, COND_EXPR, void_type_node, tmp,
gfc_finish_block (&set_status_block)); error, gfc_finish_block (&set_status_block));
} }
tmp = fold_build3 (COND_EXPR, void_type_node, null_mem, alloc, error); tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, null_mem,
alloc, error);
gfc_add_expr_to_block (block, tmp); gfc_add_expr_to_block (block, tmp);
return res; return res;
...@@ -792,11 +805,11 @@ gfc_call_free (tree var) ...@@ -792,11 +805,11 @@ gfc_call_free (tree var)
gfc_start_block (&block); gfc_start_block (&block);
var = gfc_evaluate_now (var, &block); var = gfc_evaluate_now (var, &block);
cond = fold_build2 (NE_EXPR, boolean_type_node, var, cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, var,
build_int_cst (pvoid_type_node, 0)); build_int_cst (pvoid_type_node, 0));
call = build_call_expr_loc (input_location, call = build_call_expr_loc (input_location,
built_in_decls[BUILT_IN_FREE], 1, var); built_in_decls[BUILT_IN_FREE], 1, var);
tmp = fold_build3 (COND_EXPR, void_type_node, cond, call, tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond, call,
build_empty_stmt (input_location)); build_empty_stmt (input_location));
gfc_add_expr_to_block (&block, tmp); gfc_add_expr_to_block (&block, tmp);
...@@ -841,7 +854,7 @@ gfc_deallocate_with_status (tree pointer, tree status, bool can_fail, ...@@ -841,7 +854,7 @@ gfc_deallocate_with_status (tree pointer, tree status, bool can_fail,
stmtblock_t null, non_null; stmtblock_t null, non_null;
tree cond, tmp, error; tree cond, tmp, error;
cond = fold_build2 (EQ_EXPR, boolean_type_node, pointer, cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, pointer,
build_int_cst (TREE_TYPE (pointer), 0)); build_int_cst (TREE_TYPE (pointer), 0));
/* When POINTER is NULL, we set STATUS to 1 if it's present, otherwise /* When POINTER is NULL, we set STATUS to 1 if it's present, otherwise
...@@ -868,12 +881,14 @@ gfc_deallocate_with_status (tree pointer, tree status, bool can_fail, ...@@ -868,12 +881,14 @@ gfc_deallocate_with_status (tree pointer, tree status, bool can_fail,
tree status_type = TREE_TYPE (TREE_TYPE (status)); tree status_type = TREE_TYPE (TREE_TYPE (status));
tree cond2; tree cond2;
cond2 = fold_build2 (NE_EXPR, boolean_type_node, status, cond2 = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
build_int_cst (TREE_TYPE (status), 0)); status, build_int_cst (TREE_TYPE (status), 0));
tmp = fold_build2 (MODIFY_EXPR, status_type, tmp = fold_build2_loc (input_location, MODIFY_EXPR, status_type,
fold_build1 (INDIRECT_REF, status_type, status), fold_build1_loc (input_location, 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_loc (input_location, COND_EXPR, void_type_node,
cond2, tmp, error);
} }
gfc_add_expr_to_block (&null, error); gfc_add_expr_to_block (&null, error);
...@@ -891,18 +906,20 @@ gfc_deallocate_with_status (tree pointer, tree status, bool can_fail, ...@@ -891,18 +906,20 @@ gfc_deallocate_with_status (tree pointer, tree status, bool can_fail,
tree status_type = TREE_TYPE (TREE_TYPE (status)); tree status_type = TREE_TYPE (TREE_TYPE (status));
tree cond2; tree cond2;
cond2 = fold_build2 (NE_EXPR, boolean_type_node, status, cond2 = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
build_int_cst (TREE_TYPE (status), 0)); status, build_int_cst (TREE_TYPE (status), 0));
tmp = fold_build2 (MODIFY_EXPR, status_type, tmp = fold_build2_loc (input_location, MODIFY_EXPR, status_type,
fold_build1 (INDIRECT_REF, status_type, status), fold_build1_loc (input_location, 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_loc (input_location, COND_EXPR, void_type_node, cond2,
build_empty_stmt (input_location)); tmp, build_empty_stmt (input_location));
gfc_add_expr_to_block (&non_null, tmp); gfc_add_expr_to_block (&non_null, tmp);
} }
return fold_build3 (COND_EXPR, void_type_node, cond, return fold_build3_loc (input_location, COND_EXPR, void_type_node, cond,
gfc_finish_block (&null), gfc_finish_block (&non_null)); gfc_finish_block (&null),
gfc_finish_block (&non_null));
} }
...@@ -938,11 +955,11 @@ gfc_call_realloc (stmtblock_t * block, tree mem, tree size) ...@@ -938,11 +955,11 @@ gfc_call_realloc (stmtblock_t * block, tree mem, tree size)
res = gfc_create_var (type, NULL); res = gfc_create_var (type, NULL);
/* size < 0 ? */ /* size < 0 ? */
negative = fold_build2 (LT_EXPR, boolean_type_node, size, negative = fold_build2_loc (input_location, LT_EXPR, boolean_type_node, size,
build_int_cst (size_type_node, 0)); build_int_cst (size_type_node, 0));
msg = gfc_build_addr_expr (pchar_type_node, gfc_build_localized_cstring_const msg = gfc_build_addr_expr (pchar_type_node, gfc_build_localized_cstring_const
("Attempt to allocate a negative amount of memory.")); ("Attempt to allocate a negative amount of memory."));
tmp = fold_build3 (COND_EXPR, void_type_node, negative, tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, negative,
build_call_expr_loc (input_location, build_call_expr_loc (input_location,
gfor_fndecl_runtime_error, 1, msg), gfor_fndecl_runtime_error, 1, msg),
build_empty_stmt (input_location)); build_empty_stmt (input_location));
...@@ -953,24 +970,27 @@ gfc_call_realloc (stmtblock_t * block, tree mem, tree size) ...@@ -953,24 +970,27 @@ gfc_call_realloc (stmtblock_t * block, tree mem, tree size)
built_in_decls[BUILT_IN_REALLOC], 2, built_in_decls[BUILT_IN_REALLOC], 2,
fold_convert (pvoid_type_node, mem), size); fold_convert (pvoid_type_node, mem), size);
gfc_add_modify (block, res, fold_convert (type, tmp)); gfc_add_modify (block, res, fold_convert (type, tmp));
null_result = fold_build2 (EQ_EXPR, boolean_type_node, res, null_result = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
build_int_cst (pvoid_type_node, 0)); res, build_int_cst (pvoid_type_node, 0));
nonzero = fold_build2 (NE_EXPR, boolean_type_node, size, nonzero = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, size,
build_int_cst (size_type_node, 0)); build_int_cst (size_type_node, 0));
null_result = fold_build2 (TRUTH_AND_EXPR, boolean_type_node, null_result, null_result = fold_build2_loc (input_location, TRUTH_AND_EXPR, boolean_type_node,
nonzero); null_result, nonzero);
msg = gfc_build_addr_expr (pchar_type_node, gfc_build_localized_cstring_const msg = gfc_build_addr_expr (pchar_type_node, gfc_build_localized_cstring_const
("Out of memory")); ("Out of memory"));
tmp = fold_build3 (COND_EXPR, void_type_node, null_result, tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node,
null_result,
build_call_expr_loc (input_location, build_call_expr_loc (input_location,
gfor_fndecl_os_error, 1, msg), gfor_fndecl_os_error, 1, msg),
build_empty_stmt (input_location)); build_empty_stmt (input_location));
gfc_add_expr_to_block (block, tmp); gfc_add_expr_to_block (block, tmp);
/* if (size == 0) then the result is NULL. */ /* if (size == 0) then the result is NULL. */
tmp = fold_build2 (MODIFY_EXPR, type, res, build_int_cst (type, 0)); tmp = fold_build2_loc (input_location, MODIFY_EXPR, type, res,
zero = fold_build1 (TRUTH_NOT_EXPR, boolean_type_node, nonzero); build_int_cst (type, 0));
tmp = fold_build3 (COND_EXPR, void_type_node, zero, tmp, zero = fold_build1_loc (input_location, TRUTH_NOT_EXPR, boolean_type_node,
nonzero);
tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, zero, tmp,
build_empty_stmt (input_location)); build_empty_stmt (input_location));
gfc_add_expr_to_block (block, tmp); gfc_add_expr_to_block (block, tmp);
......
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