From 1d4a51cf5079c11a44126bf7d5cf63fd9b202fbd Mon Sep 17 00:00:00 2001 From: Andre Vieira Date: Tue, 31 Jul 2018 08:42:21 +0000 Subject: [PATCH] Reverting 'AsyncI/O patch committed' as it is breaking bare-metal builds. 2018-07-31 Andre Vieira Revert 'AsyncI/O patch committed' 2018-07-25 Nicolas Koenig Thomas Koenig 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 Revert 'AsyncI/O patch committed' 2018-07-25 Nicolas Koenig Thomas Koenig 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 Revert 'AsyncI/O patch committed' 2018-07-25 Nicolas Koenig Thomas Koenig 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 Revert 'AsyncI/O patch committed'. 2018-07-25 Nicolas Koenig Thomas Koenig 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 --- gcc/fortran/ChangeLog | 14 + gcc/fortran/gfortran.texi | 18 +- gcc/fortran/trans-decl.c | 3 +- gcc/fortran/trans-io.c | 5 +- gcc/testsuite/ChangeLog | 10 + gcc/testsuite/gfortran.dg/f2003_inquire_1.f03 | 4 +- gcc/testsuite/gfortran.dg/f2003_io_1.f03 | 2 - libgfortran/ChangeLog | 65 +++ libgfortran/Makefile.am | 6 +- libgfortran/Makefile.in | 16 +- libgfortran/gfortran.map | 5 - libgfortran/io/async.c | 483 ------------------ libgfortran/io/async.h | 378 -------------- libgfortran/io/close.c | 11 +- libgfortran/io/file_pos.c | 70 +-- libgfortran/io/inquire.c | 49 +- libgfortran/io/io.h | 29 +- libgfortran/io/open.c | 9 +- libgfortran/io/read.c | 2 - libgfortran/io/transfer.c | 309 +++-------- libgfortran/io/unit.c | 54 +- libgfortran/io/unix.c | 29 +- libgfortran/libgfortran.h | 5 - libgfortran/runtime/error.c | 75 +-- libgomp/ChangeLog | 15 + .../testsuite/libgomp.fortran/async_io_1.f90 | 48 -- .../testsuite/libgomp.fortran/async_io_2.f90 | 18 - .../testsuite/libgomp.fortran/async_io_3.f90 | 16 - .../testsuite/libgomp.fortran/async_io_4.f90 | 90 ---- .../testsuite/libgomp.fortran/async_io_5.f90 | 132 ----- .../testsuite/libgomp.fortran/async_io_6.f90 | 30 -- .../testsuite/libgomp.fortran/async_io_7.f90 | 22 - 32 files changed, 254 insertions(+), 1768 deletions(-) delete mode 100644 libgfortran/io/async.c delete mode 100644 libgfortran/io/async.h delete mode 100644 libgomp/testsuite/libgomp.fortran/async_io_1.f90 delete mode 100644 libgomp/testsuite/libgomp.fortran/async_io_2.f90 delete mode 100644 libgomp/testsuite/libgomp.fortran/async_io_3.f90 delete mode 100644 libgomp/testsuite/libgomp.fortran/async_io_4.f90 delete mode 100644 libgomp/testsuite/libgomp.fortran/async_io_5.f90 delete mode 100644 libgomp/testsuite/libgomp.fortran/async_io_6.f90 delete mode 100644 libgomp/testsuite/libgomp.fortran/async_io_7.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 94b63b71e2a..9454102afdb 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,17 @@ +2018-07-31 Andre Vieira + + Revert 'AsyncI/O patch committed' + 2018-07-25 Nicolas Koenig + Thomas Koenig + + 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 Thomas Koenig diff --git a/gcc/fortran/gfortran.texi b/gcc/fortran/gfortran.texi index 39200027305..d6bb7aae494 100644 --- a/gcc/fortran/gfortran.texi +++ b/gcc/fortran/gfortran.texi @@ -879,7 +879,8 @@ than @code{(/.../)}. Type-specification for array constructors like @item Extensions to the specification and initialization expressions, including the support for intrinsics with real and complex arguments. -@item Support for the asynchronous input/output. +@item Support for the asynchronous input/output syntax; however, the +data transfer is currently always synchronously performed. @item @cindex @code{FLUSH} statement @@ -1182,7 +1183,6 @@ might in some way or another become visible to the programmer. * Files opened without an explicit ACTION= specifier:: * File operations on symbolic links:: * File format of unformatted sequential files:: -* Asynchronous I/O:: @end menu @@ -1486,20 +1486,6 @@ program main end program main @end smallexample -@node Asynchronous I/O -@section Asynchronous I/O -@cindex input/output, asynchronous -@cindex asynchronous I/O - -Asynchronous I/O is supported if the program is linked against the -POSIX thread library. If that is not the case, all I/O is performed -as synchronous. - -On some systems, such as Darwin or Solaris, the POSIX thread library -is always linked in, so asynchronous I/O is always performed. On other -sytems, such as Linux, it is necessary to specify @option{-pthread}, -@option{-lpthread} or @option{-fopenmp} during the linking step. - @c --------------------------------------------------------------------- @c Extensions @c --------------------------------------------------------------------- diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index eea6b81ebfa..08c1ebd2d4b 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -698,8 +698,7 @@ gfc_finish_var_decl (tree decl, gfc_symbol * sym) && CLASS_DATA (sym)->ts.u.derived->attr.has_dtio_procs))) TREE_STATIC (decl) = 1; - /* Treat asynchronous variables the same as volatile, for now. */ - if (sym->attr.volatile_ || sym->attr.asynchronous) + if (sym->attr.volatile_) { TREE_THIS_VOLATILE (decl) = 1; TREE_SIDE_EFFECTS (decl) = 1; diff --git a/gcc/fortran/trans-io.c b/gcc/fortran/trans-io.c index 88dbcb80a85..2626c4651e2 100644 --- a/gcc/fortran/trans-io.c +++ b/gcc/fortran/trans-io.c @@ -438,9 +438,10 @@ gfc_build_io_library_fndecls (void) get_identifier (PREFIX("st_iolength")), ".w", void_type_node, 1, dt_parm_type); + /* TODO: Change when asynchronous I/O is implemented. */ parm_type = build_pointer_type (st_parameter[IOPARM_ptype_wait].type); iocall[IOCALL_WAIT] = gfc_build_library_function_decl_with_spec ( - get_identifier (PREFIX("st_wait_async")), ".w", + get_identifier (PREFIX("st_wait")), ".X", void_type_node, 1, parm_type); parm_type = build_pointer_type (st_parameter[IOPARM_ptype_filepos].type); @@ -1526,7 +1527,7 @@ gfc_trans_wait (gfc_code * code) mask |= IOPARM_common_err; if (p->id) - mask |= set_parameter_ref (&block, &post_block, var, IOPARM_wait_id, p->id); + mask |= set_parameter_value (&block, var, IOPARM_wait_id, p->id); set_parameter_const (&block, var, IOPARM_common_flags, mask); diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 0731143de66..eb6474211c0 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,13 @@ +2018-07-31 Andre Vieira + + Revert 'AsyncI/O patch committed' + 2018-07-25 Nicolas Koenig + Thomas Koenig + + PR fortran/25829 + * gfortran.dg/f2003_inquire_1.f03: Add write statement. + * gfortran.dg/f2003_io_1.f03: Add wait statement. + 2018-07-30 Segher Boessenkool PR rtl-optimization/85160 diff --git a/gcc/testsuite/gfortran.dg/f2003_inquire_1.f03 b/gcc/testsuite/gfortran.dg/f2003_inquire_1.f03 index 957cdae5276..e51f619c863 100644 --- a/gcc/testsuite/gfortran.dg/f2003_inquire_1.f03 +++ b/gcc/testsuite/gfortran.dg/f2003_inquire_1.f03 @@ -7,12 +7,10 @@ logical :: vpending open(10, file='mydata_f2003_inquire_1', asynchronous="yes", blank="null", & & decimal="comma", encoding="utf-8", sign="plus") -write (10,*, asynchronous="yes", id=vid) 'asdf' -wait (10) - inquire(unit=10, round=sround, sign=ssign, size=vsize, id=vid, & & pending=vpending, asynchronous=sasynchronous, decimal=sdecimal, & & encoding=sencoding) + if (ssign.ne."PLUS") STOP 1 if (sasynchronous.ne."YES") STOP 2 if (sdecimal.ne."COMMA") STOP 3 diff --git a/gcc/testsuite/gfortran.dg/f2003_io_1.f03 b/gcc/testsuite/gfortran.dg/f2003_io_1.f03 index 8c7fb4b994d..8021d7906fd 100644 --- a/gcc/testsuite/gfortran.dg/f2003_io_1.f03 +++ b/gcc/testsuite/gfortran.dg/f2003_io_1.f03 @@ -13,7 +13,6 @@ open(10, file='mydata_f2003_io_1', asynchronous="yes", blank="null") write(10,'(10f8.3)', asynchronous="yes", decimal="comma", id=j) a rewind(10) read(10,'(10f8.3)', asynchronous="yes", decimal="comma", blank="zero") b -wait(10) if (any(b.ne.23.45)) STOP 1 c = 3.14 @@ -25,7 +24,6 @@ rewind(10) write(10,'(10f8.3)', asynchronous="yes", decimal="point") a rewind(10) read(10,'(10f8.3)', asynchronous="yes", decimal="point") b -wait (10) if (any(b.ne.23.45)) STOP 3 wait(unit=10, err=25, iostat=istat, iomsg=msg, end=35, id=j) diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index e895df751f7..850c8a1341b 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,68 @@ +2018-07-31 Andre Vieira + + Revert 'AsyncI/O patch committed' + 2018-07-25 Nicolas Koenig + Thomas Koenig + + 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 Thomas Koenig diff --git a/libgfortran/Makefile.am b/libgfortran/Makefile.am index 4ffc6cea780..5831631ddfb 100644 --- a/libgfortran/Makefile.am +++ b/libgfortran/Makefile.am @@ -100,8 +100,7 @@ io/transfer128.c \ io/unit.c \ io/unix.c \ io/write.c \ -io/fbuf.c \ -io/async.c +io/fbuf.c endif @@ -109,8 +108,7 @@ gfor_io_headers= \ io/io.h \ io/fbuf.h \ io/format.h \ -io/unix.h \ -io/async.h +io/unix.h gfor_helper_src= \ intrinsics/associated.c \ diff --git a/libgfortran/Makefile.in b/libgfortran/Makefile.in index 94c3524ffb9..b66a91bfde3 100644 --- a/libgfortran/Makefile.in +++ b/libgfortran/Makefile.in @@ -70,8 +70,7 @@ target_triplet = @target@ @LIBGFOR_MINIMAL_FALSE@io/unit.c \ @LIBGFOR_MINIMAL_FALSE@io/unix.c \ @LIBGFOR_MINIMAL_FALSE@io/write.c \ -@LIBGFOR_MINIMAL_FALSE@io/fbuf.c \ -@LIBGFOR_MINIMAL_FALSE@io/async.c +@LIBGFOR_MINIMAL_FALSE@io/fbuf.c @LIBGFOR_MINIMAL_FALSE@am__append_3 = \ @LIBGFOR_MINIMAL_FALSE@intrinsics/access.c \ @@ -353,7 +352,7 @@ am__objects_47 = $(am__objects_4) $(am__objects_5) $(am__objects_6) \ @LIBGFOR_MINIMAL_FALSE@ inquire.lo intrinsics.lo list_read.lo \ @LIBGFOR_MINIMAL_FALSE@ lock.lo open.lo read.lo transfer.lo \ @LIBGFOR_MINIMAL_FALSE@ transfer128.lo unit.lo unix.lo write.lo \ -@LIBGFOR_MINIMAL_FALSE@ fbuf.lo async.lo +@LIBGFOR_MINIMAL_FALSE@ fbuf.lo am__objects_49 = size_from_kind.lo $(am__objects_48) @LIBGFOR_MINIMAL_FALSE@am__objects_50 = access.lo c99_functions.lo \ @LIBGFOR_MINIMAL_FALSE@ chdir.lo chmod.lo clock.lo cpu_time.lo \ @@ -651,8 +650,7 @@ gfor_io_headers = \ io/io.h \ io/fbuf.h \ io/format.h \ -io/unix.h \ -io/async.h +io/unix.h gfor_helper_src = intrinsics/associated.c intrinsics/abort.c \ intrinsics/args.c intrinsics/cshift0.c intrinsics/eoshift0.c \ @@ -1553,7 +1551,6 @@ distclean-compile: @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/any_l8.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/args.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/associated.Plo@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/async.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/backtrace.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/bessel_r10.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/bessel_r16.Plo@am__quote@ @@ -5817,13 +5814,6 @@ fbuf.lo: io/fbuf.c @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ @am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o fbuf.lo `test -f 'io/fbuf.c' || echo '$(srcdir)/'`io/fbuf.c -async.lo: io/async.c -@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT async.lo -MD -MP -MF $(DEPDIR)/async.Tpo -c -o async.lo `test -f 'io/async.c' || echo '$(srcdir)/'`io/async.c -@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/async.Tpo $(DEPDIR)/async.Plo -@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='io/async.c' object='async.lo' libtool=yes @AMDEPBACKSLASH@ -@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ -@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o async.lo `test -f 'io/async.c' || echo '$(srcdir)/'`io/async.c - associated.lo: intrinsics/associated.c @am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT associated.lo -MD -MP -MF $(DEPDIR)/associated.Tpo -c -o associated.lo `test -f 'intrinsics/associated.c' || echo '$(srcdir)/'`intrinsics/associated.c @am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/associated.Tpo $(DEPDIR)/associated.Plo diff --git a/libgfortran/gfortran.map b/libgfortran/gfortran.map index a303a2ef573..78f8d7e9706 100644 --- a/libgfortran/gfortran.map +++ b/libgfortran/gfortran.map @@ -1483,8 +1483,3 @@ GFORTRAN_C99_8 { y1f; ynf; }; - -GFORTRAN_9 { - global: - _gfortran_st_wait_async; -}; diff --git a/libgfortran/io/async.c b/libgfortran/io/async.c deleted file mode 100644 index b32af16ccb4..00000000000 --- a/libgfortran/io/async.c +++ /dev/null @@ -1,483 +0,0 @@ -/* Copyright (C) 2018 Free Software Foundation, Inc. - Contributed by Nicolas Koenig - - This file is part of the GNU Fortran runtime library (libgfortran). - - Libgfortran is free software; you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 3, or (at your option) - any later version. - - Libgfortran is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - Under Section 7 of GPL version 3, you are granted additional - permissions described in the GCC Runtime Library Exception, version - 3.1, as published by the Free Software Foundation. - - You should have received a copy of the GNU General Public License and - a copy of the GCC Runtime Library Exception along with this program; - see the files COPYING3 and COPYING.RUNTIME respectively. If not, see - . */ - -#include "libgfortran.h" - -#define _GTHREAD_USE_COND_INIT_FUNC -#include "../../libgcc/gthr.h" -#include "io.h" -#include "fbuf.h" -#include "format.h" -#include "unix.h" -#include -#include - -#include - -#include "async.h" - -DEBUG_LINE (__thread const char *aio_prefix = MPREFIX); - -DEBUG_LINE (__gthread_mutex_t debug_queue_lock = __GTHREAD_MUTEX_INIT;) -DEBUG_LINE (aio_lock_debug *aio_debug_head = NULL;) - -/* Current unit for asynchronous I/O. Needed for error reporting. */ - -__thread gfc_unit *thread_unit = NULL; - -/* Queue entry for the asynchronous I/O entry. */ -typedef struct transfer_queue -{ - enum aio_do type; - struct transfer_queue *next; - struct st_parameter_dt *new_pdt; - transfer_args arg; - _Bool has_id; - int read_flag; -} transfer_queue; - -struct error { - st_parameter_dt *dtp; - int id; -}; - -/* Helper function to exchange the old vs. a new PDT. */ - -static void -update_pdt (st_parameter_dt **old, st_parameter_dt *new) { - st_parameter_dt *temp; - NOTE ("Changing pdts, current_unit = %p", (void *) (new->u.p.current_unit)); - temp = *old; - *old = new; - if (temp) - free (temp); -} - -/* Destroy an adv_cond structure. */ - -static void -destroy_adv_cond (struct adv_cond *ac) -{ - T_ERROR (__gthread_mutex_destroy, &ac->lock); - T_ERROR (__gthread_cond_destroy, &ac->signal); -} - -/* Function invoked as start routine for a new asynchronous I/O unit. - Contains the main loop for accepting requests and handling them. */ - -static void * -async_io (void *arg) -{ - DEBUG_LINE (aio_prefix = TPREFIX); - transfer_queue *ctq = NULL, *prev = NULL; - gfc_unit *u = (gfc_unit *) arg; - async_unit *au = u->au; - LOCK (&au->lock); - thread_unit = u; - au->thread = __gthread_self (); - while (true) - { - /* Main loop. At this point, au->lock is always held. */ - WAIT_SIGNAL_MUTEX (&au->work, au->tail != NULL, &au->lock); - LOCK (&au->lock); - ctq = au->head; - prev = NULL; - /* Loop over the queue entries until they are finished. */ - while (ctq) - { - if (prev) - free (prev); - prev = ctq; - if (!au->error.has_error) - { - UNLOCK (&au->lock); - - switch (ctq->type) - { - case AIO_WRITE_DONE: - NOTE ("Finalizing write"); - st_write_done_worker (au->pdt); - UNLOCK (&au->io_lock); - break; - - case AIO_READ_DONE: - NOTE ("Finalizing read"); - st_read_done_worker (au->pdt); - UNLOCK (&au->io_lock); - break; - - case AIO_DATA_TRANSFER_INIT: - NOTE ("Data transfer init"); - LOCK (&au->io_lock); - update_pdt (&au->pdt, ctq->new_pdt); - data_transfer_init_worker (au->pdt, ctq->read_flag); - break; - - case AIO_TRANSFER_SCALAR: - NOTE ("Starting scalar transfer"); - ctq->arg.scalar.transfer (au->pdt, ctq->arg.scalar.arg_bt, - ctq->arg.scalar.data, - ctq->arg.scalar.i, - ctq->arg.scalar.s1, - ctq->arg.scalar.s2); - break; - - case AIO_TRANSFER_ARRAY: - NOTE ("Starting array transfer"); - NOTE ("ctq->arg.array.desc = %p", - (void *) (ctq->arg.array.desc)); - transfer_array_inner (au->pdt, ctq->arg.array.desc, - ctq->arg.array.kind, - ctq->arg.array.charlen); - free (ctq->arg.array.desc); - break; - - case AIO_CLOSE: - NOTE ("Received AIO_CLOSE"); - goto finish_thread; - - default: - internal_error (NULL, "Invalid queue type"); - break; - } - LOCK (&au->lock); - if (unlikely (au->error.has_error)) - au->error.last_good_id = au->id.low - 1; - } - else - { - if (ctq->type == AIO_WRITE_DONE || ctq->type == AIO_READ_DONE) - { - UNLOCK (&au->io_lock); - } - else if (ctq->type == AIO_CLOSE) - { - NOTE ("Received AIO_CLOSE during error condition"); - UNLOCK (&au->lock); - goto finish_thread; - } - } - - NOTE ("Next ctq, current id: %d", au->id.low); - if (ctq->has_id && au->id.waiting == au->id.low++) - SIGNAL (&au->id.done); - - ctq = ctq->next; - } - au->tail = NULL; - au->head = NULL; - au->empty = 1; - UNLOCK (&au->lock); - SIGNAL (&au->emptysignal); - LOCK (&au->lock); - } - finish_thread: - au->tail = NULL; - au->head = NULL; - au->empty = 1; - SIGNAL (&au->emptysignal); - free (ctq); - return NULL; -} - -/* Free an asynchronous unit. */ - -static void -free_async_unit (async_unit *au) -{ - if (au->tail) - internal_error (NULL, "Trying to free nonempty asynchronous unit"); - - destroy_adv_cond (&au->work); - destroy_adv_cond (&au->emptysignal); - destroy_adv_cond (&au->id.done); - T_ERROR (__gthread_mutex_destroy, &au->lock); - free (au); -} - -/* Initialize an adv_cond structure. */ - -static void -init_adv_cond (struct adv_cond *ac) -{ - ac->pending = 0; - __GTHREAD_MUTEX_INIT_FUNCTION (&ac->lock); - __gthread_cond_init_function (&ac->signal); -} - -/* Initialize an asyncronous unit, returning zero on success, - nonzero on failure. It also sets u->au. */ - -void -init_async_unit (gfc_unit *u) -{ - async_unit *au; - if (!__gthread_active_p ()) - { - u->au = NULL; - return; - } - - au = (async_unit *) xmalloc (sizeof (async_unit)); - u->au = au; - init_adv_cond (&au->work); - init_adv_cond (&au->emptysignal); - __GTHREAD_MUTEX_INIT_FUNCTION (&au->lock); - __GTHREAD_MUTEX_INIT_FUNCTION (&au->io_lock); - LOCK (&au->lock); - T_ERROR (__gthread_create, &au->thread, &async_io, (void *) u); - au->pdt = NULL; - au->head = NULL; - au->tail = NULL; - au->empty = true; - au->id.waiting = -1; - au->id.low = 0; - au->id.high = 0; - au->error.fatal_error = 0; - au->error.has_error = 0; - au->error.last_good_id = 0; - init_adv_cond (&au->id.done); - UNLOCK (&au->lock); -} - -/* Enqueue a transfer statement. */ - -void -enqueue_transfer (async_unit *au, transfer_args *arg, enum aio_do type) -{ - transfer_queue *tq = calloc (sizeof (transfer_queue), 1); - tq->arg = *arg; - tq->type = type; - tq->has_id = 0; - LOCK (&au->lock); - if (!au->tail) - au->head = tq; - else - au->tail->next = tq; - au->tail = tq; - REVOKE_SIGNAL (&(au->emptysignal)); - au->empty = false; - UNLOCK (&au->lock); - SIGNAL (&au->work); -} - -/* Enqueue an st_write_done or st_read_done which contains an ID. */ - -int -enqueue_done_id (async_unit *au, enum aio_do type) -{ - int ret; - transfer_queue *tq = calloc (sizeof (transfer_queue), 1); - - tq->type = type; - tq->has_id = 1; - LOCK (&au->lock); - if (!au->tail) - au->head = tq; - else - au->tail->next = tq; - au->tail = tq; - REVOKE_SIGNAL (&(au->emptysignal)); - au->empty = false; - ret = au->id.high++; - NOTE ("Enqueue id: %d", ret); - UNLOCK (&au->lock); - SIGNAL (&au->work); - return ret; -} - -/* Enqueue an st_write_done or st_read_done without an ID. */ - -void -enqueue_done (async_unit *au, enum aio_do type) -{ - transfer_queue *tq = calloc (sizeof (transfer_queue), 1); - tq->type = type; - tq->has_id = 0; - LOCK (&au->lock); - if (!au->tail) - au->head = tq; - else - au->tail->next = tq; - au->tail = tq; - REVOKE_SIGNAL (&(au->emptysignal)); - au->empty = false; - UNLOCK (&au->lock); - SIGNAL (&au->work); -} - -/* Enqueue a CLOSE statement. */ - -void -enqueue_close (async_unit *au) -{ - transfer_queue *tq = calloc (sizeof (transfer_queue), 1); - - tq->type = AIO_CLOSE; - LOCK (&au->lock); - if (!au->tail) - au->head = tq; - else - au->tail->next = tq; - au->tail = tq; - REVOKE_SIGNAL (&(au->emptysignal)); - au->empty = false; - UNLOCK (&au->lock); - SIGNAL (&au->work); -} - -/* The asynchronous unit keeps the currently active PDT around. - This function changes that to the current one. */ - -void -enqueue_data_transfer_init (async_unit *au, st_parameter_dt *dt, int read_flag) -{ - st_parameter_dt *new = xmalloc (sizeof (st_parameter_dt)); - transfer_queue *tq = xmalloc (sizeof (transfer_queue)); - - memcpy ((void *) new, (void *) dt, sizeof (st_parameter_dt)); - - NOTE ("dt->internal_unit_desc = %p", dt->internal_unit_desc); - NOTE ("common.flags & mask = %d", dt->common.flags & IOPARM_LIBRETURN_MASK); - tq->next = NULL; - tq->type = AIO_DATA_TRANSFER_INIT; - tq->read_flag = read_flag; - tq->has_id = 0; - tq->new_pdt = new; - LOCK (&au->lock); - - if (!au->tail) - au->head = tq; - else - au->tail->next = tq; - au->tail = tq; - REVOKE_SIGNAL (&(au->emptysignal)); - au->empty = 0; - UNLOCK (&au->lock); - SIGNAL (&au->work); -} - -/* Collect the errors that may have happened asynchronously. Return true if - an error has been encountered. */ - -bool -collect_async_errors (st_parameter_common *cmp, async_unit *au) -{ - bool has_error = au->error.has_error; - - if (has_error) - { - if (generate_error_common (cmp, au->error.family, au->error.message)) - { - au->error.has_error = 0; - au->error.cmp = NULL; - } - else - { - /* The program will exit later. */ - au->error.fatal_error = true; - } - } - return has_error; -} - -/* Perform a wait operation on an asynchronous unit with an ID specified, - which means collecting the errors that may have happened asynchronously. - Return true if an error has been encountered. */ - -bool -async_wait_id (st_parameter_common *cmp, async_unit *au, int i) -{ - bool ret; - - if (au == NULL) - return false; - - if (cmp == NULL) - cmp = au->error.cmp; - - if (au->error.has_error) - { - if (i <= au->error.last_good_id) - return false; - - return collect_async_errors (cmp, au); - } - - LOCK (&au->lock); - NOTE ("Waiting for id %d", i); - if (au->id.waiting < i) - au->id.waiting = i; - UNLOCK (&au->lock); - SIGNAL (&(au->work)); - LOCK (&au->lock); - WAIT_SIGNAL_MUTEX (&(au->id.done), - (au->id.low >= au->id.waiting || au->empty), &au->lock); - LOCK (&au->lock); - ret = collect_async_errors (cmp, au); - UNLOCK (&au->lock); - return ret; -} - -/* Perform a wait operation an an asynchronous unit without an ID. */ - -bool -async_wait (st_parameter_common *cmp, async_unit *au) -{ - bool ret; - - if (au == NULL) - return false; - - if (cmp == NULL) - cmp = au->error.cmp; - - SIGNAL (&(au->work)); - LOCK (&(au->lock)); - - if (au->empty) - { - ret = collect_async_errors (cmp, au); - UNLOCK (&au->lock); - return ret; - } - - WAIT_SIGNAL_MUTEX (&(au->emptysignal), (au->empty), &au->lock); - ret = collect_async_errors (cmp, au); - return ret; -} - -/* Close an asynchronous unit. */ - -void -async_close (async_unit *au) -{ - if (au == NULL) - return; - - NOTE ("Closing async unit"); - enqueue_close (au); - T_ERROR (__gthread_join, au->thread, NULL); - free_async_unit (au); -} diff --git a/libgfortran/io/async.h b/libgfortran/io/async.h deleted file mode 100644 index 3581ae65931..00000000000 --- a/libgfortran/io/async.h +++ /dev/null @@ -1,378 +0,0 @@ -/* Copyright (C) 2018 Free Software Foundation, Inc. - Contributed by Nicolas Koenig - - This file is part of the GNU Fortran runtime library (libgfortran). - - Libgfortran is free software; you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 3, or (at your option) - any later version. - - Libgfortran is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - Under Section 7 of GPL version 3, you are granted additional - permissions described in the GCC Runtime Library Exception, version - 3.1, as published by the Free Software Foundation. - - You should have received a copy of the GNU General Public License and - a copy of the GCC Runtime Library Exception along with this program; - see the files COPYING3 and COPYING.RUNTIME respectively. If not, see - . */ - -#ifndef ASYNC_H -#define ASYNC_H - -/* Defining DEBUG_ASYNC will enable somewhat verbose debugging - output for async I/O. */ - -#define DEBUG_ASYNC -#undef DEBUG_ASYNC - -#ifdef DEBUG_ASYNC - -/* Define this if you want to use ANSI color escape sequences in your - debugging output. */ - -#define DEBUG_COLOR - -#ifdef DEBUG_COLOR -#define MPREFIX "\033[30;46mM:\033[0m " -#define TPREFIX "\033[37;44mT:\033[0m " -#define RPREFIX "\033[37;41mR:\033[0m " -#define DEBUG_RED "\033[31m" -#define DEBUG_ORANGE "\033[33m" -#define DEBUG_GREEN "\033[32m" -#define DEBUG_DARKRED "\033[31;2m" -#define DEBUG_PURPLE "\033[35m" -#define DEBUG_NORM "\033[0m" -#define DEBUG_REVERSE_RED "\033[41;37m" -#define DEBUG_BLUE "\033[34m" - -#else - -#define MPREFIX "M: " -#define TPREFIX "T: " -#define RPREFIX "" -#define DEBUG_RED "" -#define DEBUG_ORANGE "" -#define DEBUG_GREEN "" -#define DEBUG_DARKRED "" -#define DEBUG_PURPLE "" -#define DEBUG_NORM "" -#define DEBUG_REVERSE_RED "" -#define DEBUG_BLUE "" - -#endif - -#define DEBUG_PRINTF(...) fprintf (stderr,__VA_ARGS__) - -#define IN_DEBUG_QUEUE(mutex) ({ \ - __label__ end; \ - aio_lock_debug *curr = aio_debug_head; \ - while (curr) { \ - if (curr->m == mutex) { \ - goto end; \ - } \ - curr = curr->next; \ - } \ - end:; \ - curr; \ - }) - -#define TAIL_DEBUG_QUEUE ({ \ - aio_lock_debug *curr = aio_debug_head; \ - while (curr && curr->next) { \ - curr = curr->next; \ - } \ - curr; \ - }) - -#define CHECK_LOCK(mutex, status) do { \ - aio_lock_debug *curr; \ - INTERN_LOCK (&debug_queue_lock); \ - if (__gthread_mutex_trylock (mutex)) { \ - if ((curr = IN_DEBUG_QUEUE (mutex))) { \ - sprintf (status, DEBUG_RED "%s():%d" DEBUG_NORM, curr->func, curr->line); \ - } else \ - sprintf (status, DEBUG_RED "unknown" DEBUG_NORM); \ - } \ - else { \ - __gthread_mutex_unlock (mutex); \ - sprintf (status, DEBUG_GREEN "unlocked" DEBUG_NORM); \ - } \ - INTERN_UNLOCK (&debug_queue_lock); \ - }while (0) - -#define T_ERROR(func, ...) do { \ - int t_error_temp; \ - t_error_temp = func(__VA_ARGS__); \ - if (t_error_temp) \ - ERROR (t_error_temp, "args: " #__VA_ARGS__ "\n"); \ - } while (0) - -#define NOTE(str, ...) do{ \ - char note_str[200]; \ - sprintf (note_str, "%s" DEBUG_PURPLE "NOTE: " DEBUG_NORM str, aio_prefix, ##__VA_ARGS__); \ - DEBUG_PRINTF ("%-90s %20s():%-5d\n", note_str, __FUNCTION__, __LINE__); \ - }while (0); - -#define ERROR(errnum, str, ...) do{ \ - char note_str[200]; \ - sprintf (note_str, "%s" DEBUG_REVERSE_RED "ERROR:" DEBUG_NORM " [%d] " str, aio_prefix, \ - errnum, ##__VA_ARGS__); \ - DEBUG_PRINTF ("%-68s %s():%-5d\n", note_str, __FUNCTION__, __LINE__); \ - }while (0) - -#define MUTEX_DEBUG_ADD(mutex) do { \ - aio_lock_debug *n; \ - n = malloc (sizeof(aio_lock_debug)); \ - n->prev = TAIL_DEBUG_QUEUE; \ - if (n->prev) \ - n->prev->next = n; \ - n->next = NULL; \ - n->line = __LINE__; \ - n->func = __FUNCTION__; \ - n->m = mutex; \ - if (!aio_debug_head) { \ - aio_debug_head = n; \ - } \ - } while (0) - -#define UNLOCK(mutex) do { \ - aio_lock_debug *curr; \ - DEBUG_PRINTF ("%s%-75s %20s():%-5d %18p\n", aio_prefix, DEBUG_GREEN "UNLOCK: " DEBUG_NORM #mutex, \ - __FUNCTION__, __LINE__, (void *) mutex); \ - INTERN_LOCK (&debug_queue_lock); \ - curr = IN_DEBUG_QUEUE (mutex); \ - if (curr) \ - { \ - if (curr->prev) \ - curr->prev->next = curr->next; \ - if (curr->next) { \ - curr->next->prev = curr->prev; \ - if (curr == aio_debug_head) \ - aio_debug_head = curr->next; \ - } else { \ - if (curr == aio_debug_head) \ - aio_debug_head = NULL; \ - } \ - free (curr); \ - } \ - INTERN_UNLOCK (&debug_queue_lock); \ - INTERN_UNLOCK (mutex); \ - }while (0) - -#define TRYLOCK(mutex) ({ \ - char status[200]; \ - int res; \ - aio_lock_debug *curr; \ - res = __gthread_mutex_trylock (mutex); \ - INTERN_LOCK (&debug_queue_lock); \ - if (res) { \ - if ((curr = IN_DEBUG_QUEUE (mutex))) { \ - sprintf (status, DEBUG_RED "%s():%d" DEBUG_NORM, curr->func, curr->line); \ - } else \ - sprintf (status, DEBUG_RED "unknown" DEBUG_NORM); \ - } \ - else { \ - sprintf (status, DEBUG_GREEN "unlocked" DEBUG_NORM); \ - MUTEX_DEBUG_ADD (mutex); \ - } \ - DEBUG_PRINTF ("%s%-44s prev: %-35s %20s():%-5d %18p\n", aio_prefix, \ - DEBUG_DARKRED "TRYLOCK: " DEBUG_NORM #mutex, status, __FUNCTION__, __LINE__, \ - (void *) mutex); \ - INTERN_UNLOCK (&debug_queue_lock); \ - res; \ - }) - -#define LOCK(mutex) do { \ - char status[200]; \ - CHECK_LOCK (mutex, status); \ - DEBUG_PRINTF ("%s%-42s prev: %-35s %20s():%-5d %18p\n", aio_prefix, \ - DEBUG_RED "LOCK: " DEBUG_NORM #mutex, status, __FUNCTION__, __LINE__, (void *) mutex); \ - INTERN_LOCK (mutex); \ - INTERN_LOCK (&debug_queue_lock); \ - MUTEX_DEBUG_ADD (mutex); \ - INTERN_UNLOCK (&debug_queue_lock); \ - DEBUG_PRINTF ("%s" DEBUG_RED "ACQ:" DEBUG_NORM " %-30s %78p\n", aio_prefix, #mutex, mutex); \ - } while (0) - -#define DEBUG_LINE(...) __VA_ARGS__ - -#else -#define DEBUG_PRINTF(...) {} -#define CHECK_LOCK(au, mutex, status) {} -#define NOTE(str, ...) {} -#define DEBUG_LINE(...) -#define T_ERROR(func, ...) func(__VA_ARGS__) -#define LOCK(mutex) INTERN_LOCK (mutex) -#define UNLOCK(mutex) INTERN_UNLOCK (mutex) -#define TRYLOCK(mutex) (__gthread_mutex_trylock (mutex)) -#endif - -#define INTERN_LOCK(mutex) T_ERROR (__gthread_mutex_lock, mutex); - -#define INTERN_UNLOCK(mutex) T_ERROR (__gthread_mutex_unlock, mutex); - -#define SIGNAL(advcond) do{ \ - INTERN_LOCK (&(advcond)->lock); \ - (advcond)->pending = 1; \ - DEBUG_PRINTF ("%s%-75s %20s():%-5d %18p\n", aio_prefix, DEBUG_ORANGE "SIGNAL: " DEBUG_NORM \ - #advcond, __FUNCTION__, __LINE__, (void *) advcond); \ - T_ERROR (__gthread_cond_broadcast, &(advcond)->signal); \ - INTERN_UNLOCK (&(advcond)->lock); \ - } while (0) - -#define WAIT_SIGNAL_MUTEX(advcond, condition, mutex) do{ \ - __label__ finish; \ - INTERN_LOCK (&((advcond)->lock)); \ - DEBUG_PRINTF ("%s%-75s %20s():%-5d %18p\n", aio_prefix, DEBUG_BLUE "WAITING: " DEBUG_NORM \ - #advcond, __FUNCTION__, __LINE__, (void *) advcond); \ - if ((advcond)->pending || (condition)){ \ - UNLOCK (mutex); \ - goto finish; \ - } \ - UNLOCK (mutex); \ - while (!__gthread_cond_wait(&(advcond)->signal, &(advcond)->lock)) { \ - { int cond; \ - LOCK (mutex); cond = condition; UNLOCK (mutex); \ - if (cond){ \ - DEBUG_PRINTF ("%s%-75s %20s():%-5d %18p\n", aio_prefix, DEBUG_ORANGE "REC: " DEBUG_NORM \ - #advcond, __FUNCTION__, __LINE__, (void *)advcond); \ - break; \ - } \ - } \ - } \ - finish: \ - (advcond)->pending = 0; \ - INTERN_UNLOCK (&((advcond)->lock)); \ - } while (0) - -#define REVOKE_SIGNAL(advcond) do{ \ - INTERN_LOCK (&(advcond)->lock); \ - (advcond)->pending = 0; \ - INTERN_UNLOCK (&(advcond)->lock); \ - } while (0) - -DEBUG_LINE (extern __thread const char *aio_prefix); - -DEBUG_LINE (typedef struct aio_lock_debug{ - __gthread_mutex_t *m; - int line; - const char *func; - struct aio_lock_debug *next; - struct aio_lock_debug *prev; -} aio_lock_debug;) - -DEBUG_LINE (extern aio_lock_debug *aio_debug_head;) -DEBUG_LINE (extern __gthread_mutex_t debug_queue_lock;) - -/* Thread - local storage of the current unit we are looking at. Needed for - error reporting. */ - -extern __thread gfc_unit *thread_unit; - -enum aio_do { - AIO_INVALID = 0, - AIO_DATA_TRANSFER_INIT, - AIO_TRANSFER_SCALAR, - AIO_TRANSFER_ARRAY, - AIO_WRITE_DONE, - AIO_READ_DONE, - AIO_CLOSE -}; - -typedef union transfer_args -{ - struct - { - void (*transfer) (struct st_parameter_dt *, bt, void *, int, size_t, size_t); - bt arg_bt; - void *data; - int i; - size_t s1; - size_t s2; - } scalar; - struct - { - gfc_array_char *desc; - int kind; - gfc_charlen_type charlen; - } array; -} transfer_args; - -struct adv_cond -{ - int pending; - __gthread_mutex_t lock; - __gthread_cond_t signal; -}; - -typedef struct async_unit -{ - pthread_mutex_t lock; /* Lock for manipulating the queue structure. */ - pthread_mutex_t io_lock; /* Lock for doing actual I/O. */ - struct adv_cond work; - struct adv_cond emptysignal; - struct st_parameter_dt *pdt; - pthread_t thread; - struct transfer_queue *head; - struct transfer_queue *tail; - struct - { - int waiting; - int low; - int high; - struct adv_cond done; - } id; - - bool empty; - - struct { - const char *message; - st_parameter_common *cmp; - bool has_error; - int last_good_id; - int family; - bool fatal_error; - } error; - -} async_unit; - -void init_async_unit (gfc_unit *); -internal_proto (init_async_unit); - -bool async_wait (st_parameter_common *, async_unit *); -internal_proto (async_wait); - -bool async_wait_id (st_parameter_common *, async_unit *, int); -internal_proto (async_wait_id); - -bool collect_async_errors (st_parameter_common *, async_unit *); -internal_proto (collect_async_errors); - -void async_close (async_unit *); -internal_proto (async_close); - -void enqueue_transfer (async_unit * au, transfer_args * arg, enum aio_do); -internal_proto (enqueue_transfer); - -void enqueue_done (async_unit *, enum aio_do type); -internal_proto (enqueue_done); - -int enqueue_done_id (async_unit *, enum aio_do type); -internal_proto (enqueue_done_id); - -void enqueue_init (async_unit *); -internal_proto (enqueue_init); - -void enqueue_data_transfer_init (async_unit *, st_parameter_dt *, int); -internal_proto (enqueue_data_transfer_init); - -void enqueue_close (async_unit *); -internal_proto (enqueue_close); - -#endif diff --git a/libgfortran/io/close.c b/libgfortran/io/close.c index 36d9f94bb93..2117c40ac0d 100644 --- a/libgfortran/io/close.c +++ b/libgfortran/io/close.c @@ -24,7 +24,6 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see #include "io.h" #include "unix.h" -#include "async.h" #include typedef enum @@ -58,21 +57,13 @@ st_close (st_parameter_close *clp) find_option (&clp->common, clp->status, clp->status_len, status_opt, "Bad STATUS parameter in CLOSE statement"); - u = find_unit (clp->common.unit); - - if (u && u->au) - if (async_wait (&(clp->common), u->au)) - { - library_end (); - return; - } - if ((clp->common.flags & IOPARM_LIBRETURN_MASK) != IOPARM_LIBRETURN_OK) { library_end (); return; } + u = find_unit (clp->common.unit); if (u != NULL) { if (close_share (u) < 0) diff --git a/libgfortran/io/file_pos.c b/libgfortran/io/file_pos.c index 362885a37af..75f58f0f758 100644 --- a/libgfortran/io/file_pos.c +++ b/libgfortran/io/file_pos.c @@ -25,7 +25,6 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see #include "io.h" #include "fbuf.h" #include "unix.h" -#include "async.h" #include /* file_pos.c-- Implement the file positioning statements, i.e. BACKSPACE, @@ -188,7 +187,6 @@ void st_backspace (st_parameter_filepos *fpp) { gfc_unit *u; - bool needs_unlock = false; library_start (&fpp->common); @@ -216,17 +214,6 @@ st_backspace (st_parameter_filepos *fpp) goto done; } - if (u->au) - { - if (async_wait (&(fpp->common), u->au)) - return; - else - { - needs_unlock = true; - LOCK (&u->au->io_lock); - } - } - /* Make sure format buffer is flushed and reset. */ if (u->flags.form == FORM_FORMATTED) { @@ -280,12 +267,7 @@ st_backspace (st_parameter_filepos *fpp) done: if (u != NULL) - { - unlock_unit (u); - - if (u->au && needs_unlock) - UNLOCK (&u->au->io_lock); - } + unlock_unit (u); library_end (); } @@ -298,7 +280,6 @@ void st_endfile (st_parameter_filepos *fpp) { gfc_unit *u; - bool needs_unlock = false; library_start (&fpp->common); @@ -313,17 +294,6 @@ st_endfile (st_parameter_filepos *fpp) goto done; } - if (u->au) - { - if (async_wait (&(fpp->common), u->au)) - return; - else - { - needs_unlock = true; - LOCK (&u->au->io_lock); - } - } - if (u->flags.access == ACCESS_SEQUENTIAL && u->endfile == AFTER_ENDFILE) { @@ -406,11 +376,8 @@ st_endfile (st_parameter_filepos *fpp) } } - done: - if (u->au && needs_unlock) - UNLOCK (&u->au->io_lock); - - unlock_unit (u); + done: + unlock_unit (u); library_end (); } @@ -423,7 +390,6 @@ void st_rewind (st_parameter_filepos *fpp) { gfc_unit *u; - bool needs_unlock = true; library_start (&fpp->common); @@ -435,17 +401,6 @@ st_rewind (st_parameter_filepos *fpp) "Cannot REWIND a file opened for DIRECT access"); else { - if (u->au) - { - if (async_wait (&(fpp->common), u->au)) - return; - else - { - needs_unlock = true; - LOCK (&u->au->io_lock); - } - } - /* If there are previously written bytes from a write with ADVANCE="no", add a record marker before performing the ENDFILE. */ @@ -481,10 +436,6 @@ st_rewind (st_parameter_filepos *fpp) } /* Update position for INQUIRE. */ u->flags.position = POSITION_REWIND; - - if (u->au && needs_unlock) - UNLOCK (&u->au->io_lock); - unlock_unit (u); } @@ -499,24 +450,12 @@ void st_flush (st_parameter_filepos *fpp) { gfc_unit *u; - bool needs_unlock = false; library_start (&fpp->common); u = find_unit (fpp->common.unit); if (u != NULL) { - if (u->au) - { - if (async_wait (&(fpp->common), u->au)) - return; - else - { - needs_unlock = true; - LOCK (&u->au->io_lock); - } - } - /* Make sure format buffer is flushed. */ if (u->flags.form == FORM_FORMATTED) fbuf_flush (u, u->mode); @@ -530,8 +469,5 @@ st_flush (st_parameter_filepos *fpp) generate_error (&fpp->common, LIBERROR_BAD_OPTION, "Specified UNIT in FLUSH is not connected"); - if (needs_unlock) - UNLOCK (&u->au->io_lock); - library_end (); } diff --git a/libgfortran/io/inquire.c b/libgfortran/io/inquire.c index 4b6a6f5c1d3..047be39ec7a 100644 --- a/libgfortran/io/inquire.c +++ b/libgfortran/io/inquire.c @@ -26,7 +26,6 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see /* Implement the non-IOLENGTH variant of the INQUIRY statement */ #include "io.h" -#include "async.h" #include "unix.h" #include @@ -282,6 +281,12 @@ inquire_via_unit (st_parameter_inquire *iqp, gfc_unit *u) { GFC_INTEGER_4 cf2 = iqp->flags2; + if ((cf2 & IOPARM_INQUIRE_HAS_PENDING) != 0) + *iqp->pending = 0; + + if ((cf2 & IOPARM_INQUIRE_HAS_ID) != 0) + *iqp->id = 0; + if ((cf2 & IOPARM_INQUIRE_HAS_ENCODING) != 0) { if (u == NULL || u->flags.form != FORM_FORMATTED) @@ -327,41 +332,19 @@ inquire_via_unit (st_parameter_inquire *iqp, gfc_unit *u) if (u == NULL) p = undefined; else + switch (u->flags.async) { - switch (u->flags.async) - { - case ASYNC_YES: - p = yes; - break; - case ASYNC_NO: - p = no; - break; - default: - internal_error (&iqp->common, "inquire_via_unit(): Bad async"); - } + case ASYNC_YES: + p = yes; + break; + case ASYNC_NO: + p = no; + break; + default: + internal_error (&iqp->common, "inquire_via_unit(): Bad async"); } - cf_strcpy (iqp->asynchronous, iqp->asynchronous_len, p); - } - if ((cf2 & IOPARM_INQUIRE_HAS_PENDING) != 0) - { - if (u->au == NULL) - *(iqp->pending) = 0; - else - { - LOCK (&(u->au->lock)); - if ((cf2 & IOPARM_INQUIRE_HAS_ID) != 0) - { - int id; - id = *(iqp->id); - *(iqp->pending) = id > u->au->id.low; - } - else - { - *(iqp->pending) = ! u->au->empty; - } - UNLOCK (&(u->au->lock)); - } + cf_strcpy (iqp->asynchronous, iqp->asynchronous_len, p); } if ((cf2 & IOPARM_INQUIRE_HAS_SIGN) != 0) diff --git a/libgfortran/io/io.h b/libgfortran/io/io.h index d31213106ed..ccbaf47ff90 100644 --- a/libgfortran/io/io.h +++ b/libgfortran/io/io.h @@ -531,9 +531,7 @@ typedef struct st_parameter_dt /* A flag used to identify when a non-standard expanded namelist read has occurred. */ unsigned expanded_read : 1; - /* Flag to indicate if the statement has async="YES". */ - unsigned async : 1; - /* 12 unused bits. */ + /* 13 unused bits. */ int child_saved_iostat; int nml_delim; @@ -592,7 +590,7 @@ extern char check_st_parameter_dt[sizeof (((st_parameter_dt *) 0)->u.pad) typedef struct { st_parameter_common common; - GFC_INTEGER_4 *id; + CHARACTER1 (id); } st_parameter_wait; @@ -661,9 +659,6 @@ typedef struct gfc_unit int continued; - /* Contains the pointer to the async unit. */ - struct async_unit *au; - __gthread_mutex_t lock; /* Number of threads waiting to acquire this unit's lock. When non-zero, close_unit doesn't only removes the unit @@ -820,18 +815,11 @@ extern void next_record (st_parameter_dt *, int); internal_proto(next_record); extern void st_wait (st_parameter_wait *); -export_proto (st_wait); - -extern void st_wait_async (st_parameter_wait *); -export_proto (st_wait_async); +export_proto(st_wait); extern void hit_eof (st_parameter_dt *); internal_proto(hit_eof); -extern void transfer_array_inner (st_parameter_dt *, gfc_array_char *, int, - gfc_charlen_type); -internal_proto (transfer_array_inner); - /* read.c */ extern void set_integer (void *, GFC_INTEGER_LARGEST, int); @@ -1000,14 +988,3 @@ memset4 (gfc_char4_t *p, gfc_char4_t c, int k) #endif -extern void -st_write_done_worker (st_parameter_dt *); -internal_proto (st_write_done_worker); - -extern void -st_read_done_worker (st_parameter_dt *); -internal_proto (st_read_done_worker); - -extern void -data_transfer_init_worker (st_parameter_dt *, int); -internal_proto (data_transfer_init_worker); diff --git a/libgfortran/io/open.c b/libgfortran/io/open.c index 266033815fd..05aac8f6a8b 100644 --- a/libgfortran/io/open.c +++ b/libgfortran/io/open.c @@ -26,7 +26,6 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see #include "io.h" #include "fbuf.h" #include "unix.h" -#include "async.h" #ifdef HAVE_UNISTD_H #include @@ -652,12 +651,8 @@ new_unit (st_parameter_open *opp, gfc_unit *u, unit_flags *flags) else u->fbuf = NULL; - /* Check if asynchrounous. */ - if (flags->async == ASYNC_YES) - init_async_unit (u); - else - u->au = NULL; - + + return u; cleanup: diff --git a/libgfortran/io/read.c b/libgfortran/io/read.c index f972858c146..976020af448 100644 --- a/libgfortran/io/read.c +++ b/libgfortran/io/read.c @@ -30,7 +30,6 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see #include #include #include -#include "async.h" typedef unsigned char uchar; @@ -43,7 +42,6 @@ typedef unsigned char uchar; void set_integer (void *dest, GFC_INTEGER_LARGEST value, int length) { - NOTE ("set_integer: %lld %p", (long long int) value, dest); switch (length) { #ifdef HAVE_GFC_INTEGER_16 diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c index fa66e0f362d..df33bed1561 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 #include @@ -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; @@ -2506,36 +2470,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); } diff --git a/libgfortran/io/unit.c b/libgfortran/io/unit.c index 0d0ca8f6055..559dba92635 100644 --- a/libgfortran/io/unit.c +++ b/libgfortran/io/unit.c @@ -27,7 +27,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 #include @@ -241,7 +240,7 @@ insert_unit (int n) #else __GTHREAD_MUTEX_INIT_FUNCTION (&u->lock); #endif - LOCK (&u->lock); + __gthread_mutex_lock (&u->lock); u->priority = pseudo_random (); unit_root = insert (u, unit_root); return u; @@ -328,9 +327,7 @@ get_gfc_unit (int n, int do_create) gfc_unit *p; int c, created = 0; - NOTE ("Unit n=%d, do_create = %d", n, do_create); - LOCK (&unit_lock); - + __gthread_mutex_lock (&unit_lock); retry: for (c = 0; c < CACHE_SIZE; c++) if (unit_cache[c] != NULL && unit_cache[c]->unit_number == n) @@ -369,7 +366,7 @@ retry: { /* Newly created units have their lock held already from insert_unit. Just unlock UNIT_LOCK and return. */ - UNLOCK (&unit_lock); + __gthread_mutex_unlock (&unit_lock); return p; } @@ -377,10 +374,10 @@ found: if (p != NULL && (p->child_dtio == 0)) { /* Fast path. */ - if (! TRYLOCK (&p->lock)) + if (! __gthread_mutex_trylock (&p->lock)) { /* assert (p->closed == 0); */ - UNLOCK (&unit_lock); + __gthread_mutex_unlock (&unit_lock); return p; } @@ -388,15 +385,15 @@ found: } - UNLOCK (&unit_lock); + __gthread_mutex_unlock (&unit_lock); if (p != NULL && (p->child_dtio == 0)) { - LOCK (&p->lock); + __gthread_mutex_lock (&p->lock); if (p->closed) { - LOCK (&unit_lock); - UNLOCK (&p->lock); + __gthread_mutex_lock (&unit_lock); + __gthread_mutex_unlock (&p->lock); if (predec_waiting_locked (p) == 0) destroy_unit_mutex (p); goto retry; @@ -643,7 +640,7 @@ init_units (void) fbuf_init (u, 0); - UNLOCK (&u->lock); + __gthread_mutex_unlock (&u->lock); } if (options.stdout_unit >= 0) @@ -674,7 +671,7 @@ init_units (void) fbuf_init (u, 0); - UNLOCK (&u->lock); + __gthread_mutex_unlock (&u->lock); } if (options.stderr_unit >= 0) @@ -705,13 +702,13 @@ init_units (void) fbuf_init (u, 256); /* 256 bytes should be enough, probably not doing any kind of exotic formatting to stderr. */ - UNLOCK (&u->lock); + __gthread_mutex_unlock (&u->lock); } /* The default internal units. */ u = insert_unit (GFC_INTERNAL_UNIT); - UNLOCK (&u->lock); + __gthread_mutex_unlock (&u->lock); u = insert_unit (GFC_INTERNAL_UNIT4); - UNLOCK (&u->lock); + __gthread_mutex_unlock (&u->lock); } @@ -720,9 +717,6 @@ 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) @@ -732,7 +726,7 @@ close_unit_1 (gfc_unit *u, int locked) u->closed = 1; if (!locked) - LOCK (&unit_lock); + __gthread_mutex_lock (&unit_lock); for (i = 0; i < CACHE_SIZE; i++) if (unit_cache[i] == u) @@ -750,7 +744,7 @@ close_unit_1 (gfc_unit *u, int locked) newunit_free (u->unit_number); if (!locked) - UNLOCK (&u->lock); + __gthread_mutex_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 @@ -759,7 +753,7 @@ close_unit_1 (gfc_unit *u, int locked) destroy_unit_mutex (u); if (!locked) - UNLOCK (&unit_lock); + __gthread_mutex_unlock (&unit_lock); return rc; } @@ -767,9 +761,7 @@ close_unit_1 (gfc_unit *u, int locked) void unlock_unit (gfc_unit *u) { - NOTE ("unlock_unit = %d", u->unit_number); - UNLOCK (&u->lock); - NOTE ("unlock_unit done"); + __gthread_mutex_unlock (&u->lock); } /* close_unit()-- Close a unit. The stream is closed, and any memory @@ -793,10 +785,10 @@ close_unit (gfc_unit *u) void close_units (void) { - LOCK (&unit_lock); + __gthread_mutex_lock (&unit_lock); while (unit_root != NULL) close_unit_1 (unit_root, 1); - UNLOCK (&unit_lock); + __gthread_mutex_unlock (&unit_lock); free (newunits); @@ -903,7 +895,7 @@ finish_last_advance_record (gfc_unit *u) int newunit_alloc (void) { - LOCK (&unit_lock); + __gthread_mutex_lock (&unit_lock); if (!newunits) { newunits = xcalloc (16, 1); @@ -917,7 +909,7 @@ newunit_alloc (void) { newunits[ii] = true; newunit_lwi = ii + 1; - UNLOCK (&unit_lock); + __gthread_mutex_unlock (&unit_lock); return -ii + NEWUNIT_START; } } @@ -930,7 +922,7 @@ newunit_alloc (void) memset (newunits + old_size, 0, old_size); newunits[old_size] = true; newunit_lwi = old_size + 1; - UNLOCK (&unit_lock); + __gthread_mutex_unlock (&unit_lock); return -old_size + NEWUNIT_START; } diff --git a/libgfortran/io/unix.c b/libgfortran/io/unix.c index 4a133fd44bd..a8fd07a5f3b 100644 --- a/libgfortran/io/unix.c +++ b/libgfortran/io/unix.c @@ -27,7 +27,6 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see #include "io.h" #include "unix.h" -#include "async.h" #include #ifdef HAVE_UNISTD_H @@ -1743,7 +1742,7 @@ find_file (const char *file, gfc_charlen_type file_len) id = id_from_path (path); #endif - LOCK (&unit_lock); + __gthread_mutex_lock (&unit_lock); retry: u = find_file0 (unit_root, FIND_FILE0_ARGS); if (u != NULL) @@ -1752,20 +1751,20 @@ retry: if (! __gthread_mutex_trylock (&u->lock)) { /* assert (u->closed == 0); */ - UNLOCK (&unit_lock); + __gthread_mutex_unlock (&unit_lock); goto done; } inc_waiting_locked (u); } - UNLOCK (&unit_lock); + __gthread_mutex_unlock (&unit_lock); if (u != NULL) { - LOCK (&u->lock); + __gthread_mutex_lock (&u->lock); if (u->closed) { - LOCK (&unit_lock); - UNLOCK (&u->lock); + __gthread_mutex_lock (&unit_lock); + __gthread_mutex_unlock (&u->lock); if (predec_waiting_locked (u) == 0) free (u); goto retry; @@ -1795,7 +1794,7 @@ flush_all_units_1 (gfc_unit *u, int min_unit) return u; if (u->s) sflush (u->s); - UNLOCK (&u->lock); + __gthread_mutex_unlock (&u->lock); } u = u->right; } @@ -1808,31 +1807,31 @@ flush_all_units (void) gfc_unit *u; int min_unit = 0; - LOCK (&unit_lock); + __gthread_mutex_lock (&unit_lock); do { u = flush_all_units_1 (unit_root, min_unit); if (u != NULL) inc_waiting_locked (u); - UNLOCK (&unit_lock); + __gthread_mutex_unlock (&unit_lock); if (u == NULL) return; - LOCK (&u->lock); + __gthread_mutex_lock (&u->lock); min_unit = u->unit_number + 1; if (u->closed == 0) { sflush (u->s); - LOCK (&unit_lock); - UNLOCK (&u->lock); + __gthread_mutex_lock (&unit_lock); + __gthread_mutex_unlock (&u->lock); (void) predec_waiting_locked (u); } else { - LOCK (&unit_lock); - UNLOCK (&u->lock); + __gthread_mutex_lock (&unit_lock); + __gthread_mutex_unlock (&u->lock); if (predec_waiting_locked (u) == 0) free (u); } diff --git a/libgfortran/libgfortran.h b/libgfortran/libgfortran.h index b5a742aac88..2b75fbf904d 100644 --- a/libgfortran/libgfortran.h +++ b/libgfortran/libgfortran.h @@ -738,9 +738,6 @@ internal_proto(translate_error); extern void generate_error (st_parameter_common *, int, const char *); iexport_proto(generate_error); -extern bool generate_error_common (st_parameter_common *, int, const char *); -iexport_proto(generate_error_common); - extern void generate_warning (st_parameter_common *, const char *); internal_proto(generate_warning); @@ -1746,7 +1743,5 @@ void cshift1_16_c16 (gfc_array_c16 * const restrict, internal_proto(cshift1_16_c16); #endif -/* Define this if we support asynchronous I/O on this platform. This - currently requires weak symbols. */ #endif /* LIBGFOR_H */ diff --git a/libgfortran/runtime/error.c b/libgfortran/runtime/error.c index 811d86b0737..1a53e2f72f1 100644 --- a/libgfortran/runtime/error.c +++ b/libgfortran/runtime/error.c @@ -24,9 +24,6 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see #include "libgfortran.h" -#include "io.h" -#include "async.h" - #include #include #include @@ -529,38 +526,24 @@ translate_error (int code) } -/* Worker function for generate_error and generate_error_async. Return true - if a straight return is to be done, zero if the program should abort. */ +/* generate_error()-- Come here when an error happens. This + * subroutine is called if it is possible to continue on after the error. + * If an IOSTAT or IOMSG variable exists, we set it. If IOSTAT or + * ERR labels are present, we return, otherwise we terminate the program + * after printing a message. The error code is always required but the + * message parameter can be NULL, in which case a string describing + * the most recent operating system error is used. */ -bool -generate_error_common (st_parameter_common *cmp, int family, const char *message) +void +generate_error (st_parameter_common *cmp, int family, const char *message) { char errmsg[STRERR_MAXSZ]; - gfc_unit *u; - - NOTE ("Entering generate_error_common"); - - u = thread_unit; - if (u && u->au) - { - if (u->au->error.has_error) - return true; - - if (__gthread_equal (u->au->thread, __gthread_self ())) - { - u->au->error.has_error = 1; - u->au->error.cmp = cmp; - u->au->error.family = family; - u->au->error.message = message; - return true; - } - } /* If there was a previous error, don't mask it with another error message, EOF or EOR condition. */ if ((cmp->flags & IOPARM_LIBRETURN_MASK) == IOPARM_LIBRETURN_ERROR) - return true; + return; /* Set the error status. */ if ((cmp->flags & IOPARM_HAS_IOSTAT)) @@ -579,56 +562,36 @@ generate_error_common (st_parameter_common *cmp, int family, const char *message switch (family) { case LIBERROR_EOR: - cmp->flags |= IOPARM_LIBRETURN_EOR; NOTE("EOR"); + cmp->flags |= IOPARM_LIBRETURN_EOR; if ((cmp->flags & IOPARM_EOR)) - return true; + return; break; case LIBERROR_END: - cmp->flags |= IOPARM_LIBRETURN_END; NOTE("END"); + cmp->flags |= IOPARM_LIBRETURN_END; if ((cmp->flags & IOPARM_END)) - return true; + return; break; default: - cmp->flags |= IOPARM_LIBRETURN_ERROR; NOTE("ERROR"); + cmp->flags |= IOPARM_LIBRETURN_ERROR; if ((cmp->flags & IOPARM_ERR)) - return true; + return; break; } /* Return if the user supplied an iostat variable. */ if ((cmp->flags & IOPARM_HAS_IOSTAT)) - return true; + return; - /* Return code, caller is responsible for terminating - the program if necessary. */ + /* Terminate the program */ recursion_check (); show_locus (cmp); estr_write ("Fortran runtime error: "); estr_write (message); estr_write ("\n"); - return false; -} - -/* generate_error()-- Come here when an error happens. This - * subroutine is called if it is possible to continue on after the error. - * If an IOSTAT or IOMSG variable exists, we set it. If IOSTAT or - * ERR labels are present, we return, otherwise we terminate the program - * after printing a message. The error code is always required but the - * message parameter can be NULL, in which case a string describing - * the most recent operating system error is used. - * If the error is for an asynchronous unit and if the program is currently - * executing the asynchronous thread, just mark the error and return. */ - -void -generate_error (st_parameter_common *cmp, int family, const char *message) -{ - if (generate_error_common (cmp, family, message)) - return; - - exit_error(2); + exit_error (2); } iexport(generate_error); diff --git a/libgomp/ChangeLog b/libgomp/ChangeLog index 6cd30bbf49d..0cce3715b84 100644 --- a/libgomp/ChangeLog +++ b/libgomp/ChangeLog @@ -1,3 +1,18 @@ +2018-07-31 Andre Vieira + + Revert 'AsyncI/O patch committed'. + 2018-07-25 Nicolas Koenig + Thomas Koenig + + 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. + 2018-07-30 Tom de Vries * plugin/plugin-nvptx.c (MIN, MAX): Redefine. diff --git a/libgomp/testsuite/libgomp.fortran/async_io_1.f90 b/libgomp/testsuite/libgomp.fortran/async_io_1.f90 deleted file mode 100644 index 07721bb230a..00000000000 --- a/libgomp/testsuite/libgomp.fortran/async_io_1.f90 +++ /dev/null @@ -1,48 +0,0 @@ -! { dg-do run } -!TODO: Move these testcases to gfortran testsuite -! once compilation with pthreads is supported there -! Check basic functionality of async I/O -program main - implicit none - integer:: i=1, j=2, k, l - real :: a, b, c, d - character(3), parameter:: yes="yes" - character(4) :: str - complex :: cc, dd - integer, dimension(4):: is = [0, 1, 2, 3] - integer, dimension(4):: res - character(10) :: inq - - open (10, file='a.dat', asynchronous=yes) - cc = (1.5, 0.5) - inquire (10,asynchronous=inq) - if (inq /= "YES") stop 1 - write (10,*,asynchronous=yes) 4, 3 - write (10,*,asynchronous=yes) 2, 1 - write (10,*,asynchronous=yes) 1.0, 3.0 - write (10,'(A)', asynchronous=yes) 'asdf' - write (10,*, asynchronous=yes) cc - close (10) - open (20, file='a.dat', asynchronous=yes) - read (20, *, asynchronous=yes) i, j - read (20, *, asynchronous=yes) k, l - read (20, *, asynchronous=yes) a, b - read (20,'(A4)',asynchronous=yes) str - read (20,*, asynchronous=yes) dd - wait (20) - if (i /= 4 .or. j /= 3) stop 2 - if (k /= 2 .or. l /= 1) stop 3 - if (a /= 1.0 .or. b /= 3.0) stop 4 - if (str /= 'asdf') stop 5 - if (cc /= dd) stop 6 - close (20,status="delete") - - open(10, file='c.dat', asynchronous=yes) - write(10, *, asynchronous=yes) is - close(10) - open(20, file='c.dat', asynchronous=yes) - read(20, *, asynchronous=yes) res - wait (20) - if (any(res /= is)) stop 7 - close (20,status="delete") -end program diff --git a/libgomp/testsuite/libgomp.fortran/async_io_2.f90 b/libgomp/testsuite/libgomp.fortran/async_io_2.f90 deleted file mode 100644 index 440d46e9463..00000000000 --- a/libgomp/testsuite/libgomp.fortran/async_io_2.f90 +++ /dev/null @@ -1,18 +0,0 @@ -! { dg-do run } -!TODO: Move these testcases to gfortran testsuite -! once compilation with pthreads is supported there -program main - implicit none - integer :: i, ios - character(len=100) :: iom - open (10,file="tst.dat") - write (10,'(A4)') 'asdf' - close(10) - i = 234 - open(10,file="tst.dat", asynchronous="yes") - read (10,'(I4)',asynchronous="yes") i - iom = ' ' - wait (10,iostat=ios,iomsg=iom) - if (iom == ' ') stop 1 - close(10,status="delete") -end program main diff --git a/libgomp/testsuite/libgomp.fortran/async_io_3.f90 b/libgomp/testsuite/libgomp.fortran/async_io_3.f90 deleted file mode 100644 index 7d5124868cf..00000000000 --- a/libgomp/testsuite/libgomp.fortran/async_io_3.f90 +++ /dev/null @@ -1,16 +0,0 @@ - -!TODO: Move these testcases to gfortran testsuite -! once compilation with pthreads is supported there -! { dg-do run } -program main - integer :: i - open (10,file="tst.dat") - write (10,'(A4)') 'asdf' - close(10) - i = 234 - open(10,file="tst.dat", asynchronous="yes") - read (10,'(I4)',asynchronous="yes") i - wait(10) -end program main -! { dg-output "Fortran runtime error: Bad value during integer read" } -! { dg-final { remote_file build delete "tst.dat" } } diff --git a/libgomp/testsuite/libgomp.fortran/async_io_4.f90 b/libgomp/testsuite/libgomp.fortran/async_io_4.f90 deleted file mode 100644 index a21ffaef478..00000000000 --- a/libgomp/testsuite/libgomp.fortran/async_io_4.f90 +++ /dev/null @@ -1,90 +0,0 @@ -! { dg-do run { target fd_truncate } } -!TODO: Move these testcases to gfortran testsuite -! once compilation with pthreads is supported there - -! Test BACKSPACE for synchronous and asynchronous I/O -program main - - integer i, n, nr - real x(10), y(10) - - ! PR libfortran/20068 - open (20, status='scratch', asynchronous="yes") - write (20,*, asynchronous="yes" ) 1 - write (20,*, asynchronous="yes") 2 - write (20,*, asynchronous="yes") 3 - rewind (20) - i = 41 - read (20,*, asynchronous="yes") i - wait (20) - if (i .ne. 1) STOP 1 - write (*,*) ' ' - backspace (20) - i = 42 - read (20,*, asynchronous="yes") i - close (20) - if (i .ne. 1) STOP 2 - - ! PR libfortran/20125 - open (20, status='scratch', asynchronous="yes") - write (20,*, asynchronous="yes") 7 - backspace (20) - read (20,*, asynchronous="yes") i - wait (20) - if (i .ne. 7) STOP 3 - close (20) - - open (20, status='scratch', form='unformatted') - write (20) 8 - backspace (20) - read (20) i - if (i .ne. 8) STOP 4 - close (20) - - ! PR libfortran/20471 - do n = 1, 10 - x(n) = sqrt(real(n)) - end do - open (3, form='unformatted', status='scratch') - write (3) (x(n),n=1,10) - backspace (3) - rewind (3) - read (3) (y(n),n=1,10) - - do n = 1, 10 - if (abs(x(n)-y(n)) > 0.00001) STOP 5 - end do - close (3) - - ! PR libfortran/20156 - open (3, form='unformatted', status='scratch') - do i = 1, 5 - x(1) = i - write (3) n, (x(n),n=1,10) - end do - nr = 0 - rewind (3) -20 continue - read (3,end=30,err=90) n, (x(n),n=1,10) - nr = nr + 1 - goto 20 -30 continue - if (nr .ne. 5) STOP 6 - - do i = 1, nr+1 - backspace (3) - end do - - do i = 1, nr - read(3,end=70,err=90) n, (x(n),n=1,10) - if (abs(x(1) - i) .gt. 0.001) STOP 7 - end do - close (3) - stop - -70 continue - STOP 8 -90 continue - STOP 9 - -end program diff --git a/libgomp/testsuite/libgomp.fortran/async_io_5.f90 b/libgomp/testsuite/libgomp.fortran/async_io_5.f90 deleted file mode 100644 index 916e78aa001..00000000000 --- a/libgomp/testsuite/libgomp.fortran/async_io_5.f90 +++ /dev/null @@ -1,132 +0,0 @@ -! { dg-do run } -!TODO: Move these testcases to gfortran testsuite -! once compilation with pthreads is supported there -! PR55818 Reading a REAL from a file which doesn't end in a new line fails -! Test case from PR reporter. -implicit none -integer :: stat -!integer :: var ! << works -real :: var ! << fails -character(len=10) :: cvar ! << fails -complex :: cval -logical :: lvar - -open(99, file="test.dat", access="stream", form="unformatted", status="new") -write(99) "1", new_line("") -write(99) "2", new_line("") -write(99) "3" -close(99) - -! Test character kind -open(99, file="test.dat") -read (99,*, iostat=stat) cvar -if (stat /= 0 .or. cvar /= "1") STOP 1 -read (99,*, iostat=stat) cvar -if (stat /= 0 .or. cvar /= "2") STOP 2 -read (99,*, iostat=stat) cvar ! << FAILS: stat /= 0 -if (stat /= 0 .or. cvar /= "3") STOP 3 ! << aborts here - -! Test real kind -rewind(99) -read (99,*, iostat=stat) var -if (stat /= 0 .or. var /= 1.0) STOP 4 -read (99,*, iostat=stat) var -if (stat /= 0 .or. var /= 2.0) STOP 5 -read (99,*, iostat=stat) var ! << FAILS: stat /= 0 -if (stat /= 0 .or. var /= 3.0) STOP 6 -close(99, status="delete") - -! Test real kind with exponents -open(99, file="test.dat", access="stream", form="unformatted", status="new") -write(99) "1.0e3", new_line("") -write(99) "2.0e-03", new_line("") -write(99) "3.0e2" -close(99) - -open(99, file="test.dat") -read (99,*, iostat=stat) var -if (stat /= 0) STOP 7 -read (99,*, iostat=stat) var -if (stat /= 0) STOP 8 -read (99,*) var ! << FAILS: stat /= 0 -if (stat /= 0) STOP 9 -close(99, status="delete") - -! Test logical kind -open(99, file="test.dat", access="stream", form="unformatted", status="new") -write(99) "Tru", new_line("") -write(99) "fal", new_line("") -write(99) "t" -close(99) - -open(99, file="test.dat") -read (99,*, iostat=stat) lvar -if (stat /= 0 .or. (.not.lvar)) STOP 10 -read (99,*, iostat=stat) lvar -if (stat /= 0 .or. lvar) STOP 11 -read (99,*) lvar ! << FAILS: stat /= 0 -if (stat /= 0 .or. (.not.lvar)) STOP 12 -close(99, status="delete") - -! Test combinations of Inf and Nan -open(99, file="test.dat", access="stream", form="unformatted", status="new") -write(99) "infinity", new_line("") -write(99) "nan", new_line("") -write(99) "infinity" -close(99) - -open(99, file="test.dat") -read (99,*, iostat=stat) var -if (stat /= 0) STOP 13 -read (99,*, iostat=stat) var -if (stat /= 0) STOP 14 -read (99,*) var ! << FAILS: stat /= 0 -if (stat /= 0) STOP 1! << aborts here -close(99, status="delete") - -open(99, file="test.dat", access="stream", form="unformatted", status="new") -write(99) "infinity", new_line("") -write(99) "inf", new_line("") -write(99) "nan" -close(99) - -open(99, file="test.dat") -read (99,*, iostat=stat) var -if (stat /= 0) STOP 15 -read (99,*, iostat=stat) var -if (stat /= 0) STOP 16 -read (99,*) var ! << FAILS: stat /= 0 -if (stat /= 0) STOP 2! << aborts here -close(99, status="delete") - -open(99, file="test.dat", access="stream", form="unformatted", status="new") -write(99) "infinity", new_line("") -write(99) "nan", new_line("") -write(99) "inf" -close(99) - -open(99, file="test.dat") -read (99,*, iostat=stat) var -if (stat /= 0) STOP 17 -read (99,*, iostat=stat) var -if (stat /= 0) STOP 18 -read (99,*) var ! << FAILS: stat /= 0 -if (stat /= 0) STOP 3! << aborts here -close(99, status="delete") - -! Test complex kind -open(99, file="test.dat", access="stream", form="unformatted", status="new") -write(99) "(1,2)", new_line("") -write(99) "(2,3)", new_line("") -write(99) "(4,5)" -close(99) - -open(99, file="test.dat") -read (99,*, iostat=stat) cval -if (stat /= 0 .or. cval /= cmplx(1,2)) STOP 19 -read (99,*, iostat=stat) cval -if (stat /= 0 .or. cval /= cmplx(2,3)) STOP 20 -read (99,*, iostat=stat) cval ! << FAILS: stat /= 0, value is okay -if (stat /= 0 .or. cval /= cmplx(4,5)) STOP 21 -close(99, status="delete") -end diff --git a/libgomp/testsuite/libgomp.fortran/async_io_6.f90 b/libgomp/testsuite/libgomp.fortran/async_io_6.f90 deleted file mode 100644 index f19c0379202..00000000000 --- a/libgomp/testsuite/libgomp.fortran/async_io_6.f90 +++ /dev/null @@ -1,30 +0,0 @@ -! { dg-do run } -!TODO: Move these testcases to gfortran testsuite -! once compilation with pthreads is supported there -! PR 22390 Implement flush statement -program flush_1 - - character(len=256) msg - integer ios - - open (unit=10, access='SEQUENTIAL', status='SCRATCH') - - write (10, *) 42 - flush 10 - - write (10, *) 42 - flush(10) - - write (10, *) 42 - flush(unit=10, iostat=ios) - if (ios /= 0) STOP 1 - - write (10, *) 42 - flush (unit=10, err=20) - goto 30 -20 STOP 2 -30 continue - - call flush(10) - -end program flush_1 diff --git a/libgomp/testsuite/libgomp.fortran/async_io_7.f90 b/libgomp/testsuite/libgomp.fortran/async_io_7.f90 deleted file mode 100644 index a7ce9ba47a7..00000000000 --- a/libgomp/testsuite/libgomp.fortran/async_io_7.f90 +++ /dev/null @@ -1,22 +0,0 @@ -! { dg-do run } -!TODO: Move these testcases to gfortran testsuite -! once compilation with pthreads is supported there -! PR40008 F2008: Add NEWUNIT= for OPEN statement -! Contributed by Jerry DeLisle -program newunit_1 - character(len=25) :: str - integer(1) :: myunit, myunit2 - myunit = 25 - str = "bad" - open(newunit=myunit, status="scratch") - open(newunit = myunit2, file="newunit_1file") - write(myunit,'(e24.15e2)') 1.0d0 - write(myunit2,*) "abcdefghijklmnop" - flush(myunit) - rewind(myunit) - rewind(myunit2) - read(myunit2,'(a)') str - if (str.ne." abcdefghijklmnop") STOP 1 - close(myunit) - close(myunit2, status="delete") -end program newunit_1 -- 2.30.2