This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[patch, fortran, RFC] Separate READ from WRITE
- From: Thomas Koenig <tkoenig at netcologne dot de>
- To: fortran at gcc dot gnu dot org
- Cc: gcc-patches at gcc dot gnu dot org
- Date: Sun, 10 Oct 2010 19:23:09 +0200
- Subject: [patch, fortran, RFC] Separate READ from WRITE
Hello world,
this RFC patch separates reads from writes in Fortran, by establishing
separate transfer functions for writing, with a different spec. For
now, the write functions just call the original transfer functions, with
the spec making all the difference.
Do you think this is the right approach? Did I get the specs right (I
didn't find any documentation, but I may have missed something)?
This does speed up the test case from PR 31593, and should also at least
partially fix PR 20165.
No changelog yet, and a test case probably isn't needed. I'm currently
regression-testing. If there is general agreement, I think this could
still go into 4.6.
Comments? Other/better ideas?
Thomas
Index: libgfortran/gfortran.map
===================================================================
--- libgfortran/gfortran.map (Revision 165124)
+++ libgfortran/gfortran.map (Arbeitskopie)
@@ -1141,6 +1141,12 @@
_gfortran_parity_l8;
_gfortran_parity_l16;
_gfortran_selected_real_kind2008;
+ _gfortran_transfer_array_write;
+ _gfortran_transfer_character_write;
+ _gfortran_transfer_complex_write;
+ _gfortran_transfer_integer_write;
+ _gfortran_transfer_logical_write;
+ _gfortran_transfer_real_write;
} GFORTRAN_1.3;
F2C_1.0 {
Index: libgfortran/io/transfer.c
===================================================================
--- libgfortran/io/transfer.c (Revision 165124)
+++ libgfortran/io/transfer.c (Arbeitskopie)
@@ -67,25 +67,48 @@
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 @@
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 @@
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 @@
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)
@@ -1887,6 +1925,12 @@
}
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)
{
static char *empty_string[0];
@@ -1904,6 +1948,11 @@
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 @@
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 @@
}
}
+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. */
Index: gcc/fortran/trans-io.c
===================================================================
--- gcc/fortran/trans-io.c (Revision 165124)
+++ gcc/fortran/trans-io.c (Arbeitskopie)
@@ -115,12 +115,19 @@
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 @@
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 @@
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")), ".rW",
+ 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")), ".rW",
+ 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")), ".rW",
+ 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")), ".rW",
+ 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")), ".rW",
+ 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")), ".rW",
+ 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")), ".rW",
+ 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 @@
{
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 @@
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 @@
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 @@
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 @@
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);