re PR fortran/25829 ([F03] Asynchronous IO support)

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-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-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-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.


Co-Authored-By: Thomas Koenig <tkoenig@gcc.gnu.org>

From-SVN: r262978

1 files changed, 31 insertions, 23 deletions

diff --git a/libgfortran/io/unit.c b/libgfortran/io/unit.c
index 559dba9..0d0ca8f 100644
--- a/libgfortran/io/unit.c
+++ b/libgfortran/io/unit.c
@@ -27,6 +27,7 @@ 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 <assert.h>
 
@@ -240,7 +241,7 @@ insert_unit (int n)
 #else
   __GTHREAD_MUTEX_INIT_FUNCTION (&u->lock);
 #endif
-  __gthread_mutex_lock (&u->lock);
+  LOCK (&u->lock);
   u->priority = pseudo_random ();
   unit_root = insert (u, unit_root);
   return u;
@@ -327,7 +328,9 @@ get_gfc_unit (int n, int do_create)
   gfc_unit *p;
   int c, created = 0;
 
-  __gthread_mutex_lock (&unit_lock);
+  NOTE ("Unit n=%d, do_create = %d", n, do_create);
+  LOCK (&unit_lock);
+
 retry:
   for (c = 0; c < CACHE_SIZE; c++)
     if (unit_cache[c] != NULL && unit_cache[c]->unit_number == n)
@@ -366,7 +369,7 @@ retry:
     {
       /* Newly created units have their lock held already
 	 from insert_unit.  Just unlock UNIT_LOCK and return.  */
-      __gthread_mutex_unlock (&unit_lock);
+      UNLOCK (&unit_lock);
       return p;
     }
 
@@ -374,10 +377,10 @@ found:
   if (p != NULL && (p->child_dtio == 0))
     {
       /* Fast path.  */
-      if (! __gthread_mutex_trylock (&p->lock))
+      if (! TRYLOCK (&p->lock))
 	{
 	  /* assert (p->closed == 0); */
-	  __gthread_mutex_unlock (&unit_lock);
+	  UNLOCK (&unit_lock);
 	  return p;
 	}
 
@@ -385,15 +388,15 @@ found:
     }
 
 
-  __gthread_mutex_unlock (&unit_lock);
+  UNLOCK (&unit_lock);
 
   if (p != NULL && (p->child_dtio == 0))
     {
-      __gthread_mutex_lock (&p->lock);
+      LOCK (&p->lock);
       if (p->closed)
 	{
-	  __gthread_mutex_lock (&unit_lock);
-	  __gthread_mutex_unlock (&p->lock);
+	  LOCK (&unit_lock);
+	  UNLOCK (&p->lock);
 	  if (predec_waiting_locked (p) == 0)
 	    destroy_unit_mutex (p);
 	  goto retry;
@@ -640,7 +643,7 @@ init_units (void)
 
       fbuf_init (u, 0);
 
-      __gthread_mutex_unlock (&u->lock);
+      UNLOCK (&u->lock);
     }
 
   if (options.stdout_unit >= 0)
@@ -671,7 +674,7 @@ init_units (void)
 
       fbuf_init (u, 0);
 
-      __gthread_mutex_unlock (&u->lock);
+      UNLOCK (&u->lock);
     }
 
   if (options.stderr_unit >= 0)
@@ -702,13 +705,13 @@ init_units (void)
       fbuf_init (u, 256);  /* 256 bytes should be enough, probably not doing
                               any kind of exotic formatting to stderr.  */
 
-      __gthread_mutex_unlock (&u->lock);
+      UNLOCK (&u->lock);
     }
   /* The default internal units.  */
   u = insert_unit (GFC_INTERNAL_UNIT);
-  __gthread_mutex_unlock (&u->lock);
+  UNLOCK (&u->lock);
   u = insert_unit (GFC_INTERNAL_UNIT4);
-  __gthread_mutex_unlock (&u->lock);
+  UNLOCK (&u->lock);
 }
 
 
@@ -717,6 +720,9 @@ close_unit_1 (gfc_unit *u, int locked)
 {
   int i, rc;
 
+  if (u->au)
+    async_close (u->au);
+
   /* If there are previously written bytes from a write with ADVANCE="no"
      Reposition the buffer before closing.  */
   if (u->previous_nonadvancing_write)
@@ -726,7 +732,7 @@ close_unit_1 (gfc_unit *u, int locked)
 
   u->closed = 1;
   if (!locked)
-    __gthread_mutex_lock (&unit_lock);
+    LOCK (&unit_lock);
 
   for (i = 0; i < CACHE_SIZE; i++)
     if (unit_cache[i] == u)
@@ -744,7 +750,7 @@ close_unit_1 (gfc_unit *u, int locked)
     newunit_free (u->unit_number);
 
   if (!locked)
-    __gthread_mutex_unlock (&u->lock);
+    UNLOCK (&u->lock);
 
   /* If there are any threads waiting in find_unit for this unit,
      avoid freeing the memory, the last such thread will free it
@@ -753,7 +759,7 @@ close_unit_1 (gfc_unit *u, int locked)
     destroy_unit_mutex (u);
 
   if (!locked)
-    __gthread_mutex_unlock (&unit_lock);
+    UNLOCK (&unit_lock);
 
   return rc;
 }
@@ -761,7 +767,9 @@ close_unit_1 (gfc_unit *u, int locked)
 void
 unlock_unit (gfc_unit *u)
 {
-  __gthread_mutex_unlock (&u->lock);
+  NOTE ("unlock_unit = %d", u->unit_number);
+  UNLOCK (&u->lock);
+  NOTE ("unlock_unit done");
 }
 
 /* close_unit()-- Close a unit.  The stream is closed, and any memory
@@ -785,10 +793,10 @@ close_unit (gfc_unit *u)
 void
 close_units (void)
 {
-  __gthread_mutex_lock (&unit_lock);
+  LOCK (&unit_lock);
   while (unit_root != NULL)
     close_unit_1 (unit_root, 1);
-  __gthread_mutex_unlock (&unit_lock);
+  UNLOCK (&unit_lock);
 
   free (newunits);
 
@@ -895,7 +903,7 @@ finish_last_advance_record (gfc_unit *u)
 int
 newunit_alloc (void)
 {
-  __gthread_mutex_lock (&unit_lock);
+  LOCK (&unit_lock);
   if (!newunits)
     {
       newunits = xcalloc (16, 1);
@@ -909,7 +917,7 @@ newunit_alloc (void)
         {
           newunits[ii] = true;
           newunit_lwi = ii + 1;
-	  __gthread_mutex_unlock (&unit_lock);
+	  UNLOCK (&unit_lock);
           return -ii + NEWUNIT_START;
         }
     }
@@ -922,7 +930,7 @@ newunit_alloc (void)
   memset (newunits + old_size, 0, old_size);
   newunits[old_size] = true;
   newunit_lwi = old_size + 1;
-    __gthread_mutex_unlock (&unit_lock);
+    UNLOCK (&unit_lock);
   return -old_size + NEWUNIT_START;
 }