aboutsummaryrefslogtreecommitdiff
path: root/gcc/fortran/trans-io.c
diff options
context:
space:
mode:
Diffstat (limited to 'gcc/fortran/trans-io.c')
-rw-r--r--gcc/fortran/trans-io.c135
1 files changed, 76 insertions, 59 deletions
diff --git a/gcc/fortran/trans-io.c b/gcc/fortran/trans-io.c
index 89c8df7..6d4cba2 100644
--- a/gcc/fortran/trans-io.c
+++ b/gcc/fortran/trans-io.c
@@ -428,10 +428,11 @@ set_parameter_const (stmtblock_t *block, tree var, enum iofield type,
gfc_st_parameter_field *p = &st_parameter_field[type];
if (p->param_type == IOPARM_ptype_common)
- var = fold_build3 (COMPONENT_REF, st_parameter[IOPARM_ptype_common].type,
- var, TYPE_FIELDS (TREE_TYPE (var)), NULL_TREE);
- tmp = fold_build3 (COMPONENT_REF, TREE_TYPE (p->field), var, p->field,
- NULL_TREE);
+ var = fold_build3_loc (input_location, COMPONENT_REF,
+ st_parameter[IOPARM_ptype_common].type,
+ var, TYPE_FIELDS (TREE_TYPE (var)), NULL_TREE);
+ tmp = fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (p->field),
+ var, p->field, NULL_TREE);
gfc_add_modify (block, tmp, build_int_cst (TREE_TYPE (p->field), val));
return p->mask;
}
@@ -464,16 +465,18 @@ set_parameter_value (stmtblock_t *block, tree var, enum iofield type,
/* UNIT numbers should be greater than the min. */
i = gfc_validate_kind (BT_INTEGER, 4, false);
val = gfc_conv_mpz_to_tree (gfc_integer_kinds[i].pedantic_min_int, 4);
- cond = fold_build2 (LT_EXPR, boolean_type_node, se.expr,
- fold_convert (TREE_TYPE (se.expr), val));
+ cond = fold_build2_loc (input_location, LT_EXPR, boolean_type_node,
+ se.expr,
+ fold_convert (TREE_TYPE (se.expr), val));
gfc_trans_io_runtime_check (cond, var, LIBERROR_BAD_UNIT,
"Unit number in I/O statement too small",
&se.pre);
/* UNIT numbers should be less than the max. */
val = gfc_conv_mpz_to_tree (gfc_integer_kinds[i].huge, 4);
- cond = fold_build2 (GT_EXPR, boolean_type_node, se.expr,
- fold_convert (TREE_TYPE (se.expr), val));
+ cond = fold_build2_loc (input_location, GT_EXPR, boolean_type_node,
+ se.expr,
+ fold_convert (TREE_TYPE (se.expr), val));
gfc_trans_io_runtime_check (cond, var, LIBERROR_BAD_UNIT,
"Unit number in I/O statement too large",
&se.pre);
@@ -484,10 +487,12 @@ set_parameter_value (stmtblock_t *block, tree var, enum iofield type,
gfc_add_block_to_block (block, &se.pre);
if (p->param_type == IOPARM_ptype_common)
- var = fold_build3 (COMPONENT_REF, st_parameter[IOPARM_ptype_common].type,
- var, TYPE_FIELDS (TREE_TYPE (var)), NULL_TREE);
+ var = fold_build3_loc (input_location, COMPONENT_REF,
+ st_parameter[IOPARM_ptype_common].type,
+ 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);
return p->mask;
}
@@ -542,10 +547,11 @@ set_parameter_ref (stmtblock_t *block, stmtblock_t *postblock,
}
if (p->param_type == IOPARM_ptype_common)
- var = fold_build3 (COMPONENT_REF, st_parameter[IOPARM_ptype_common].type,
- var, TYPE_FIELDS (TREE_TYPE (var)), NULL_TREE);
- tmp = fold_build3 (COMPONENT_REF, TREE_TYPE (p->field),
- var, p->field, NULL_TREE);
+ var = fold_build3_loc (input_location, COMPONENT_REF,
+ st_parameter[IOPARM_ptype_common].type,
+ var, TYPE_FIELDS (TREE_TYPE (var)), NULL_TREE);
+ tmp = fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (p->field),
+ var, p->field, NULL_TREE);
gfc_add_modify (block, tmp, addr);
return p->mask;
}
@@ -583,21 +589,26 @@ gfc_convert_array_to_string (gfc_se * se, gfc_expr * e)
{
gcc_assert (GFC_DESCRIPTOR_TYPE_P (type));
size = gfc_conv_array_stride (array, rank);
- tmp = fold_build2 (MINUS_EXPR, gfc_array_index_type,
- gfc_conv_array_ubound (array, rank),
- gfc_conv_array_lbound (array, rank));
- tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type, tmp,
- gfc_index_one_node);
- size = fold_build2 (MULT_EXPR, gfc_array_index_type, tmp, size);
+ tmp = fold_build2_loc (input_location, MINUS_EXPR,
+ gfc_array_index_type,
+ gfc_conv_array_ubound (array, rank),
+ gfc_conv_array_lbound (array, rank));
+ tmp = fold_build2_loc (input_location, PLUS_EXPR,
+ gfc_array_index_type, tmp,
+ gfc_index_one_node);
+ size = fold_build2_loc (input_location, MULT_EXPR,
+ gfc_array_index_type, tmp, size);
}
gcc_assert (size);
- size = fold_build2 (MINUS_EXPR, gfc_array_index_type, size,
- TREE_OPERAND (se->expr, 1));
+ size = fold_build2_loc (input_location, MINUS_EXPR,
+ gfc_array_index_type, size,
+ TREE_OPERAND (se->expr, 1));
se->expr = gfc_build_addr_expr (NULL_TREE, se->expr);
tmp = TYPE_SIZE_UNIT (gfc_get_element_type (type));
- size = fold_build2 (MULT_EXPR, gfc_array_index_type, size,
- fold_convert (gfc_array_index_type, tmp));
+ size = fold_build2_loc (input_location, MULT_EXPR,
+ gfc_array_index_type, size,
+ fold_convert (gfc_array_index_type, tmp));
se->string_length = fold_convert (gfc_charlen_type_node, size);
return;
}
@@ -623,12 +634,14 @@ set_string (stmtblock_t * block, stmtblock_t * postblock, tree var,
gfc_init_se (&se, NULL);
if (p->param_type == IOPARM_ptype_common)
- var = fold_build3 (COMPONENT_REF, st_parameter[IOPARM_ptype_common].type,
- var, TYPE_FIELDS (TREE_TYPE (var)), NULL_TREE);
- io = fold_build3 (COMPONENT_REF, TREE_TYPE (p->field),
+ var = fold_build3_loc (input_location, COMPONENT_REF,
+ st_parameter[IOPARM_ptype_common].type,
+ var, TYPE_FIELDS (TREE_TYPE (var)), NULL_TREE);
+ io = fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (p->field),
var, p->field, NULL_TREE);
- len = fold_build3 (COMPONENT_REF, TREE_TYPE (p->field_len),
- var, p->field_len, NULL_TREE);
+ len = fold_build3_loc (input_location, COMPONENT_REF,
+ TREE_TYPE (p->field_len),
+ var, p->field_len, NULL_TREE);
/* Integer variable assigned a format label. */
if (e->ts.type == BT_INTEGER
@@ -640,8 +653,8 @@ set_string (stmtblock_t * block, stmtblock_t * postblock, tree var,
gfc_conv_label_variable (&se, e);
tmp = GFC_DECL_STRING_LEN (se.expr);
- cond = fold_build2 (LT_EXPR, boolean_type_node,
- tmp, build_int_cst (TREE_TYPE (tmp), 0));
+ cond = fold_build2_loc (input_location, LT_EXPR, boolean_type_node,
+ tmp, build_int_cst (TREE_TYPE (tmp), 0));
asprintf(&msg, "Label assigned to variable '%s' (%%ld) is not a format "
"label", e->symtree->name);
@@ -694,13 +707,13 @@ set_internal_unit (stmtblock_t * block, stmtblock_t * post_block,
p = &st_parameter_field[IOPARM_dt_internal_unit];
mask = p->mask;
- io = fold_build3 (COMPONENT_REF, TREE_TYPE (p->field),
- var, p->field, NULL_TREE);
- len = fold_build3 (COMPONENT_REF, TREE_TYPE (p->field_len),
- var, p->field_len, NULL_TREE);
+ io = fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (p->field),
+ var, p->field, NULL_TREE);
+ len = fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (p->field_len),
+ var, p->field_len, NULL_TREE);
p = &st_parameter_field[IOPARM_dt_internal_unit_desc];
- desc = fold_build3 (COMPONENT_REF, TREE_TYPE (p->field),
- var, p->field, NULL_TREE);
+ desc = fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (p->field),
+ var, p->field, NULL_TREE);
gcc_assert (e->ts.type == BT_CHARACTER);
@@ -809,13 +822,14 @@ io_result (stmtblock_t * block, tree var, gfc_st_label * err_label,
tmp = gfc_finish_block (&body);
- var = fold_build3 (COMPONENT_REF, st_parameter[IOPARM_ptype_common].type,
- var, TYPE_FIELDS (TREE_TYPE (var)), NULL_TREE);
- rc = fold_build3 (COMPONENT_REF, TREE_TYPE (p->field),
- var, p->field, NULL_TREE);
- rc = fold_build2 (BIT_AND_EXPR, TREE_TYPE (rc),
- rc, build_int_cst (TREE_TYPE (rc),
- IOPARM_common_libreturn_mask));
+ var = fold_build3_loc (input_location, COMPONENT_REF,
+ st_parameter[IOPARM_ptype_common].type,
+ var, TYPE_FIELDS (TREE_TYPE (var)), NULL_TREE);
+ rc = fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (p->field),
+ var, p->field, NULL_TREE);
+ rc = fold_build2_loc (input_location, BIT_AND_EXPR, TREE_TYPE (rc),
+ rc, build_int_cst (TREE_TYPE (rc),
+ IOPARM_common_libreturn_mask));
tmp = build3_v (SWITCH_EXPR, rc, tmp, NULL_TREE);
@@ -834,11 +848,12 @@ set_error_locus (stmtblock_t * block, tree var, locus * where)
int line;
gfc_st_parameter_field *p = &st_parameter_field[IOPARM_common_filename];
- locus_file = fold_build3 (COMPONENT_REF,
- st_parameter[IOPARM_ptype_common].type,
- var, TYPE_FIELDS (TREE_TYPE (var)), NULL_TREE);
- locus_file = fold_build3 (COMPONENT_REF, TREE_TYPE (p->field),
- locus_file, p->field, NULL_TREE);
+ locus_file = fold_build3_loc (input_location, COMPONENT_REF,
+ st_parameter[IOPARM_ptype_common].type,
+ var, TYPE_FIELDS (TREE_TYPE (var)), NULL_TREE);
+ locus_file = fold_build3_loc (input_location, COMPONENT_REF,
+ TREE_TYPE (p->field), locus_file,
+ p->field, NULL_TREE);
f = where->lb->file;
str = gfc_build_cstring_const (f->filename);
@@ -1448,8 +1463,8 @@ nml_get_addr_expr (gfc_symbol * sym, gfc_component * c,
the derived type. */
if (TREE_CODE (decl) == FIELD_DECL)
- tmp = fold_build3 (COMPONENT_REF, TREE_TYPE (tmp),
- base_addr, tmp, NULL_TREE);
+ tmp = fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (tmp),
+ base_addr, tmp, NULL_TREE);
/* If we have a derived type component, a reference to the first
element of the array is built. This is done so that base_addr,
@@ -1786,13 +1801,15 @@ build_dt (tree function, gfc_code * code)
{
gfc_st_parameter_field *p = &st_parameter_field[IOPARM_common_flags];
- tmp = fold_build3 (COMPONENT_REF, st_parameter[IOPARM_ptype_common].type,
- dt_parm, TYPE_FIELDS (TREE_TYPE (dt_parm)), NULL_TREE);
- tmp = fold_build3 (COMPONENT_REF, TREE_TYPE (p->field),
- tmp, p->field, NULL_TREE);
- tmp = fold_build2 (BIT_AND_EXPR, TREE_TYPE (tmp),
- tmp, build_int_cst (TREE_TYPE (tmp),
- IOPARM_common_libreturn_mask));
+ tmp = fold_build3_loc (input_location, COMPONENT_REF,
+ st_parameter[IOPARM_ptype_common].type,
+ dt_parm, TYPE_FIELDS (TREE_TYPE (dt_parm)),
+ NULL_TREE);
+ 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),
+ IOPARM_common_libreturn_mask));
}
else /* IOLENGTH */
tmp = NULL_TREE;
generated by cgit v1.1 at 2025-06-02 13:44:10 +0000