re PR tree-optimization/20165 (Pointer does not really escape with write)
2010-10-16 Thomas Koenig <tkoenig@gcc.gnu.org> PR fortran/20165 PR fortran/31593 PR fortran/43665 * gfortran.map: Add _gfortran_transfer_array_write, _gfortran_transfer_array_write, _gfortran_transfer_character_write, _gfortran_transfer_character_wide_write, _gfortran_transfer_complex_write, _gfortran_transfer_integer_write, _gfortran_transfer_logical_write and _gfortran_transfer_real_write. * io/transfer.c (transfer_integer_write): Add prototype and function body as call to the original function, without the _write. (transfer_real_write): Likewise. (transfer_logical_write): Likewise. (transfer_character_write): Likewise. (transfer_character_wide_write): Likewise. (transfer_complex_write): Likewise. (transfer_array_write): Likewise. 2010-10-16 Thomas Koenig <tkoenig@gcc.gnu.org> PR fortran/20165 PR fortran/31593 PR fortran/43665 * trans-io.c (enum iocall): Add IOCALL_X_INTEGER_WRITE, IOCALL_X_LOGICAL_WRITE, IOCALL_X_CHARACTER_WRITE, IOCALL_X_CHARACTER_WIDE_WRIE, IOCALL_X_REAL_WRITE, IOCALL_X_COMPLEX_WRITE and IOCALL_X_ARRAY_WRITE. (gfc_build_io_library_fndecls): Add corresponding function decls. (transfer_expr): If the current transfer is a READ, use the iocall with the original version, otherwise the version with _WRITE. (transfer_array_desc): Likewise. From-SVN: r165559
This commit is contained in:
Thomas Koenig
parent
08d78391b7
commit
6eb6875d7e
@ -1,3 +1,18 @@
|
||||
2010-10-16 Thomas Koenig <tkoenig@gcc.gnu.org>
|
||||
|
||||
PR fortran/20165
|
||||
PR fortran/31593
|
||||
PR fortran/43665
|
||||
* trans-io.c (enum iocall): Add IOCALL_X_INTEGER_WRITE,
|
||||
IOCALL_X_LOGICAL_WRITE, IOCALL_X_CHARACTER_WRITE,
|
||||
IOCALL_X_CHARACTER_WIDE_WRIE, IOCALL_X_REAL_WRITE,
|
||||
IOCALL_X_COMPLEX_WRITE and IOCALL_X_ARRAY_WRITE.
|
||||
(gfc_build_io_library_fndecls): Add corresponding function
|
||||
decls.
|
||||
(transfer_expr): If the current transfer is a READ, use
|
||||
the iocall with the original version, otherwise the version
|
||||
with _WRITE.
|
||||
(transfer_array_desc): Likewise.
|
||||
2010-10-15 Tobias Burnus <burnus@net-b.de>
|
||||
|
||||
PR fortran/45186
|
||||
|
||||
@ -115,12 +115,19 @@ enum iocall
|
||||
IOCALL_WRITE,
|
||||
IOCALL_WRITE_DONE,
|
||||
IOCALL_X_INTEGER,
|
||||
IOCALL_X_INTEGER_WRITE,
|
||||
IOCALL_X_LOGICAL,
|
||||
IOCALL_X_LOGICAL_WRITE,
|
||||
IOCALL_X_CHARACTER,
|
||||
IOCALL_X_CHARACTER_WRITE,
|
||||
IOCALL_X_CHARACTER_WIDE,
|
||||
IOCALL_X_CHARACTER_WIDE_WRITE,
|
||||
IOCALL_X_REAL,
|
||||
IOCALL_X_REAL_WRITE,
|
||||
IOCALL_X_COMPLEX,
|
||||
IOCALL_X_COMPLEX_WRITE,
|
||||
IOCALL_X_ARRAY,
|
||||
IOCALL_X_ARRAY_WRITE,
|
||||
IOCALL_OPEN,
|
||||
IOCALL_CLOSE,
|
||||
IOCALL_INQUIRE,
|
||||
@ -303,9 +310,7 @@ gfc_build_io_library_fndecls (void)
|
||||
for (ptype = IOPARM_ptype_common; ptype < IOPARM_ptype_num; ptype++)
|
||||
gfc_build_st_parameter ((enum ioparam_type) ptype, types);
|
||||
|
||||
/* Define the transfer functions.
|
||||
TODO: Split them between READ and WRITE to allow further
|
||||
optimizations, e.g. by using aliases? */
|
||||
/* Define the transfer functions. */
|
||||
|
||||
dt_parm_type = build_pointer_type (st_parameter[IOPARM_ptype_dt].type);
|
||||
|
||||
@ -313,32 +318,63 @@ gfc_build_io_library_fndecls (void)
|
||||
get_identifier (PREFIX("transfer_integer")), ".wW",
|
||||
void_type_node, 3, dt_parm_type, pvoid_type_node, gfc_int4_type_node);
|
||||
|
||||
iocall[IOCALL_X_INTEGER_WRITE] = gfc_build_library_function_decl_with_spec (
|
||||
get_identifier (PREFIX("transfer_integer_write")), ".wR",
|
||||
void_type_node, 3, dt_parm_type, pvoid_type_node, gfc_int4_type_node);
|
||||
|
||||
iocall[IOCALL_X_LOGICAL] = gfc_build_library_function_decl_with_spec (
|
||||
get_identifier (PREFIX("transfer_logical")), ".wW",
|
||||
void_type_node, 3, dt_parm_type, pvoid_type_node, gfc_int4_type_node);
|
||||
|
||||
iocall[IOCALL_X_LOGICAL_WRITE] = gfc_build_library_function_decl_with_spec (
|
||||
get_identifier (PREFIX("transfer_logical_write")), ".wR",
|
||||
void_type_node, 3, dt_parm_type, pvoid_type_node, gfc_int4_type_node);
|
||||
|
||||
iocall[IOCALL_X_CHARACTER] = gfc_build_library_function_decl_with_spec (
|
||||
get_identifier (PREFIX("transfer_character")), ".wW",
|
||||
void_type_node, 3, dt_parm_type, pvoid_type_node, gfc_int4_type_node);
|
||||
|
||||
iocall[IOCALL_X_CHARACTER_WRITE] = gfc_build_library_function_decl_with_spec (
|
||||
get_identifier (PREFIX("transfer_character_write")), ".wR",
|
||||
void_type_node, 3, dt_parm_type, pvoid_type_node, gfc_int4_type_node);
|
||||
|
||||
iocall[IOCALL_X_CHARACTER_WIDE] = gfc_build_library_function_decl_with_spec (
|
||||
get_identifier (PREFIX("transfer_character_wide")), ".wW",
|
||||
void_type_node, 4, dt_parm_type, pvoid_type_node,
|
||||
gfc_charlen_type_node, gfc_int4_type_node);
|
||||
|
||||
iocall[IOCALL_X_CHARACTER_WIDE_WRITE] =
|
||||
gfc_build_library_function_decl_with_spec (
|
||||
get_identifier (PREFIX("transfer_character_wide_write")), ".wR",
|
||||
void_type_node, 4, dt_parm_type, pvoid_type_node,
|
||||
gfc_charlen_type_node, gfc_int4_type_node);
|
||||
|
||||
iocall[IOCALL_X_REAL] = gfc_build_library_function_decl_with_spec (
|
||||
get_identifier (PREFIX("transfer_real")), ".wW",
|
||||
void_type_node, 3, dt_parm_type, pvoid_type_node, gfc_int4_type_node);
|
||||
|
||||
iocall[IOCALL_X_REAL_WRITE] = gfc_build_library_function_decl_with_spec (
|
||||
get_identifier (PREFIX("transfer_real_write")), ".wR",
|
||||
void_type_node, 3, dt_parm_type, pvoid_type_node, gfc_int4_type_node);
|
||||
|
||||
iocall[IOCALL_X_COMPLEX] = gfc_build_library_function_decl_with_spec (
|
||||
get_identifier (PREFIX("transfer_complex")), ".wW",
|
||||
void_type_node, 3, dt_parm_type, pvoid_type_node, gfc_int4_type_node);
|
||||
|
||||
iocall[IOCALL_X_COMPLEX_WRITE] = gfc_build_library_function_decl_with_spec (
|
||||
get_identifier (PREFIX("transfer_complex_write")), ".wR",
|
||||
void_type_node, 3, dt_parm_type, pvoid_type_node, gfc_int4_type_node);
|
||||
|
||||
iocall[IOCALL_X_ARRAY] = gfc_build_library_function_decl_with_spec (
|
||||
get_identifier (PREFIX("transfer_array")), ".wW",
|
||||
void_type_node, 4, dt_parm_type, pvoid_type_node,
|
||||
integer_type_node, gfc_charlen_type_node);
|
||||
|
||||
iocall[IOCALL_X_ARRAY_WRITE] = gfc_build_library_function_decl_with_spec (
|
||||
get_identifier (PREFIX("transfer_array_write")), ".wr",
|
||||
void_type_node, 4, dt_parm_type, pvoid_type_node,
|
||||
integer_type_node, gfc_charlen_type_node);
|
||||
|
||||
/* Library entry points */
|
||||
|
||||
iocall[IOCALL_READ] = gfc_build_library_function_decl_with_spec (
|
||||
@ -2037,22 +2073,38 @@ transfer_expr (gfc_se * se, gfc_typespec * ts, tree addr_expr, gfc_code * code)
|
||||
{
|
||||
case BT_INTEGER:
|
||||
arg2 = build_int_cst (NULL_TREE, kind);
|
||||
function = iocall[IOCALL_X_INTEGER];
|
||||
if (last_dt == READ)
|
||||
function = iocall[IOCALL_X_INTEGER];
|
||||
else
|
||||
function = iocall[IOCALL_X_INTEGER_WRITE];
|
||||
|
||||
break;
|
||||
|
||||
case BT_REAL:
|
||||
arg2 = build_int_cst (NULL_TREE, kind);
|
||||
function = iocall[IOCALL_X_REAL];
|
||||
if (last_dt == READ)
|
||||
function = iocall[IOCALL_X_REAL];
|
||||
else
|
||||
function = iocall[IOCALL_X_REAL_WRITE];
|
||||
|
||||
break;
|
||||
|
||||
case BT_COMPLEX:
|
||||
arg2 = build_int_cst (NULL_TREE, kind);
|
||||
function = iocall[IOCALL_X_COMPLEX];
|
||||
if (last_dt == READ)
|
||||
function = iocall[IOCALL_X_COMPLEX];
|
||||
else
|
||||
function = iocall[IOCALL_X_COMPLEX_WRITE];
|
||||
|
||||
break;
|
||||
|
||||
case BT_LOGICAL:
|
||||
arg2 = build_int_cst (NULL_TREE, kind);
|
||||
function = iocall[IOCALL_X_LOGICAL];
|
||||
if (last_dt == READ)
|
||||
function = iocall[IOCALL_X_LOGICAL];
|
||||
else
|
||||
function = iocall[IOCALL_X_LOGICAL_WRITE];
|
||||
|
||||
break;
|
||||
|
||||
case BT_CHARACTER:
|
||||
@ -2069,7 +2121,11 @@ transfer_expr (gfc_se * se, gfc_typespec * ts, tree addr_expr, gfc_code * code)
|
||||
arg2 = fold_convert (gfc_charlen_type_node, arg2);
|
||||
}
|
||||
arg3 = build_int_cst (NULL_TREE, kind);
|
||||
function = iocall[IOCALL_X_CHARACTER_WIDE];
|
||||
if (last_dt == READ)
|
||||
function = iocall[IOCALL_X_CHARACTER_WIDE];
|
||||
else
|
||||
function = iocall[IOCALL_X_CHARACTER_WIDE_WRITE];
|
||||
|
||||
tmp = gfc_build_addr_expr (NULL_TREE, dt_parm);
|
||||
tmp = build_call_expr_loc (input_location,
|
||||
function, 4, tmp, addr_expr, arg2, arg3);
|
||||
@ -2088,7 +2144,11 @@ transfer_expr (gfc_se * se, gfc_typespec * ts, tree addr_expr, gfc_code * code)
|
||||
gcc_assert (TREE_CODE (TREE_TYPE (tmp)) == ARRAY_TYPE);
|
||||
arg2 = TYPE_MAX_VALUE (TYPE_DOMAIN (TREE_TYPE (tmp)));
|
||||
}
|
||||
function = iocall[IOCALL_X_CHARACTER];
|
||||
if (last_dt == READ)
|
||||
function = iocall[IOCALL_X_CHARACTER];
|
||||
else
|
||||
function = iocall[IOCALL_X_CHARACTER_WRITE];
|
||||
|
||||
break;
|
||||
|
||||
case BT_DERIVED:
|
||||
@ -2139,7 +2199,7 @@ transfer_expr (gfc_se * se, gfc_typespec * ts, tree addr_expr, gfc_code * code)
|
||||
static void
|
||||
transfer_array_desc (gfc_se * se, gfc_typespec * ts, tree addr_expr)
|
||||
{
|
||||
tree tmp, charlen_arg, kind_arg;
|
||||
tree tmp, charlen_arg, kind_arg, io_call;
|
||||
|
||||
if (ts->type == BT_CHARACTER)
|
||||
charlen_arg = se->string_length;
|
||||
@ -2149,8 +2209,13 @@ transfer_array_desc (gfc_se * se, gfc_typespec * ts, tree addr_expr)
|
||||
kind_arg = build_int_cst (NULL_TREE, ts->kind);
|
||||
|
||||
tmp = gfc_build_addr_expr (NULL_TREE, dt_parm);
|
||||
if (last_dt == READ)
|
||||
io_call = iocall[IOCALL_X_ARRAY];
|
||||
else
|
||||
io_call = iocall[IOCALL_X_ARRAY_WRITE];
|
||||
|
||||
tmp = build_call_expr_loc (UNKNOWN_LOCATION,
|
||||
iocall[IOCALL_X_ARRAY], 4,
|
||||
io_call, 4,
|
||||
tmp, addr_expr, kind_arg, charlen_arg);
|
||||
gfc_add_expr_to_block (&se->pre, tmp);
|
||||
gfc_add_block_to_block (&se->pre, &se->post);
|
||||
|
||||
@ -1,3 +1,25 @@
|
||||
2010-10-16 Thomas Koenig <tkoenig@gcc.gnu.org>
|
||||
|
||||
PR fortran/20165
|
||||
PR fortran/31593
|
||||
PR fortran/43665
|
||||
* gfortran.map: Add _gfortran_transfer_array_write,
|
||||
_gfortran_transfer_array_write, _gfortran_transfer_character_write,
|
||||
_gfortran_transfer_character_wide_write,
|
||||
_gfortran_transfer_complex_write,
|
||||
_gfortran_transfer_integer_write,
|
||||
_gfortran_transfer_logical_write and
|
||||
_gfortran_transfer_real_write.
|
||||
* io/transfer.c (transfer_integer_write): Add prototype and
|
||||
function body as call to the original function, without the
|
||||
_write.
|
||||
(transfer_real_write): Likewise.
|
||||
(transfer_logical_write): Likewise.
|
||||
(transfer_character_write): Likewise.
|
||||
(transfer_character_wide_write): Likewise.
|
||||
(transfer_complex_write): Likewise.
|
||||
(transfer_array_write): Likewise.
|
||||
|
||||
2010-09-22 Jerry DeLisle <jvdelisle@gcc.gnu.org>
|
||||
|
||||
PR libfortran/45710
|
||||
|
||||
@ -1141,6 +1141,13 @@ GFORTRAN_1.4 {
|
||||
_gfortran_parity_l8;
|
||||
_gfortran_parity_l16;
|
||||
_gfortran_selected_real_kind2008;
|
||||
_gfortran_transfer_array_write;
|
||||
_gfortran_transfer_character_write;
|
||||
_gfortran_transfer_character_wide_write;
|
||||
_gfortran_transfer_complex_write;
|
||||
_gfortran_transfer_integer_write;
|
||||
_gfortran_transfer_logical_write;
|
||||
_gfortran_transfer_real_write;
|
||||
} GFORTRAN_1.3;
|
||||
|
||||
F2C_1.0 {
|
||||
|
||||
@ -67,25 +67,48 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
|
||||
extern void transfer_integer (st_parameter_dt *, void *, int);
|
||||
export_proto(transfer_integer);
|
||||
|
||||
extern void transfer_integer_write (st_parameter_dt *, void *, int);
|
||||
export_proto(transfer_integer_write);
|
||||
|
||||
extern void transfer_real (st_parameter_dt *, void *, int);
|
||||
export_proto(transfer_real);
|
||||
|
||||
extern void transfer_real_write (st_parameter_dt *, void *, int);
|
||||
export_proto(transfer_real_write);
|
||||
|
||||
extern void transfer_logical (st_parameter_dt *, void *, int);
|
||||
export_proto(transfer_logical);
|
||||
|
||||
extern void transfer_logical_write (st_parameter_dt *, void *, int);
|
||||
export_proto(transfer_logical_write);
|
||||
|
||||
extern void transfer_character (st_parameter_dt *, void *, int);
|
||||
export_proto(transfer_character);
|
||||
|
||||
extern void transfer_character_write (st_parameter_dt *, void *, int);
|
||||
export_proto(transfer_character_write);
|
||||
|
||||
extern void transfer_character_wide (st_parameter_dt *, void *, int, int);
|
||||
export_proto(transfer_character_wide);
|
||||
|
||||
extern void transfer_character_wide_write (st_parameter_dt *,
|
||||
void *, int, int);
|
||||
export_proto(transfer_character_wide_write);
|
||||
|
||||
extern void transfer_complex (st_parameter_dt *, void *, int);
|
||||
export_proto(transfer_complex);
|
||||
|
||||
extern void transfer_complex_write (st_parameter_dt *, void *, int);
|
||||
export_proto(transfer_complex_write);
|
||||
|
||||
extern void transfer_array (st_parameter_dt *, gfc_array_char *, int,
|
||||
gfc_charlen_type);
|
||||
export_proto(transfer_array);
|
||||
|
||||
extern void transfer_array_write (st_parameter_dt *, gfc_array_char *, int,
|
||||
gfc_charlen_type);
|
||||
export_proto(transfer_array_write);
|
||||
|
||||
static void us_read (st_parameter_dt *, int);
|
||||
static void us_write (st_parameter_dt *, int);
|
||||
static void next_record_r_unf (st_parameter_dt *, int);
|
||||
@ -1847,6 +1870,11 @@ transfer_integer (st_parameter_dt *dtp, void *p, int kind)
|
||||
dtp->u.p.transfer (dtp, BT_INTEGER, p, kind, kind, 1);
|
||||
}
|
||||
|
||||
void
|
||||
transfer_integer_write (st_parameter_dt *dtp, void *p, int kind)
|
||||
{
|
||||
transfer_integer (dtp, p, kind);
|
||||
}
|
||||
|
||||
void
|
||||
transfer_real (st_parameter_dt *dtp, void *p, int kind)
|
||||
@ -1858,6 +1886,11 @@ transfer_real (st_parameter_dt *dtp, void *p, int kind)
|
||||
dtp->u.p.transfer (dtp, BT_REAL, p, kind, size, 1);
|
||||
}
|
||||
|
||||
void
|
||||
transfer_real_write (st_parameter_dt *dtp, void *p, int kind)
|
||||
{
|
||||
transfer_real (dtp, p, kind);
|
||||
}
|
||||
|
||||
void
|
||||
transfer_logical (st_parameter_dt *dtp, void *p, int kind)
|
||||
@ -1867,6 +1900,11 @@ transfer_logical (st_parameter_dt *dtp, void *p, int kind)
|
||||
dtp->u.p.transfer (dtp, BT_LOGICAL, p, kind, kind, 1);
|
||||
}
|
||||
|
||||
void
|
||||
transfer_logical_write (st_parameter_dt *dtp, void *p, int kind)
|
||||
{
|
||||
transfer_logical (dtp, p, kind);
|
||||
}
|
||||
|
||||
void
|
||||
transfer_character (st_parameter_dt *dtp, void *p, int len)
|
||||
@ -1886,6 +1924,12 @@ transfer_character (st_parameter_dt *dtp, void *p, int len)
|
||||
dtp->u.p.transfer (dtp, BT_CHARACTER, p, 1, len, 1);
|
||||
}
|
||||
|
||||
void
|
||||
transfer_character_write (st_parameter_dt *dtp, void *p, int len)
|
||||
{
|
||||
transfer_character (dtp, p, len);
|
||||
}
|
||||
|
||||
void
|
||||
transfer_character_wide (st_parameter_dt *dtp, void *p, int len, int kind)
|
||||
{
|
||||
@ -1904,6 +1948,11 @@ transfer_character_wide (st_parameter_dt *dtp, void *p, int len, int kind)
|
||||
dtp->u.p.transfer (dtp, BT_CHARACTER, p, kind, len, 1);
|
||||
}
|
||||
|
||||
void
|
||||
transfer_character_wide_write (st_parameter_dt *dtp, void *p, int len, int kind)
|
||||
{
|
||||
transfer_character_wide (dtp, p, len, kind);
|
||||
}
|
||||
|
||||
void
|
||||
transfer_complex (st_parameter_dt *dtp, void *p, int kind)
|
||||
@ -1915,6 +1964,11 @@ transfer_complex (st_parameter_dt *dtp, void *p, int kind)
|
||||
dtp->u.p.transfer (dtp, BT_COMPLEX, p, kind, size, 1);
|
||||
}
|
||||
|
||||
void
|
||||
transfer_complex_write (st_parameter_dt *dtp, void *p, int kind)
|
||||
{
|
||||
transfer_complex (dtp, p, kind);
|
||||
}
|
||||
|
||||
void
|
||||
transfer_array (st_parameter_dt *dtp, gfc_array_char *desc, int kind,
|
||||
@ -2020,6 +2074,12 @@ transfer_array (st_parameter_dt *dtp, gfc_array_char *desc, int kind,
|
||||
}
|
||||
}
|
||||
|
||||
void
|
||||
transfer_array_write (st_parameter_dt *dtp, gfc_array_char *desc, int kind,
|
||||
gfc_charlen_type charlen)
|
||||
{
|
||||
transfer_array (dtp, desc, kind, charlen);
|
||||
}
|
||||
|
||||
/* Preposition a sequential unformatted file while reading. */
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user