summaryrefslogtreecommitdiff
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.c79
1 files changed, 46 insertions, 33 deletions
diff --git a/gcc/fortran/trans-io.c b/gcc/fortran/trans-io.c
index 2c843497295..c4781dc39e5 100644
--- a/gcc/fortran/trans-io.c
+++ b/gcc/fortran/trans-io.c
@@ -471,14 +471,15 @@ gfc_build_io_library_fndecls (void)
iocall[IOCALL_SET_NML_VAL] = gfc_build_library_function_decl_with_spec (
get_identifier (PREFIX("st_set_nml_var")), ".w.R",
- void_type_node, 6, dt_parm_type, pvoid_type_node, pvoid_type_node,
- gfc_int4_type_node, gfc_charlen_type_node, gfc_int4_type_node);
+ void_type_node, 7, dt_parm_type, pvoid_type_node, pvoid_type_node,
+ gfc_int4_type_node, gfc_charlen_type_node, gfc_int4_type_node,
+ gfc_int4_type_node);
iocall[IOCALL_SET_NML_DTIO_VAL] = gfc_build_library_function_decl_with_spec (
get_identifier (PREFIX("st_set_nml_dtio_var")), ".w.R",
- void_type_node, 8, dt_parm_type, pvoid_type_node, pvoid_type_node,
+ void_type_node, 9, dt_parm_type, pvoid_type_node, pvoid_type_node,
gfc_int4_type_node, gfc_charlen_type_node, gfc_int4_type_node,
- pvoid_type_node, pvoid_type_node);
+ gfc_int4_type_node, pvoid_type_node, pvoid_type_node);
iocall[IOCALL_SET_NML_VAL_DIM] = gfc_build_library_function_decl_with_spec (
get_identifier (PREFIX("st_set_nml_var_dim")), ".w",
@@ -755,16 +756,10 @@ gfc_convert_array_to_string (gfc_se * se, gfc_expr * e)
else
{
gcc_assert (GFC_DESCRIPTOR_TYPE_P (type));
- size = gfc_conv_array_stride (array, rank);
- 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);
+ gfc_array_index_type,
+ gfc_conv_array_stride (array, rank),
+ gfc_conv_array_extent (array, rank));
}
gcc_assert (size);
@@ -1630,14 +1625,13 @@ transfer_namelist_element (stmtblock_t * block, const char * var_name,
tree dt = NULL;
tree string;
tree tmp;
- tree dtype;
+ tree elem_len;
tree dt_parm_addr;
tree decl = NULL_TREE;
tree gfc_int4_type_node = gfc_get_int_type (4);
- tree dtio_proc = null_pointer_node;
- tree vtable = null_pointer_node;
+ tree dtio_proc = NULL_TREE;
+ tree vtable = NULL_TREE;
int n_dim;
- int itype;
int rank = 0;
gcc_assert (sym || c);
@@ -1657,23 +1651,29 @@ transfer_namelist_element (stmtblock_t * block, const char * var_name,
if (as)
rank = as->rank;
+ decl = (sym) ? sym->backend_decl : c->backend_decl;
if (rank)
{
- decl = (sym) ? sym->backend_decl : c->backend_decl;
if (sym && sym->attr.dummy)
decl = build_fold_indirect_ref_loc (input_location, decl);
dt = TREE_TYPE (decl);
- dtype = gfc_get_dtype (dt);
+ tmp = TYPE_SIZE_UNIT (gfc_get_element_type (dt));
}
else
{
- itype = ts->type;
- dtype = IARG (itype << GFC_DTYPE_TYPE_SHIFT);
+ tmp = TREE_TYPE (decl);
+ if (TREE_CODE (tmp) == REFERENCE_TYPE)
+ tmp = TREE_TYPE (tmp);
+ if (POINTER_TYPE_P (tmp) || TREE_CODE (tmp) == REFERENCE_TYPE)
+ tmp = TREE_TYPE (tmp);
+ tmp = TYPE_SIZE_UNIT (tmp);
}
+ elem_len = tmp;
+
/* Build up the arguments for the transfer call.
The call for the scalar part transfers:
- (address, name, type, kind or string_length, dtype) */
+ (address, name, kind, elem_len, type) */
dt_parm_addr = gfc_build_addr_expr (NULL_TREE, dt_parm);
@@ -1700,22 +1700,35 @@ transfer_namelist_element (stmtblock_t * block, const char * var_name,
}
if (ts->type == BT_CHARACTER)
- tmp = ts->u.cl->backend_decl;
+ {
+ elem_len = ts->u.cl->backend_decl;
+ tmp = build_int_cst (gfc_charlen_type_node, ts->kind);
+ elem_len = fold_build2_loc (input_location, MULT_EXPR,
+ gfc_charlen_type_node,
+ elem_len, tmp);
+ gfc_evaluate_now (elem_len, block);
+ }
else
- tmp = build_int_cst (gfc_charlen_type_node, 0);
+ elem_len = fold_convert (gfc_charlen_type_node, elem_len);
+
if (dtio_proc == NULL_TREE)
tmp = build_call_expr_loc (input_location,
- iocall[IOCALL_SET_NML_VAL], 6,
+ iocall[IOCALL_SET_NML_VAL], 7,
dt_parm_addr, addr_expr, string,
build_int_cst (gfc_int4_type_node, ts->kind),
- tmp, dtype);
+ elem_len,
+ build_int_cst (gfc_int4_type_node, rank),
+ build_int_cst (gfc_int4_type_node, ts->type));
else
tmp = build_call_expr_loc (input_location,
- iocall[IOCALL_SET_NML_DTIO_VAL], 8,
+ iocall[IOCALL_SET_NML_DTIO_VAL], 9,
dt_parm_addr, addr_expr, string,
build_int_cst (gfc_int4_type_node, ts->kind),
- tmp, dtype, dtio_proc, vtable);
+ elem_len,
+ build_int_cst (gfc_int4_type_node, rank),
+ build_int_cst (integer_type_node, ts->type),
+ dtio_proc, vtable);
gfc_add_expr_to_block (block, tmp);
/* If the object is an array, transfer rank times:
@@ -1727,14 +1740,14 @@ transfer_namelist_element (stmtblock_t * block, const char * var_name,
iocall[IOCALL_SET_NML_VAL_DIM], 5,
dt_parm_addr,
build_int_cst (gfc_int4_type_node, n_dim),
- gfc_conv_array_stride (decl, n_dim),
gfc_conv_array_lbound (decl, n_dim),
- gfc_conv_array_ubound (decl, n_dim));
+ gfc_conv_array_extent (decl, n_dim),
+ gfc_conv_array_sm (decl, n_dim));
gfc_add_expr_to_block (block, tmp);
}
if (gfc_bt_struct (ts->type) && ts->u.derived->components
- && dtio_proc == null_pointer_node)
+ && dtio_proc == NULL_TREE)
{
gfc_component *cmp;
@@ -2097,7 +2110,7 @@ transfer_array_component (tree expr, gfc_component * cm, locus * where)
gfc_init_loopinfo (&loop);
gfc_add_ss_to_loop (&loop, ss);
gfc_conv_ss_startstride (&loop);
- gfc_conv_loop_setup (&loop, where);
+ gfc_conv_loop_setup (&loop, where, &cm->ts);
gfc_mark_ss_chain_used (ss, 1);
gfc_start_scalarized_body (&loop, &body);
@@ -2513,7 +2526,7 @@ gfc_trans_transfer (gfc_code * code)
/* Initialize the loop. */
gfc_conv_ss_startstride (&loop);
- gfc_conv_loop_setup (&loop, &code->expr1->where);
+ gfc_conv_loop_setup (&loop, &code->expr1->where, &code->expr1->ts);
/* The main loop body. */
gfc_mark_ss_chain_used (ss, 1);
View Lorry Controller Status