Patchwork [fortran] Separate READ from WRITE

login
register
mail settings
Submitter Thomas Koenig
Date Oct. 12, 2010, 10:10 p.m.
Message ID <1286921431.6440.28.camel@linux-fd1f.site>
Download mbox | patch
Permalink /patch/67629/
State New
Headers show

Comments

Thomas Koenig - Oct. 12, 2010, 10:10 p.m.
Hi Tobias,

> 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 

After having read the source in tree.h, I concur.  

Here's the updated patch; currently regression-testing. Note the small
"r" for the array transfer.

OK if it passes?  I'll only be able to commit this on the weekend, due
to business travel.

	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.
Tobias Burnus - Oct. 13, 2010, 6:45 a.m.
On 10/13/2010 12:10 AM, Thomas Koenig wrote:
> Here's the updated patch [...]
> OK if it passes?

OK. Thanks for  the patch!

Tobias

> 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.
Thomas Koenig - Oct. 16, 2010, 4:07 p.m.
Am Mittwoch, den 13.10.2010, 08:45 +0200 schrieb Tobias Burnus:
>   On 10/13/2010 12:10 AM, Thomas Koenig wrote:
> > Here's the updated patch [...]
> > OK if it passes?
> 
> OK. Thanks for  the patch!

Sende          gcc/fortran/ChangeLog
Sende          gcc/fortran/trans-io.c
Sende          libgfortran/ChangeLog
Sende          libgfortran/gfortran.map
Sende          libgfortran/io/transfer.c
├ťbertrage Daten .....
Revision 165559 ├╝bertragen.

Thanks for the review!

	Thomas

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")), ".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, 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);