diff mbox

[fortran] Separate READ from WRITE

Message ID 1286822512.3841.7.camel@linux-fd1f.site
State New
Headers show

Commit Message

Thomas Koenig Oct. 11, 2010, 6:41 p.m. UTC 
Well, feedback seems to have been positive, so here is the formal patch
with a proper changelog entry.

I agree we should be separating the read and write functions at a later
date, probably for 4.7.

The additional overhead generated by the wrapper functions is small; in
my build, either the actual function is inlined or the tail call is
turned into a single jump.

OK for trunk?

	Thomas

2010-10-11  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-11  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.

Comments

Tobias Burnus Oct. 11, 2010, 6:57 p.m. UTC | #1 
Thomas Koenig wrote:
> Well, feedback seems to have been positive, so here is the formal patch
> with a proper changelog entry.

No review yet but:

    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);
+


I think one also needs to update the "fn spec" for "transfer_logical" 
besides adding "transfer_logical_write". I am also a bit lost whether 
".rW" is correct - I always get confused which argument is for what and 
whether some status is also updated in dtp or whether it only contains 
the internal-I/O string and the format string. I had expected that the 
fn-spec should be ".wR" for WRITE, i.e. that the dtp might be written to 
(for internal I/O) but that the second argument is only read from (R). 
While for READ, I would expect the ".rW" which your patch has for 
transfer_logical_write (assuming that no status is returned via dtp 
during a transfer call).

Tobias
Tobias Burnus Oct. 12, 2010, 8:58 a.m. UTC | #2 
On 10/11/2010 08:57 PM, Tobias Burnus wrote:
>  Thomas Koenig wrote:
>> Well, feedback seems to have been positive, so here is the formal patch
>> with a proper changelog entry.
>
> No review yet but:
>
>    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);
> +

I looked at libgfortran/io/transfer.c and both 
formatted_transfer_scalar_read and -_write contain a like like:
   dtp->u.p.sf_read_comma =
     dtp->u.p.current_unit->decimal_status == DECIMAL_COMMA ? 0 : 1;

Thus, I think the first argument should be "w" (i.e. the attribute 
should start with ".w"). However, I have still the feeling that READ and 
thus transfer_logical should have ".wW" (as it is now) while WRITE 
should have ".wR" (and not ".rW"). Recall in that the first item in the 
string (".") skips over the *return value* (which here is "void"). The 
last argument (int4 len) has no spec as it is passed by value and thus 
does not need a fn-spec. (One could use ".wW." or ".wWR" but the last 
character in the string would just waste CPU cycles (in the ME) and at 
least a byte ;-)

Tobias
Jerry DeLisle Oct. 12, 2010, 1:52 p.m. UTC | #3 
On 10/12/2010 01:58 AM, Tobias Burnus wrote:
> On 10/11/2010 08:57 PM, Tobias Burnus wrote:
>> Thomas Koenig wrote:
>>> Well, feedback seems to have been positive, so here is the formal patch
>>> with a proper changelog entry.
>>
>> No review yet but:
>>
>> 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);
>> +
>
> I looked at libgfortran/io/transfer.c and both formatted_transfer_scalar_read
> and -_write contain a like like:
> dtp->u.p.sf_read_comma =
> dtp->u.p.current_unit->decimal_status == DECIMAL_COMMA ? 0 : 1;

I don't know if this is relevant but parameters within the current_unit 
structure can and do get modified by read and write functions. Bits within the 
"common" structure get modified at run time by the error and iostat, err, end, 
eor events, but are not used from one IO call to the next. They are checked by 
series of calls between st_write/read and st_write_done/read_done to check 
library status as the various transfers proceed.

I am wondering as part of the ABI cleanup, should we isolate the function 
arguments so that it is clear which ones get modified and which do not?

Jerry
diff mbox

Patch

Index: libgfortran/gfortran.map
===================================================================
--- libgfortran/gfortran.map	(Revision 165124)
+++ libgfortran/gfortran.map	(Arbeitskopie)
@@ -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 {
Index: libgfortran/io/transfer.c
===================================================================
--- libgfortran/io/transfer.c	(Revision 165124)
+++ libgfortran/io/transfer.c	(Arbeitskopie)
@@ -67,25 +67,48 @@  see the files COPYING3 and COPYING.RUNTIME respect
 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, i
   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
   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, i
   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 @@  transfer_character (st_parameter_dt *dtp, void *p,
 }
 
 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 @@  transfer_character_wide (st_parameter_dt *dtp, voi
   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, i
   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_ch
     }
 }
 
+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 @@  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")), ".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 @@  transfer_expr (gfc_se * se, gfc_typespec * ts, tre
     {
     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, tre
 	      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, tre
 	  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, tre
 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 * t
   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);