[multiple changes]

2005-09-24  Janne Blomqvist  <jblomqvi@cc.hut.fi>

	* trans-io.c (gfc_build_io_library_fndecls): Add entry
	iocall_x_array for transfer_array. (transfer_array_desc): New
	function. (gfc_trans_transfer): Add code to call
	transfer_array_desc.

2005-09-24  Janne Blomqvist <jblomqvi@cc.hut.fi>

	* io.h: Changed prototypes of list_formatted_{read|write}.
	* list_read.c (list_formatted_read): Renamed to
	list_formatted_read_scalar and made static. (list_formatted_read):
	New function.
	* transfer.c: Prototype for transfer_array. Changed transfer
	function pointer. (unformatted_read): Add nelems argument, use
	it. (unformatted_write): Likewise. (formatted_transfer): Changed
	name to formatted_transfer_scalar. (formatted_transfer): New
	function. (transfer_integer): Add nelems argument to transfer
	call, move updating item count to transfer
	functions. (transfer_real): Likewise. (transfer_logical):
	Likewise. (transfer_character): Likewise. (transfer_complex):
	Likewise. (transfer_array): New function. (data_transfer_init):
	Call formatted_transfer with new argument. (iolength_transfer):
	New argument, use it.
	* write.c (list_formatted_write): Renamed to
	list_formatted_write_scalar, made static. (list_formatted_write):
	New function.

From-SVN: r104662

1 files changed, 44 insertions, 6 deletions

diff --git a/gcc/fortran/trans-io.c b/gcc/fortran/trans-io.c
index 41f4ae8..2c8a9cd 100644
--- a/gcc/fortran/trans-io.c
+++ b/gcc/fortran/trans-io.c
@@ -120,6 +120,7 @@ static GTY(()) tree iocall_x_logical;
 static GTY(()) tree iocall_x_character;
 static GTY(()) tree iocall_x_real;
 static GTY(()) tree iocall_x_complex;
+static GTY(()) tree iocall_x_array;
 static GTY(()) tree iocall_open;
 static GTY(()) tree iocall_close;
 static GTY(()) tree iocall_inquire;
@@ -267,6 +268,12 @@ gfc_build_io_library_fndecls (void)
 				     void_type_node, 2, pvoid_type_node,
 				     gfc_int4_type_node);
 
+  iocall_x_array =
+    gfc_build_library_function_decl (get_identifier
+				     (PREFIX("transfer_array")),
+				     void_type_node, 2, pvoid_type_node,
+				     gfc_charlen_type_node);
+
   /* Library entry points */
 
   iocall_read =
@@ -1584,6 +1591,27 @@ transfer_expr (gfc_se * se, gfc_typespec * ts, tree addr_expr)
 }
 
 
+/* Generate a call to pass an array descriptor to the IO library. The
+   array should be of one of the intrinsic types.  */
+
+static void
+transfer_array_desc (gfc_se * se, gfc_typespec * ts, tree addr_expr)
+{
+  tree args, tmp, charlen_arg;
+
+  if (ts->type == BT_CHARACTER)
+    charlen_arg = se->string_length;
+  else
+    charlen_arg = build_int_cstu (NULL_TREE, 0);
+
+  args = gfc_chainon_list (NULL_TREE, addr_expr);
+  args = gfc_chainon_list (args, charlen_arg);
+  tmp = gfc_build_function_call (iocall_x_array, args);
+  gfc_add_expr_to_block (&se->pre, tmp);
+  gfc_add_block_to_block (&se->pre, &se->post);
+}
+
+
 /* gfc_trans_transfer()-- Translate a TRANSFER code node */
 
 tree
@@ -1597,6 +1625,7 @@ gfc_trans_transfer (gfc_code * code)
   tree tmp;
 
   gfc_start_block (&block);
+  gfc_init_block (&body);
 
   expr = code->expr;
   ss = gfc_walk_expr (expr);
@@ -1604,8 +1633,11 @@ gfc_trans_transfer (gfc_code * code)
   gfc_init_se (&se, NULL);
 
   if (ss == gfc_ss_terminator)
-    gfc_init_block (&body);
-  else
+    {
+      gfc_conv_expr_reference (&se, expr);
+      transfer_expr (&se, &expr->ts, se.expr);
+    }
+  else if (expr->ts.type == BT_DERIVED)
     {
       /* Initialize the scalarizer.  */
       gfc_init_loopinfo (&loop);
@@ -1621,11 +1653,17 @@ gfc_trans_transfer (gfc_code * code)
 
       gfc_copy_loopinfo_to_se (&se, &loop);
       se.ss = ss;
-    }
-
-  gfc_conv_expr_reference (&se, expr);
 
-  transfer_expr (&se, &expr->ts, se.expr);
+      gfc_conv_expr_reference (&se, expr);
+      transfer_expr (&se, &expr->ts, se.expr);
+    }
+  else
+    {
+      /* Pass the array descriptor to the library.  */
+      gfc_conv_expr_descriptor (&se, expr, ss);
+      tmp = gfc_build_addr_expr (NULL, se.expr);
+      transfer_array_desc (&se, &expr->ts, tmp);
+    }
 
   gfc_add_block_to_block (&body, &se.pre);
   gfc_add_block_to_block (&body, &se.post);