Reverting 'AsyncI/O patch committed' as it is breaking bare-metal builds.

2018-07-31  Andre Vieira  <andre.simoesdiasvieira@arm.com>

	Revert 'AsyncI/O patch committed'
	2018-07-25  Nicolas Koenig  <koenigni@gcc.gnu.org>
		Thomas Koenig <tkoenig@gcc.gnu.org>

	PR fortran/25829
	* gfortran.texi: Add description of asynchronous I/O.
	* trans-decl.c (gfc_finish_var_decl): Treat asynchronous variables
	as volatile.
	* trans-io.c (gfc_build_io_library_fndecls): Rename st_wait to
	st_wait_async and change argument spec from ".X" to ".w".
	(gfc_trans_wait): Pass ID argument via reference.

2018-07-31  Andre Vieira  <andre.simoesdiasvieira@arm.com>

	Revert 'AsyncI/O patch committed'
	2018-07-25  Nicolas Koenig  <koenigni@gcc.gnu.org>
		Thomas Koenig <tkoenig@gcc.gnu.org>

	PR fortran/25829
	* gfortran.dg/f2003_inquire_1.f03: Add write statement.
	* gfortran.dg/f2003_io_1.f03: Add wait statement.

2018-07-31  Andre Vieira  <andre.simoesdiasvieira@arm.com>

	Revert 'AsyncI/O patch committed'
	2018-07-25  Nicolas Koenig  <koenigni@gcc.gnu.org>
		Thomas Koenig <tkoenig@gcc.gnu.org>

	PR fortran/25829
	* Makefile.am: Add async.c to gfor_io_src.
	Add async.h to gfor_io_headers.
	* Makefile.in: Regenerated.
	* gfortran.map: Add _gfortran_st_wait_async.
	* io/async.c: New file.
	* io/async.h: New file.
	* io/close.c: Include async.h.
	(st_close): Call async_wait for an asynchronous unit.
	* io/file_pos.c (st_backspace): Likewise.
	(st_endfile): Likewise.
	(st_rewind): Likewise.
	(st_flush): Likewise.
	* io/inquire.c: Add handling for asynchronous PENDING
	and ID arguments.
	* io/io.h (st_parameter_dt): Add async bit.
	(st_parameter_wait): Correct.
	(gfc_unit): Add au pointer.
	(st_wait_async): Add prototype.
	(transfer_array_inner): Likewise.
	(st_write_done_worker): Likewise.
	* io/open.c: Include async.h.
	(new_unit): Initialize asynchronous unit.
	* io/transfer.c (async_opt): New struct.
	(wrap_scalar_transfer): New function.
	(transfer_integer): Call wrap_scalar_transfer to do the work.
	(transfer_real): Likewise.
	(transfer_real_write): Likewise.
	(transfer_character): Likewise.
	(transfer_character_wide): Likewise.
	(transfer_complex): Likewise.
	(transfer_array_inner): New function.
	(transfer_array): Call transfer_array_inner.
	(transfer_derived): Call wrap_scalar_transfer.
	(data_transfer_init): Check for asynchronous I/O.
	Perform a wait operation on any pending asynchronous I/O
	if the data transfer is synchronous. Copy PDT and enqueue
	thread for data transfer.
	(st_read_done_worker): New function.
	(st_read_done): Enqueue transfer or call st_read_done_worker.
	(st_write_done_worker): New function.
	(st_write_done): Enqueue transfer or call st_read_done_worker.
	(st_wait): Document as no-op for compatibility reasons.
	(st_wait_async): New function.
	* io/unit.c (insert_unit): Use macros LOCK, UNLOCK and TRYLOCK;
	add NOTE where necessary.
	(get_gfc_unit): Likewise.
	(init_units): Likewise.
	(close_unit_1): Likewise. Call async_close if asynchronous.
	(close_unit): Use macros LOCK and UNLOCK.
	(finish_last_advance_record): Likewise.
	(newunit_alloc): Likewise.
	* io/unix.c (find_file): Likewise.
	(flush_all_units_1): Likewise.
	(flush_all_units): Likewise.
	* libgfortran.h (generate_error_common): Add prototype.
	* runtime/error.c: Include io.h and async.h.
	(generate_error_common): New function.

2018-07-31  Andre Vieira  <andre.simoesdiasvieira@arm.com>

	Revert 'AsyncI/O patch committed'.
	2018-07-25  Nicolas Koenig  <koenigni@gcc.gnu.org>
		Thomas Koenig <tkoenig@gcc.gnu.org>

	PR fortran/25829
	* testsuite/libgomp.fortran/async_io_1.f90: New test.
	* testsuite/libgomp.fortran/async_io_2.f90: New test.
	* testsuite/libgomp.fortran/async_io_3.f90: New test.
	* testsuite/libgomp.fortran/async_io_4.f90: New test.
	* testsuite/libgomp.fortran/async_io_5.f90: New test.
	* testsuite/libgomp.fortran/async_io_6.f90: New test.
	* testsuite/libgomp.fortran/async_io_7.f90: New test.

From-SVN: r263082

1 files changed, 57 insertions, 252 deletions

diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c
index fa66e0f..df33bed 100644
--- a/libgfortran/io/transfer.c
+++ b/libgfortran/io/transfer.c
@@ -31,7 +31,6 @@ see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
 #include "fbuf.h"
 #include "format.h"
 #include "unix.h"
-#include "async.h"
 #include <string.h>
 #include <errno.h>
 
@@ -185,12 +184,6 @@ static const st_option pad_opt[] = {
   {NULL, 0}
 };
 
-static const st_option async_opt[] = {
-  {"yes", ASYNC_YES},
-  {"no", ASYNC_NO},
-  {NULL, 0}
-};
-
 typedef enum
 { FORMATTED_SEQUENTIAL, UNFORMATTED_SEQUENTIAL,
   FORMATTED_DIRECT, UNFORMATTED_DIRECT, FORMATTED_STREAM, UNFORMATTED_STREAM
@@ -1601,8 +1594,7 @@ formatted_transfer_scalar_read (st_parameter_dt *dtp, bt type, void *p, int kind
 		read_f (dtp, f, p, kind);
 		break;
 	      default:
-		internal_error (&dtp->common,
-				"formatted_transfer (): Bad type");
+		internal_error (&dtp->common, "formatted_transfer(): Bad type");
 	    }
 	  break;
 
@@ -2074,7 +2066,7 @@ formatted_transfer_scalar_write (st_parameter_dt *dtp, bt type, void *p, int kin
 		break;
 	      default:
 		internal_error (&dtp->common,
-				"formatted_transfer (): Bad type");
+				"formatted_transfer(): Bad type");
 	    }
 	  break;
 
@@ -2289,38 +2281,6 @@ formatted_transfer (st_parameter_dt *dtp, bt type, void *p, int kind,
     }
 }
 
-/* Wrapper function for I/O of scalar types.  If this should be an async I/O
-   request, queue it.  For a synchronous write on an async unit, perform the
-   wait operation and return an error.  For all synchronous writes, call the
-   right transfer function.  */
-
-static void
-wrap_scalar_transfer (st_parameter_dt *dtp, bt type, void *p, int kind,
-		      size_t size, size_t n_elem)
-{
-  if (dtp->u.p.current_unit && dtp->u.p.current_unit->au)
-    {
-      if (dtp->u.p.async)
-	{
-	  transfer_args args;
-	  args.scalar.transfer = dtp->u.p.transfer;
-	  args.scalar.arg_bt = type;
-	  args.scalar.data = p;
-	  args.scalar.i = kind;
-	  args.scalar.s1 = size;
-	  args.scalar.s2 = n_elem;
-	  enqueue_transfer (dtp->u.p.current_unit->au, &args,
-			    AIO_TRANSFER_SCALAR);
-	  return;
-	}
-    }
-  /* Come here if there was no asynchronous I/O to be scheduled.  */
-  if ((dtp->common.flags & IOPARM_LIBRETURN_MASK) != IOPARM_LIBRETURN_OK)
-    return;
-
-  dtp->u.p.transfer (dtp, type, p, kind, size, 1);
-}
-
 
 /* Data transfer entry points.  The type of the data entity is
    implicit in the subroutine call.  This prevents us from having to
@@ -2329,7 +2289,9 @@ wrap_scalar_transfer (st_parameter_dt *dtp, bt type, void *p, int kind,
 void
 transfer_integer (st_parameter_dt *dtp, void *p, int kind)
 {
-    wrap_scalar_transfer (dtp, BT_INTEGER, p, kind, kind, 1);
+  if ((dtp->common.flags & IOPARM_LIBRETURN_MASK) != IOPARM_LIBRETURN_OK)
+    return;
+  dtp->u.p.transfer (dtp, BT_INTEGER, p, kind, kind, 1);
 }
 
 void
@@ -2345,7 +2307,7 @@ transfer_real (st_parameter_dt *dtp, void *p, int kind)
   if ((dtp->common.flags & IOPARM_LIBRETURN_MASK) != IOPARM_LIBRETURN_OK)
     return;
   size = size_from_real_kind (kind);
-  wrap_scalar_transfer (dtp, BT_REAL, p, kind, size, 1);
+  dtp->u.p.transfer (dtp, BT_REAL, p, kind, size, 1);
 }
 
 void
@@ -2357,7 +2319,9 @@ transfer_real_write (st_parameter_dt *dtp, void *p, int kind)
 void
 transfer_logical (st_parameter_dt *dtp, void *p, int kind)
 {
-  wrap_scalar_transfer (dtp, BT_LOGICAL, p, kind, kind, 1);
+  if ((dtp->common.flags & IOPARM_LIBRETURN_MASK) != IOPARM_LIBRETURN_OK)
+    return;
+  dtp->u.p.transfer (dtp, BT_LOGICAL, p, kind, kind, 1);
 }
 
 void
@@ -2381,7 +2345,7 @@ transfer_character (st_parameter_dt *dtp, void *p, gfc_charlen_type len)
     p = empty_string;
 
   /* Set kind here to 1.  */
-  wrap_scalar_transfer (dtp, BT_CHARACTER, p, 1, len, 1);
+  dtp->u.p.transfer (dtp, BT_CHARACTER, p, 1, len, 1);
 }
 
 void
@@ -2405,7 +2369,7 @@ transfer_character_wide (st_parameter_dt *dtp, void *p, gfc_charlen_type len, in
     p = empty_string;
 
   /* Here we pass the actual kind value.  */
-  wrap_scalar_transfer (dtp, BT_CHARACTER, p, kind, len, 1);
+  dtp->u.p.transfer (dtp, BT_CHARACTER, p, kind, len, 1);
 }
 
 void
@@ -2421,7 +2385,7 @@ transfer_complex (st_parameter_dt *dtp, void *p, int kind)
   if ((dtp->common.flags & IOPARM_LIBRETURN_MASK) != IOPARM_LIBRETURN_OK)
     return;
   size = size_from_complex_kind (kind);
-  wrap_scalar_transfer (dtp, BT_COMPLEX, p, kind, size, 1);
+  dtp->u.p.transfer (dtp, BT_COMPLEX, p, kind, size, 1);
 }
 
 void
@@ -2431,8 +2395,8 @@ transfer_complex_write (st_parameter_dt *dtp, void *p, int kind)
 }
 
 void
-transfer_array_inner (st_parameter_dt *dtp, gfc_array_char *desc, int kind,
-		      gfc_charlen_type charlen)
+transfer_array (st_parameter_dt *dtp, gfc_array_char *desc, int kind,
+		gfc_charlen_type charlen)
 {
   index_type count[GFC_MAX_DIMENSIONS];
   index_type extent[GFC_MAX_DIMENSIONS];
@@ -2443,7 +2407,7 @@ transfer_array_inner (st_parameter_dt *dtp, gfc_array_char *desc, int kind,
   bt iotype;
 
   /* Adjust item_count before emitting error message.  */
-
+ 
   if ((dtp->common.flags & IOPARM_LIBRETURN_MASK) != IOPARM_LIBRETURN_OK)
     return;
 
@@ -2507,36 +2471,6 @@ transfer_array_inner (st_parameter_dt *dtp, gfc_array_char *desc, int kind,
 }
 
 void
-transfer_array (st_parameter_dt *dtp, gfc_array_char *desc, int kind,
-	        gfc_charlen_type charlen)
-{
-  if ((dtp->common.flags & IOPARM_LIBRETURN_MASK) != IOPARM_LIBRETURN_OK)
-    return;
-
-  if (dtp->u.p.current_unit && dtp->u.p.current_unit->au)
-    {
-      if (dtp->u.p.async)
-	{
-	  transfer_args args;
-	  size_t sz = sizeof (gfc_array_char)
-			+ sizeof (descriptor_dimension)
-       			* GFC_DESCRIPTOR_RANK (desc);
-	  args.array.desc = xmalloc (sz);
-	  NOTE ("desc = %p", (void *) args.array.desc);
-	  memcpy (args.array.desc, desc, sz);
-	  args.array.kind = kind;
-	  args.array.charlen = charlen;
-	  enqueue_transfer (dtp->u.p.current_unit->au, &args,
-			    AIO_TRANSFER_ARRAY);
-	  return;
-	}
-    }
-  /* Come here if there was no asynchronous I/O to be scheduled.  */
-  transfer_array_inner (dtp, desc, kind, charlen);
-}
-
-
-void
 transfer_array_write (st_parameter_dt *dtp, gfc_array_char *desc, int kind,
 		      gfc_charlen_type charlen)
 {
@@ -2558,7 +2492,7 @@ transfer_derived (st_parameter_dt *parent, void *dtio_source, void *dtio_proc)
       else
 	parent->u.p.fdtio_ptr = (formatted_dtio) dtio_proc;
     }
-  wrap_scalar_transfer (parent, BT_CLASS, dtio_source, 0, 0, 1);
+  parent->u.p.transfer (parent, BT_CLASS, dtio_source, 0, 0, 1);
 }
 
 
@@ -2733,9 +2667,6 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag)
   unit_flags u_flags;  /* Used for creating a unit if needed.  */
   GFC_INTEGER_4 cf = dtp->common.flags;
   namelist_info *ionml;
-  async_unit *au;
-
-  NOTE ("data_transfer_init");
 
   ionml = ((cf & IOPARM_DT_IONML_SET) != 0) ? dtp->u.p.ionml : NULL;
 
@@ -2762,9 +2693,9 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag)
     }
   else if (dtp->u.p.current_unit->s == NULL)
     {  /* Open the unit with some default flags.  */
-      st_parameter_open opp;
-      unit_convert conv;
-      NOTE ("Open the unit with some default flags.");
+       st_parameter_open opp;
+       unit_convert conv;
+
       memset (&u_flags, '\0', sizeof (u_flags));
       u_flags.access = ACCESS_SEQUENTIAL;
       u_flags.action = ACTION_READWRITE;
@@ -2839,42 +2770,6 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag)
   else if (dtp->u.p.current_unit->internal_unit_kind > 0)
     dtp->u.p.unit_is_internal = 1;
 
-  if ((cf & IOPARM_DT_HAS_ASYNCHRONOUS) != 0)
-    {
-      int f;
-      f = find_option (&dtp->common, dtp->asynchronous, dtp->asynchronous_len,
-		       async_opt, "Bad ASYNCHRONOUS in data transfer "
-		       "statement");
-      if (f == ASYNC_YES && dtp->u.p.current_unit->flags.async != ASYNC_YES)
-	{
-	  generate_error (&dtp->common, LIBERROR_OPTION_CONFLICT,
-			  "ASYNCHRONOUS transfer without "
-			  "ASYHCRONOUS='YES' in OPEN");
-	  return;
-	}
-      dtp->u.p.async = f == ASYNC_YES;
-    }
-
-  au = dtp->u.p.current_unit->au;
-  if (au)
-    {
-      if (dtp->u.p.async)
-	{
-	  /* If this is an asynchronous I/O statement, collect errors and
-	     return if there are any.  */
-	  if (collect_async_errors (&dtp->common, au))
-	    return;
-	}
-      else
-	{
-	  /* Synchronous statement: Perform a wait operation for any pending
-	     asynchronous I/O.  This needs to be done before all other error
-	     checks.  See F2008, 9.6.4.1.  */
-	  if (async_wait (&(dtp->common), au))
-	    return;
-	}
-    }
-
   /* Check the action.  */
 
   if (read_flag && dtp->u.p.current_unit->flags.action == ACTION_WRITE)
@@ -3114,57 +3009,6 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag)
   if (dtp->u.p.current_unit->pad_status == PAD_UNSPECIFIED)
 	dtp->u.p.current_unit->pad_status = dtp->u.p.current_unit->flags.pad;
 
-  /* Set up the subroutine that will handle the transfers.  */
-
-  if (read_flag)
-    {
-      if (dtp->u.p.current_unit->flags.form == FORM_UNFORMATTED)
-	dtp->u.p.transfer = unformatted_read;
-      else
-	{
-	  if ((cf & IOPARM_DT_LIST_FORMAT) != 0)
-	    dtp->u.p.transfer = list_formatted_read;
-	  else
-	    dtp->u.p.transfer = formatted_transfer;
-	}
-    }
-  else
-    {
-      if (dtp->u.p.current_unit->flags.form == FORM_UNFORMATTED)
-	dtp->u.p.transfer = unformatted_write;
-      else
-	{
-	  if ((cf & IOPARM_DT_LIST_FORMAT) != 0)
-	    dtp->u.p.transfer = list_formatted_write;
-	  else
-	    dtp->u.p.transfer = formatted_transfer;
-	}
-    }
-
-  if (au)
-    {
-      NOTE ("enqueue_data_transfer");
-      enqueue_data_transfer_init (au, dtp, read_flag);
-    }
-  else
-    {
-      NOTE ("invoking data_transfer_init_worker");
-      data_transfer_init_worker (dtp, read_flag);
-    }
-}
-
-void
-data_transfer_init_worker (st_parameter_dt *dtp, int read_flag)
-{
-  GFC_INTEGER_4 cf = dtp->common.flags;
-
-  NOTE ("starting worker...");
-
-  if (read_flag && dtp->u.p.current_unit->flags.form != FORM_UNFORMATTED
-      && ((cf & IOPARM_DT_LIST_FORMAT) != 0)
-      && dtp->u.p.current_unit->child_dtio  == 0)
-    dtp->u.p.current_unit->last_char = EOF - 1;
-
   /* Check to see if we might be reading what we wrote before  */
 
   if (dtp->u.p.mode != dtp->u.p.current_unit->mode
@@ -3291,6 +3135,38 @@ data_transfer_init_worker (st_parameter_dt *dtp, int read_flag)
 
   pre_position (dtp);
 
+
+  /* Set up the subroutine that will handle the transfers.  */
+
+  if (read_flag)
+    {
+      if (dtp->u.p.current_unit->flags.form == FORM_UNFORMATTED)
+	dtp->u.p.transfer = unformatted_read;
+      else
+	{
+	  if ((cf & IOPARM_DT_LIST_FORMAT) != 0)
+	    {
+	      if (dtp->u.p.current_unit->child_dtio  == 0)
+	        dtp->u.p.current_unit->last_char = EOF - 1;
+	      dtp->u.p.transfer = list_formatted_read;
+	    }
+	  else
+	    dtp->u.p.transfer = formatted_transfer;
+	}
+    }
+  else
+    {
+      if (dtp->u.p.current_unit->flags.form == FORM_UNFORMATTED)
+	dtp->u.p.transfer = unformatted_write;
+      else
+	{
+	  if ((cf & IOPARM_DT_LIST_FORMAT) != 0)
+	    dtp->u.p.transfer = list_formatted_write;
+	  else
+	    dtp->u.p.transfer = formatted_transfer;
+	}
+    }
+
   /* Make sure that we don't do a read after a nonadvancing write.  */
 
   if (read_flag)
@@ -4223,7 +4099,7 @@ extern void st_read_done (st_parameter_dt *);
 export_proto(st_read_done);
 
 void
-st_read_done_worker (st_parameter_dt *dtp)
+st_read_done (st_parameter_dt *dtp)
 {
   finalize_transfer (dtp);
 
@@ -4251,30 +4127,6 @@ st_read_done_worker (st_parameter_dt *dtp)
 	  free_format_data (dtp->u.p.fmt);
 	  free_format (dtp);
 	}
-    }
-}
-
-void
-st_read_done (st_parameter_dt *dtp)
-{
-  if (dtp->u.p.current_unit)
-    {
-      if (dtp->u.p.current_unit->au)
-	{
-	  if (dtp->common.flags & IOPARM_DT_HAS_ID)
-	    *dtp->id = enqueue_done_id (dtp->u.p.current_unit->au, AIO_READ_DONE);  
-	  else
-	    {
-	      enqueue_done (dtp->u.p.current_unit->au, AIO_READ_DONE);
-	      /* An asynchronous unit without ASYNCHRONOUS="YES" - make this
-		 synchronous by performing a wait operation.  */
-	      if (!dtp->u.p.async)
-		async_wait (&dtp->common, dtp->u.p.current_unit->au);
-	    }
-	}
-      else
-	st_read_done_worker (dtp);
-
       unlock_unit (dtp->u.p.current_unit);
     }
 
@@ -4282,7 +4134,7 @@ st_read_done (st_parameter_dt *dtp)
 }
 
 extern void st_write (st_parameter_dt *);
-export_proto (st_write);
+export_proto(st_write);
 
 void
 st_write (st_parameter_dt *dtp)
@@ -4291,9 +4143,11 @@ st_write (st_parameter_dt *dtp)
   data_transfer_init (dtp, 0);
 }
 
+extern void st_write_done (st_parameter_dt *);
+export_proto(st_write_done);
 
 void
-st_write_done_worker (st_parameter_dt *dtp)
+st_write_done (st_parameter_dt *dtp)
 {
   finalize_transfer (dtp);
 
@@ -4342,65 +4196,16 @@ st_write_done_worker (st_parameter_dt *dtp)
 	  free_format_data (dtp->u.p.fmt);
 	  free_format (dtp);
 	}
-    }
-}
-
-extern void st_write_done (st_parameter_dt *);
-export_proto(st_write_done);
-
-void
-st_write_done (st_parameter_dt *dtp)
-{
-  if (dtp->u.p.current_unit)
-    {
-      if (dtp->u.p.current_unit->au)
-	{
-	  if (dtp->common.flags & IOPARM_DT_HAS_ID)
-	    *dtp->id = enqueue_done_id (dtp->u.p.current_unit->au,
-					AIO_WRITE_DONE);
-	  else
-	    {
-	      enqueue_done (dtp->u.p.current_unit->au, AIO_WRITE_DONE);
-	      /* An asynchronous unit without ASYNCHRONOUS="YES" - make this
-		 synchronous by performing a wait operation.  */
-	      if (!dtp->u.p.async)
-		async_wait (&dtp->common, dtp->u.p.current_unit->au);
-	    }
-	}
-      else
-	st_write_done_worker (dtp);
-
       unlock_unit (dtp->u.p.current_unit);
     }
-
   library_end ();
 }
 
-/* Wait operation.  We need to keep around the do-nothing version
- of st_wait for compatibility with previous versions, which had marked
- the argument as unused (and thus liable to be removed).
-
- TODO: remove at next bump in version number.  */
 
+/* F2003: This is a stub for the runtime portion of the WAIT statement.  */
 void
 st_wait (st_parameter_wait *wtp __attribute__((unused)))
 {
-  return;
-}
-
-void
-st_wait_async (st_parameter_wait *wtp)
-{
-  gfc_unit *u = find_unit (wtp->common.unit);
-  if (u->au)
-    {
-      if (wtp->common.flags & IOPARM_WAIT_HAS_ID)
-	async_wait_id (&(wtp->common), u->au, *wtp->id);
-      else
-	async_wait (&(wtp->common), u->au);
-    }
-
-  unlock_unit (u);
 }