diff mbox series

Use vectored writes when reporting errors and warnings.

Message ID 20180912191733.24547-1-blomqvist.janne@gmail.com
State New
Headers show
Series Use vectored writes when reporting errors and warnings. | expand

Commit Message

Janne Blomqvist Sept. 12, 2018, 7:17 p.m. UTC
When producing error and warning messages, libgfortran writes a
message by using many system calls.  By using vectored writes (the
POSIX writev function) when available and feasible to use without
major surgery, we reduce the chance that output gets intermingled with
other output to stderr.

In practice, this is done by introducing a new function estr_writev in
addition to the existing estr_write.  In order to use this, the old
st_vprintf is removed, replaced by direct calls of vsnprintf, allowing
more message batching.

Regtested on x86_64-pc-linux-gnu, Ok for trunk?

libgfortran/ChangeLog:

2018-09-12  Janne Blomqvist  <jb@gcc.gnu.org>

	* config.h.in: Regenerated.
	* configure: Regenerated.
	* configure.ac: Check for writev and sys/uio.h.
	* libgfortran.h: Include sys/uio.h.
	(st_vprintf): Remove prototype.
	(struct iovec): Define if not available.
	(estr_writev): New prototype.
	* runtime/backtrace.c (error_callback): Use estr_writev.
	* runtime/error.c (ST_VPRINTF_SIZE): Remove.
	(estr_writev): New function.
	(st_vprintf): Remove.
	(gf_vsnprintf): New function.
	(ST_ERRBUF_SIZE): New macro.
	(st_printf): Use vsnprintf.
	(os_error): Use estr_writev.
	(runtime_error): Use vsnprintf and estr_writev.
	(runtime_error_at): Likewise.
	(runtime_warning_at): Likewise.
	(internal_error): Use estr_writev.
	(generate_error_common): Likewise.
	(generate_warning): Likewise.
	(notify_std): Likewise.
	* runtime/pause.c (pause_string): Likewise.
	* runtime/stop.c (report_exception): Likewise.
	(stop_string): Likewise.
	(error_stop_string): Likewise.
---
 libgfortran/config.h.in         |   6 +
 libgfortran/configure           |  10 +-
 libgfortran/configure.ac        |   4 +-
 libgfortran/libgfortran.h       |  15 ++-
 libgfortran/runtime/backtrace.c |  27 +++--
 libgfortran/runtime/error.c     | 188 +++++++++++++++++++++++---------
 libgfortran/runtime/pause.c     |  14 ++-
 libgfortran/runtime/stop.c      |  71 +++++++++---
 8 files changed, 250 insertions(+), 85 deletions(-)

Comments

Janne Blomqvist Sept. 21, 2018, 8:41 a.m. UTC | #1
PING

On Wed, Sep 12, 2018 at 10:17 PM Janne Blomqvist <blomqvist.janne@gmail.com>
wrote:

> When producing error and warning messages, libgfortran writes a
> message by using many system calls.  By using vectored writes (the
> POSIX writev function) when available and feasible to use without
> major surgery, we reduce the chance that output gets intermingled with
> other output to stderr.
>
> In practice, this is done by introducing a new function estr_writev in
> addition to the existing estr_write.  In order to use this, the old
> st_vprintf is removed, replaced by direct calls of vsnprintf, allowing
> more message batching.
>
> Regtested on x86_64-pc-linux-gnu, Ok for trunk?
>
> libgfortran/ChangeLog:
>
> 2018-09-12  Janne Blomqvist  <jb@gcc.gnu.org>
>
>         * config.h.in: Regenerated.
>         * configure: Regenerated.
>         * configure.ac: Check for writev and sys/uio.h.
>         * libgfortran.h: Include sys/uio.h.
>         (st_vprintf): Remove prototype.
>         (struct iovec): Define if not available.
>         (estr_writev): New prototype.
>         * runtime/backtrace.c (error_callback): Use estr_writev.
>         * runtime/error.c (ST_VPRINTF_SIZE): Remove.
>         (estr_writev): New function.
>         (st_vprintf): Remove.
>         (gf_vsnprintf): New function.
>         (ST_ERRBUF_SIZE): New macro.
>         (st_printf): Use vsnprintf.
>         (os_error): Use estr_writev.
>         (runtime_error): Use vsnprintf and estr_writev.
>         (runtime_error_at): Likewise.
>         (runtime_warning_at): Likewise.
>         (internal_error): Use estr_writev.
>         (generate_error_common): Likewise.
>         (generate_warning): Likewise.
>         (notify_std): Likewise.
>         * runtime/pause.c (pause_string): Likewise.
>         * runtime/stop.c (report_exception): Likewise.
>         (stop_string): Likewise.
>         (error_stop_string): Likewise.
> ---
>  libgfortran/config.h.in         |   6 +
>  libgfortran/configure           |  10 +-
>  libgfortran/configure.ac        |   4 +-
>  libgfortran/libgfortran.h       |  15 ++-
>  libgfortran/runtime/backtrace.c |  27 +++--
>  libgfortran/runtime/error.c     | 188 +++++++++++++++++++++++---------
>  libgfortran/runtime/pause.c     |  14 ++-
>  libgfortran/runtime/stop.c      |  71 +++++++++---
>  8 files changed, 250 insertions(+), 85 deletions(-)
>
> diff --git a/libgfortran/config.h.in b/libgfortran/config.h.in
> index 65fd27c6b11..c7f47146030 100644
> --- a/libgfortran/config.h.in
> +++ b/libgfortran/config.h.in
> @@ -762,6 +762,9 @@
>  /* Define to 1 if you have the <sys/types.h> header file. */
>  #undef HAVE_SYS_TYPES_H
>
> +/* Define to 1 if you have the <sys/uio.h> header file. */
> +#undef HAVE_SYS_UIO_H
> +
>  /* Define to 1 if you have the <sys/wait.h> header file. */
>  #undef HAVE_SYS_WAIT_H
>
> @@ -828,6 +831,9 @@
>  /* Define if target has a reliable stat. */
>  #undef HAVE_WORKING_STAT
>
> +/* Define to 1 if you have the `writev' function. */
> +#undef HAVE_WRITEV
> +
>  /* Define to 1 if you have the <xlocale.h> header file. */
>  #undef HAVE_XLOCALE_H
>
> diff --git a/libgfortran/configure b/libgfortran/configure
> index a583b676a3e..1c93683acd2 100755
> --- a/libgfortran/configure
> +++ b/libgfortran/configure
> @@ -2553,6 +2553,7 @@ as_fn_append ac_header_list " sys/times.h"
>  as_fn_append ac_header_list " sys/resource.h"
>  as_fn_append ac_header_list " sys/types.h"
>  as_fn_append ac_header_list " sys/stat.h"
> +as_fn_append ac_header_list " sys/uio.h"
>  as_fn_append ac_header_list " sys/wait.h"
>  as_fn_append ac_header_list " floatingpoint.h"
>  as_fn_append ac_header_list " ieeefp.h"
> @@ -2584,6 +2585,7 @@ as_fn_append ac_func_list " access"
>  as_fn_append ac_func_list " fork"
>  as_fn_append ac_func_list " setmode"
>  as_fn_append ac_func_list " fcntl"
> +as_fn_append ac_func_list " writev"
>  as_fn_append ac_func_list " gettimeofday"
>  as_fn_append ac_func_list " stat"
>  as_fn_append ac_func_list " fstat"
> @@ -12514,7 +12516,7 @@ else
>    lt_dlunknown=0; lt_dlno_uscore=1; lt_dlneed_uscore=2
>    lt_status=$lt_dlunknown
>    cat > conftest.$ac_ext <<_LT_EOF
> -#line 12517 "configure"
> +#line 12519 "configure"
>  #include "confdefs.h"
>
>  #if HAVE_DLFCN_H
> @@ -12620,7 +12622,7 @@ else
>    lt_dlunknown=0; lt_dlno_uscore=1; lt_dlneed_uscore=2
>    lt_status=$lt_dlunknown
>    cat > conftest.$ac_ext <<_LT_EOF
> -#line 12623 "configure"
> +#line 12625 "configure"
>  #include "confdefs.h"
>
>  #if HAVE_DLFCN_H
> @@ -16168,6 +16170,8 @@ done
>
>
>
> +
> +
>
>
>
> @@ -16763,6 +16767,8 @@ done
>
>
>
> +
> +
>
>
>
> diff --git a/libgfortran/configure.ac b/libgfortran/configure.ac
> index 05952aa0d40..64f7b9a39d5 100644
> --- a/libgfortran/configure.ac
> +++ b/libgfortran/configure.ac
> @@ -276,7 +276,7 @@ AC_CHECK_TYPES([ptrdiff_t])
>
>  # check header files (we assume C89 is available, so don't check for that)
>  AC_CHECK_HEADERS_ONCE(unistd.h sys/random.h sys/time.h sys/times.h \
> -sys/resource.h sys/types.h sys/stat.h sys/wait.h \
> +sys/resource.h sys/types.h sys/stat.h sys/uio.h sys/wait.h \
>  floatingpoint.h ieeefp.h fenv.h fptrap.h \
>  fpxcp.h pwd.h complex.h xlocale.h)
>
> @@ -315,7 +315,7 @@ else
>     AC_CHECK_FUNCS_ONCE(getrusage times mkstemp strtof strtold snprintf \
>     ftruncate chsize chdir getentropy getlogin gethostname kill link
> symlink \
>     sleep ttyname \
> -   alarm access fork setmode fcntl \
> +   alarm access fork setmode fcntl writev \
>     gettimeofday stat fstat lstat getpwuid vsnprintf dup \
>     getcwd localtime_r gmtime_r getpwuid_r ttyname_r clock_gettime \
>     getgid getpid getuid geteuid umask getegid \
> diff --git a/libgfortran/libgfortran.h b/libgfortran/libgfortran.h
> index b5a742aac88..1179812310b 100644
> --- a/libgfortran/libgfortran.h
> +++ b/libgfortran/libgfortran.h
> @@ -88,6 +88,10 @@ extern long double __strtold (const char *, char **);
>  #include <sys/types.h>
>  #endif
>
> +#ifdef HAVE_SYS_UIO_H
> +#include <sys/uio.h>
> +#endif
> +
>  #ifdef __MINGW32__
>  typedef off64_t gfc_offset;
>  #else
> @@ -701,8 +705,15 @@ internal_proto(exit_error);
>  extern ssize_t estr_write (const char *);
>  internal_proto(estr_write);
>
> -extern int st_vprintf (const char *, va_list);
> -internal_proto(st_vprintf);
> +#if !defined(HAVE_WRITEV) && !defined(HAVE_SYS_UIO_H)
> +struct iovec {
> +  void  *iov_base;    /* Starting address */
> +  size_t iov_len;     /* Number of bytes to transfer */
> +};
> +#endif
> +
> +extern ssize_t estr_writev (const struct iovec *iov, int iovcnt);
> +internal_proto(estr_writev);
>
>  extern int st_printf (const char *, ...)
>    __attribute__((format (gfc_printf, 1, 2)));
> diff --git a/libgfortran/runtime/backtrace.c
> b/libgfortran/runtime/backtrace.c
> index b8246889fde..e0c277044b6 100644
> --- a/libgfortran/runtime/backtrace.c
> +++ b/libgfortran/runtime/backtrace.c
> @@ -68,6 +68,7 @@ static void
>  error_callback (void *data, const char *msg, int errnum)
>  {
>    struct mystate *state = (struct mystate *) data;
> +  struct iovec iov[5];
>  #define ERRHDR "\nCould not print backtrace: "
>
>    if (errnum < 0)
> @@ -77,21 +78,31 @@ error_callback (void *data, const char *msg, int
> errnum)
>      }
>    else if (errnum == 0)
>      {
> -      estr_write (ERRHDR);
> -      estr_write (msg);
> -      estr_write ("\n");
> +      iov[0].iov_base = (char*) ERRHDR;
> +      iov[0].iov_len = strlen (ERRHDR);
> +      iov[1].iov_base = (char*) msg;
> +      iov[1].iov_len = strlen (msg);
> +      iov[2].iov_base = (char*) "\n";
> +      iov[2].iov_len = 1;
> +      estr_writev (iov, 3);
>      }
>    else
>      {
>        char errbuf[256];
>        if (state->in_signal_handler)
>         {
> -         estr_write (ERRHDR);
> -         estr_write (msg);
> -         estr_write (", errno: ");
> +         iov[0].iov_base = (char*) ERRHDR;
> +         iov[0].iov_len = strlen (ERRHDR);
> +         iov[1].iov_base = (char*) msg;
> +         iov[1].iov_len = strlen (msg);
> +         iov[2].iov_base = (char*) ", errno: ";
> +         iov[2].iov_len = strlen (iov[2].iov_base);
>           const char *p = gfc_itoa (errnum, errbuf, sizeof (errbuf));
> -         estr_write (p);
> -         estr_write ("\n");
> +         iov[3].iov_base = (char*) p;
> +         iov[3].iov_len = strlen (p);
> +         iov[4].iov_base = (char*) "\n";
> +         iov[4].iov_len = 1;
> +         estr_writev (iov, 5);
>         }
>        else
>         st_printf (ERRHDR "%s: %s\n", msg,
> diff --git a/libgfortran/runtime/error.c b/libgfortran/runtime/error.c
> index 1e8b6223aca..b07a4c0b12a 100644
> --- a/libgfortran/runtime/error.c
> +++ b/libgfortran/runtime/error.c
> @@ -114,52 +114,71 @@ estr_write (const char *str)
>  }
>
>
> -/* st_vprintf()-- vsnprintf-like function for error output.  We use a
> -   stack allocated buffer for formatting; since this function might be
> -   called from within a signal handler, printing directly to stderr
> -   with vfprintf is not safe since the stderr locking might lead to a
> -   deadlock.  */
> +/* Write a vector of strings to standard error.  This function is
> +   async-signal-safe.  */
>
> -#define ST_VPRINTF_SIZE 512
> +ssize_t
> +estr_writev (const struct iovec *iov, int iovcnt)
> +{
> +#ifdef HAVE_WRITEV
> +  return writev (STDERR_FILENO, iov, iovcnt);
> +#else
> +  ssize_t w = 0;
> +  for (int i = 0; i < iovcnt; i++)
> +    {
> +      ssize_t r = write (STDERR_FILENO, iov[i].iov_base, iov[i].iov_len);
> +      if (r == -1)
> +       return r;
> +      w += r;
> +    }
> +  return w;
> +#endif
> +}
>
> -int
> -st_vprintf (const char *format, va_list ap)
> +
> +#ifndef HAVE_VSNPRINTF
> +static int
> +gf_vsnprintf (char *str, size_t size, const char *format, va_list ap)
>  {
>    int written;
> -  char buffer[ST_VPRINTF_SIZE];
>
> -#ifdef HAVE_VSNPRINTF
> -  written = vsnprintf(buffer, ST_VPRINTF_SIZE, format, ap);
> -#else
>    written = vsprintf(buffer, format, ap);
>
> -  if (written >= ST_VPRINTF_SIZE - 1)
> +  if (written >= size - 1)
>      {
>        /* The error message was longer than our buffer.  Ouch.  Because
>          we may have messed up things badly, report the error and
>          quit.  */
> -#define ERROR_MESSAGE "Internal error: buffer overrun in st_vprintf()\n"
> -      write (STDERR_FILENO, buffer, ST_VPRINTF_SIZE - 1);
> -      write (STDERR_FILENO, ERROR_MESSAGE, strlen(ERROR_MESSAGE));
> +#define ERROR_MESSAGE "Internal error: buffer overrun in gf_vsnprintf()\n"
> +      write (STDERR_FILENO, buffer, size - 1);
> +      write (STDERR_FILENO, ERROR_MESSAGE, strlen (ERROR_MESSAGE));
>        sys_abort ();
>  #undef ERROR_MESSAGE
>
>      }
> -#endif
> -
> -  written = write (STDERR_FILENO, buffer, written);
>    return written;
>  }
>
> +#define vsnprintf gf_vsnprintf
> +#endif
> +
> +
> +/* printf() like function for for printing to stderr.  Uses a stack
> +   allocated buffer and doesn't lock stderr, so it should be safe to
> +   use from within a signal handler.  */
> +
> +#define ST_ERRBUF_SIZE 512
>
>  int
>  st_printf (const char * format, ...)
>  {
> +  char buffer[ST_ERRBUF_SIZE];
>    int written;
>    va_list ap;
>    va_start (ap, format);
> -  written = st_vprintf (format, ap);
> +  written = vsnprintf (buffer, ST_ERRBUF_SIZE, format, ap);
>    va_end (ap);
> +  written = write (STDERR_FILENO, buffer, written);
>    return written;
>  }
>
> @@ -340,12 +359,19 @@ void
>  os_error (const char *message)
>  {
>    char errmsg[STRERR_MAXSZ];
> +  struct iovec iov[5];
>    recursion_check ();
> -  estr_write ("Operating system error: ");
> -  estr_write (gf_strerror (errno, errmsg, STRERR_MAXSZ));
> -  estr_write ("\n");
> -  estr_write (message);
> -  estr_write ("\n");
> +  iov[0].iov_base = (char*) "Operating system error: ";
> +  iov[0].iov_len = strlen (iov[0].iov_base);
> +  iov[1].iov_base = gf_strerror (errno, errmsg, STRERR_MAXSZ);
> +  iov[1].iov_len = strlen (iov[1].iov_base);
> +  iov[2].iov_base = (char*) "\n";
> +  iov[2].iov_len = 1;
> +  iov[3].iov_base = (char*) message;
> +  iov[3].iov_len = strlen (message);
> +  iov[4].iov_base = (char*) "\n";
> +  iov[4].iov_len = 1;
> +  estr_writev (iov, 5);
>    exit_error (1);
>  }
>  iexport(os_error);
> @@ -357,14 +383,25 @@ iexport(os_error);
>  void
>  runtime_error (const char *message, ...)
>  {
> +  char buffer[ST_ERRBUF_SIZE];
> +  struct iovec iov[3];
>    va_list ap;
> +  int written;
>
>    recursion_check ();
> -  estr_write ("Fortran runtime error: ");
> +  iov[0].iov_base = (char*) "Fortran runtime error: ";
> +  iov[0].iov_len = strlen (iov[0].iov_base);
>    va_start (ap, message);
> -  st_vprintf (message, ap);
> +  written = vsnprintf (buffer, ST_ERRBUF_SIZE, message, ap);
>    va_end (ap);
> -  estr_write ("\n");
> +  if (written >= 0)
> +    {
> +      iov[1].iov_base = buffer;
> +      iov[1].iov_len = written;
> +      iov[2].iov_base = (char*) "\n";
> +      iov[2].iov_len = 1;
> +      estr_writev (iov, 3);
> +    }
>    exit_error (2);
>  }
>  iexport(runtime_error);
> @@ -375,15 +412,27 @@ iexport(runtime_error);
>  void
>  runtime_error_at (const char *where, const char *message, ...)
>  {
> +  char buffer[ST_ERRBUF_SIZE];
>    va_list ap;
> +  struct iovec iov[4];
> +  int written;
>
>    recursion_check ();
> -  estr_write (where);
> -  estr_write ("\nFortran runtime error: ");
> +  iov[0].iov_base = (char*) where;
> +  iov[0].iov_len = strlen (where);
> +  iov[1].iov_base = (char*) "\nFortran runtime error: ";
> +  iov[1].iov_len = strlen (iov[1].iov_base);
>    va_start (ap, message);
> -  st_vprintf (message, ap);
> +  written = vsnprintf (buffer, ST_ERRBUF_SIZE, message, ap);
>    va_end (ap);
> -  estr_write ("\n");
> +  if (written >= 0)
> +    {
> +      iov[2].iov_base = buffer;
> +      iov[2].iov_len = written;
> +      iov[3].iov_base = (char*) "\n";
> +      iov[3].iov_len = 1;
> +      estr_writev (iov, 4);
> +    }
>    exit_error (2);
>  }
>  iexport(runtime_error_at);
> @@ -392,14 +441,26 @@ iexport(runtime_error_at);
>  void
>  runtime_warning_at (const char *where, const char *message, ...)
>  {
> +  char buffer[ST_ERRBUF_SIZE];
>    va_list ap;
> +  struct iovec iov[4];
> +  int written;
>
> -  estr_write (where);
> -  estr_write ("\nFortran runtime warning: ");
> +  iov[0].iov_base = (char*) where;
> +  iov[0].iov_len = strlen (where);
> +  iov[1].iov_base = (char*) "\nFortran runtime warning: ";
> +  iov[1].iov_len = strlen (iov[1].iov_base);
>    va_start (ap, message);
> -  st_vprintf (message, ap);
> +  written = vsnprintf (buffer, ST_ERRBUF_SIZE, message, ap);
>    va_end (ap);
> -  estr_write ("\n");
> +  if (written >= 0)
> +    {
> +      iov[2].iov_base = buffer;
> +      iov[2].iov_len = written;
> +      iov[3].iov_base = (char*) "\n";
> +      iov[3].iov_len = 1;
> +      estr_writev (iov, 4);
> +    }
>  }
>  iexport(runtime_warning_at);
>
> @@ -410,11 +471,17 @@ iexport(runtime_warning_at);
>  void
>  internal_error (st_parameter_common *cmp, const char *message)
>  {
> +  struct iovec iov[3];
> +
>    recursion_check ();
>    show_locus (cmp);
> -  estr_write ("Internal Error: ");
> -  estr_write (message);
> -  estr_write ("\n");
> +  iov[0].iov_base = (char*) "Internal Error: ";
> +  iov[0].iov_len = strlen (iov[0].iov_base);
> +  iov[1].iov_base = (char*) message;
> +  iov[1].iov_len = strlen (message);
> +  iov[2].iov_base = (char*) "\n";
> +  iov[2].iov_len = 1;
> +  estr_writev (iov, 3);
>
>    /* This function call is here to get the main.o object file included
>       when linking statically. This works because error.o is supposed to
> @@ -609,9 +676,14 @@ generate_error_common (st_parameter_common *cmp, int
> family, const char *message
>
>    recursion_check ();
>    show_locus (cmp);
> -  estr_write ("Fortran runtime error: ");
> -  estr_write (message);
> -  estr_write ("\n");
> +  struct iovec iov[3];
> +  iov[0].iov_base = (char*) "Fortran runtime error: ";
> +  iov[0].iov_len = strlen (iov[0].iov_base);
> +  iov[1].iov_base = (char*) message;
> +  iov[1].iov_len = strlen (message);
> +  iov[2].iov_base = (char*) "\n";
> +  iov[2].iov_len = 1;
> +  estr_writev (iov, 3);
>    return false;
>  }
>
> @@ -645,9 +717,14 @@ generate_warning (st_parameter_common *cmp, const
> char *message)
>      message = " ";
>
>    show_locus (cmp);
> -  estr_write ("Fortran runtime warning: ");
> -  estr_write (message);
> -  estr_write ("\n");
> +  struct iovec iov[3];
> +  iov[0].iov_base = (char*) "Fortran runtime warning: ";
> +  iov[0].iov_len = strlen (iov[0].iov_base);
> +  iov[1].iov_base = (char*) message;
> +  iov[1].iov_len = strlen (message);
> +  iov[2].iov_base = (char*) "\n";
> +  iov[2].iov_len = 1;
> +  estr_writev (iov, 3);
>  }
>
>
> @@ -678,6 +755,7 @@ bool
>  notify_std (st_parameter_common *cmp, int std, const char * message)
>  {
>    int warning;
> +  struct iovec iov[3];
>
>    if (!compile_options.pedantic)
>      return true;
> @@ -690,17 +768,25 @@ notify_std (st_parameter_common *cmp, int std, const
> char * message)
>      {
>        recursion_check ();
>        show_locus (cmp);
> -      estr_write ("Fortran runtime error: ");
> -      estr_write (message);
> -      estr_write ("\n");
> +      iov[0].iov_base = (char*) "Fortran runtime error: ";
> +      iov[0].iov_len = strlen (iov[0].iov_base);
> +      iov[1].iov_base = (char*) message;
> +      iov[1].iov_len = strlen (message);
> +      iov[2].iov_base = (char*) "\n";
> +      iov[2].iov_len = 1;
> +      estr_writev (iov, 3);
>        exit_error (2);
>      }
>    else
>      {
>        show_locus (cmp);
> -      estr_write ("Fortran runtime warning: ");
> -      estr_write (message);
> -      estr_write ("\n");
> +      iov[0].iov_base = (char*) "Fortran runtime warning: ";
> +      iov[0].iov_len = strlen (iov[0].iov_base);
> +      iov[1].iov_base = (char*) message;
> +      iov[1].iov_len = strlen (message);
> +      iov[2].iov_base = (char*) "\n";
> +      iov[2].iov_len = 1;
> +      estr_writev (iov, 3);
>      }
>    return false;
>  }
> diff --git a/libgfortran/runtime/pause.c b/libgfortran/runtime/pause.c
> index 37672d4a02c..12997c7a685 100644
> --- a/libgfortran/runtime/pause.c
> +++ b/libgfortran/runtime/pause.c
> @@ -64,11 +64,15 @@ export_proto(pause_string);
>  void
>  pause_string (char *string, size_t len)
>  {
> -  estr_write ("PAUSE ");
> -  ssize_t w = write (STDERR_FILENO, string, len);
> -  (void) sizeof (w); /* Avoid compiler warning about not using write
> -                       return val.  */
> -  estr_write ("\n");
> +  struct iovec iov[3];
> +
> +  iov[0].iov_base = (char*) "PAUSE ";
> +  iov[0].iov_len = strlen (iov[0].iov_base);
> +  iov[1].iov_base = string;
> +  iov[1].iov_len = len;
> +  iov[2].iov_base = (char*) "\n";
> +  iov[2].iov_len = 1;
> +  estr_writev (iov, 3);
>
>    do_pause ();
>  }
> diff --git a/libgfortran/runtime/stop.c b/libgfortran/runtime/stop.c
> index 1e6dd8c28d0..4833e7b414a 100644
> --- a/libgfortran/runtime/stop.c
> +++ b/libgfortran/runtime/stop.c
> @@ -29,6 +29,7 @@ see the files COPYING3 and COPYING.RUNTIME
> respectively.  If not, see
>  #include <unistd.h>
>  #endif
>
> +#include <string.h>
>
>  /* Fortran 2008 demands: If any exception (14) is signaling on that
> image, the
>     processor shall issue a warning indicating which exceptions are
> signaling;
> @@ -40,7 +41,8 @@ see the files COPYING3 and COPYING.RUNTIME
> respectively.  If not, see
>  static void
>  report_exception (void)
>  {
> -  int set_excepts;
> +  struct iovec iov[8];
> +  int set_excepts, iovcnt = 1;
>
>    if (!compile_options.fpe_summary)
>      return;
> @@ -49,33 +51,62 @@ report_exception (void)
>    if ((set_excepts & compile_options.fpe_summary) == 0)
>      return;
>
> -  estr_write ("Note: The following floating-point exceptions are
> signalling:");
> +  iov[0].iov_base = (char*) "Note: The following floating-point
> exceptions are signalling:";
> +  iov[0].iov_len = strlen (iov[0].iov_base);
>
>    if ((compile_options.fpe_summary & GFC_FPE_INVALID)
>        && (set_excepts & GFC_FPE_INVALID))
> -    estr_write (" IEEE_INVALID_FLAG");
> +    {
> +      iov[iovcnt].iov_base = (char*) " IEEE_INVALID_FLAG";
> +      iov[iovcnt].iov_len = strlen (iov[iovcnt].iov_base);
> +      iovcnt++;
> +    }
>
>    if ((compile_options.fpe_summary & GFC_FPE_ZERO)
>        && (set_excepts & GFC_FPE_ZERO))
> -    estr_write (" IEEE_DIVIDE_BY_ZERO");
> +    {
> +      iov[iovcnt].iov_base = (char*) " IEEE_DIVIDE_BY_ZERO";
> +      iov[iovcnt].iov_len = strlen (iov[iovcnt].iov_base);
> +      iovcnt++;
> +    }
>
>    if ((compile_options.fpe_summary & GFC_FPE_OVERFLOW)
>        && (set_excepts & GFC_FPE_OVERFLOW))
> -    estr_write (" IEEE_OVERFLOW_FLAG");
> +    {
> +      iov[iovcnt].iov_base = (char*) " IEEE_OVERFLOW_FLAG";
> +      iov[iovcnt].iov_len = strlen (iov[iovcnt].iov_base);
> +      iovcnt++;
> +    }
>
>    if ((compile_options.fpe_summary & GFC_FPE_UNDERFLOW)
>        && (set_excepts & GFC_FPE_UNDERFLOW))
> -    estr_write (" IEEE_UNDERFLOW_FLAG");
> +    {
> +      iov[iovcnt].iov_base = (char*) " IEEE_UNDERFLOW_FLAG";
> +      iov[iovcnt].iov_len = strlen (iov[iovcnt].iov_base);
> +      iovcnt++;
> +    }
>
>    if ((compile_options.fpe_summary & GFC_FPE_DENORMAL)
>        && (set_excepts & GFC_FPE_DENORMAL))
> -    estr_write (" IEEE_DENORMAL");
> +    {
> +      iov[iovcnt].iov_base = (char*) " IEEE_DENORMAL";
> +      iov[iovcnt].iov_len = strlen (iov[iovcnt].iov_base);
> +      iovcnt++;
> +    }
>
>    if ((compile_options.fpe_summary & GFC_FPE_INEXACT)
>        && (set_excepts & GFC_FPE_INEXACT))
> -    estr_write (" IEEE_INEXACT_FLAG");
> +    {
> +      iov[iovcnt].iov_base = (char*) " IEEE_INEXACT_FLAG";
> +      iov[iovcnt].iov_len = strlen (iov[iovcnt].iov_base);
> +      iovcnt++;
> +    }
> +
> +  iov[iovcnt].iov_base = (char*) "\n";
> +  iov[iovcnt].iov_len = 1;
> +  iovcnt++;
>
> -  estr_write ("\n");
> +  estr_writev (iov, iovcnt);
>  }
>
>
> @@ -106,9 +137,14 @@ stop_string (const char *string, size_t len, bool
> quiet)
>        report_exception ();
>        if (string)
>         {
> -         estr_write ("STOP ");
> -         (void) write (STDERR_FILENO, string, len);
> -         estr_write ("\n");
> +         struct iovec iov[3];
> +         iov[0].iov_base = (char*) "STOP ";
> +         iov[0].iov_len = strlen (iov[0].iov_base);
> +         iov[1].iov_base = (char*) string;
> +         iov[1].iov_len = len;
> +         iov[2].iov_base = (char*) "\n";
> +         iov[2].iov_len = 1;
> +         estr_writev (iov, 3);
>         }
>      }
>    exit (0);
> @@ -128,10 +164,15 @@ error_stop_string (const char *string, size_t len,
> bool quiet)
>  {
>    if (!quiet)
>      {
> +      struct iovec iov[3];
>        report_exception ();
> -      estr_write ("ERROR STOP ");
> -      (void) write (STDERR_FILENO, string, len);
> -      estr_write ("\n");
> +      iov[0].iov_base = (char*) "ERROR STOP ";
> +      iov[0].iov_len = strlen (iov[0].iov_base);
> +      iov[1].iov_base = (char*) string;
> +      iov[1].iov_len = len;
> +      iov[2].iov_base = (char*) "\n";
> +      iov[2].iov_len = 1;
> +      estr_writev (iov, 3);
>      }
>    exit_error (1);
>  }
> --
> 2.17.1
>
>
Jerry DeLisle Sept. 21, 2018, 4:37 p.m. UTC | #2
Janne, this looks OK. Since you are touching on configuration and posix 
dependencies have you tested under any other systems?

Jerry

On 9/21/18 1:41 AM, Janne Blomqvist wrote:
> PING
> 
> On Wed, Sep 12, 2018 at 10:17 PM Janne Blomqvist <blomqvist.janne@gmail.com>
> wrote:
> 
>> When producing error and warning messages, libgfortran writes a
>> message by using many system calls.  By using vectored writes (the
>> POSIX writev function) when available and feasible to use without
>> major surgery, we reduce the chance that output gets intermingled with
>> other output to stderr.
>>
>> In practice, this is done by introducing a new function estr_writev in
>> addition to the existing estr_write.  In order to use this, the old
>> st_vprintf is removed, replaced by direct calls of vsnprintf, allowing
>> more message batching.
>>
>> Regtested on x86_64-pc-linux-gnu, Ok for trunk?
>>
>> libgfortran/ChangeLog:
>>
>> 2018-09-12  Janne Blomqvist  <jb@gcc.gnu.org>
>>
>>          * config.h.in: Regenerated.
>>          * configure: Regenerated.
>>          * configure.ac: Check for writev and sys/uio.h.
>>          * libgfortran.h: Include sys/uio.h.
>>          (st_vprintf): Remove prototype.
>>          (struct iovec): Define if not available.
>>          (estr_writev): New prototype.
>>          * runtime/backtrace.c (error_callback): Use estr_writev.
>>          * runtime/error.c (ST_VPRINTF_SIZE): Remove.
>>          (estr_writev): New function.
>>          (st_vprintf): Remove.
>>          (gf_vsnprintf): New function.
>>          (ST_ERRBUF_SIZE): New macro.
>>          (st_printf): Use vsnprintf.
>>          (os_error): Use estr_writev.
>>          (runtime_error): Use vsnprintf and estr_writev.
>>          (runtime_error_at): Likewise.
>>          (runtime_warning_at): Likewise.
>>          (internal_error): Use estr_writev.
>>          (generate_error_common): Likewise.
>>          (generate_warning): Likewise.
>>          (notify_std): Likewise.
>>          * runtime/pause.c (pause_string): Likewise.
>>          * runtime/stop.c (report_exception): Likewise.
>>          (stop_string): Likewise.
>>          (error_stop_string): Likewise.

--- snip ---
Janne Blomqvist Sept. 21, 2018, 6:15 p.m. UTC | #3
On Fri, Sep 21, 2018 at 7:37 PM Jerry DeLisle <jvdelisle@charter.net> wrote:

> Janne, this looks OK.


Thanks, committed as r264487.

Since you are touching on configuration and posix
> dependencies have you tested under any other systems?
>

No, unfortunately I don't have easy access to such a system for testing.
The patch, as can be seen, contains backwards compatibility stuff for
targets that don't have writev() and struct iovec, but that code is
untested.  I'll keep an eye out for regression reports, of course!
diff mbox series

Patch

diff --git a/libgfortran/config.h.in b/libgfortran/config.h.in
index 65fd27c6b11..c7f47146030 100644
--- a/libgfortran/config.h.in
+++ b/libgfortran/config.h.in
@@ -762,6 +762,9 @@ 
 /* Define to 1 if you have the <sys/types.h> header file. */
 #undef HAVE_SYS_TYPES_H
 
+/* Define to 1 if you have the <sys/uio.h> header file. */
+#undef HAVE_SYS_UIO_H
+
 /* Define to 1 if you have the <sys/wait.h> header file. */
 #undef HAVE_SYS_WAIT_H
 
@@ -828,6 +831,9 @@ 
 /* Define if target has a reliable stat. */
 #undef HAVE_WORKING_STAT
 
+/* Define to 1 if you have the `writev' function. */
+#undef HAVE_WRITEV
+
 /* Define to 1 if you have the <xlocale.h> header file. */
 #undef HAVE_XLOCALE_H
 
diff --git a/libgfortran/configure b/libgfortran/configure
index a583b676a3e..1c93683acd2 100755
--- a/libgfortran/configure
+++ b/libgfortran/configure
@@ -2553,6 +2553,7 @@  as_fn_append ac_header_list " sys/times.h"
 as_fn_append ac_header_list " sys/resource.h"
 as_fn_append ac_header_list " sys/types.h"
 as_fn_append ac_header_list " sys/stat.h"
+as_fn_append ac_header_list " sys/uio.h"
 as_fn_append ac_header_list " sys/wait.h"
 as_fn_append ac_header_list " floatingpoint.h"
 as_fn_append ac_header_list " ieeefp.h"
@@ -2584,6 +2585,7 @@  as_fn_append ac_func_list " access"
 as_fn_append ac_func_list " fork"
 as_fn_append ac_func_list " setmode"
 as_fn_append ac_func_list " fcntl"
+as_fn_append ac_func_list " writev"
 as_fn_append ac_func_list " gettimeofday"
 as_fn_append ac_func_list " stat"
 as_fn_append ac_func_list " fstat"
@@ -12514,7 +12516,7 @@  else
   lt_dlunknown=0; lt_dlno_uscore=1; lt_dlneed_uscore=2
   lt_status=$lt_dlunknown
   cat > conftest.$ac_ext <<_LT_EOF
-#line 12517 "configure"
+#line 12519 "configure"
 #include "confdefs.h"
 
 #if HAVE_DLFCN_H
@@ -12620,7 +12622,7 @@  else
   lt_dlunknown=0; lt_dlno_uscore=1; lt_dlneed_uscore=2
   lt_status=$lt_dlunknown
   cat > conftest.$ac_ext <<_LT_EOF
-#line 12623 "configure"
+#line 12625 "configure"
 #include "confdefs.h"
 
 #if HAVE_DLFCN_H
@@ -16168,6 +16170,8 @@  done
 
 
 
+
+
 
 
 
@@ -16763,6 +16767,8 @@  done
 
 
 
+
+
 
 
 
diff --git a/libgfortran/configure.ac b/libgfortran/configure.ac
index 05952aa0d40..64f7b9a39d5 100644
--- a/libgfortran/configure.ac
+++ b/libgfortran/configure.ac
@@ -276,7 +276,7 @@  AC_CHECK_TYPES([ptrdiff_t])
 
 # check header files (we assume C89 is available, so don't check for that)
 AC_CHECK_HEADERS_ONCE(unistd.h sys/random.h sys/time.h sys/times.h \
-sys/resource.h sys/types.h sys/stat.h sys/wait.h \
+sys/resource.h sys/types.h sys/stat.h sys/uio.h sys/wait.h \
 floatingpoint.h ieeefp.h fenv.h fptrap.h \
 fpxcp.h pwd.h complex.h xlocale.h)
 
@@ -315,7 +315,7 @@  else
    AC_CHECK_FUNCS_ONCE(getrusage times mkstemp strtof strtold snprintf \
    ftruncate chsize chdir getentropy getlogin gethostname kill link symlink \
    sleep ttyname \
-   alarm access fork setmode fcntl \
+   alarm access fork setmode fcntl writev \
    gettimeofday stat fstat lstat getpwuid vsnprintf dup \
    getcwd localtime_r gmtime_r getpwuid_r ttyname_r clock_gettime \
    getgid getpid getuid geteuid umask getegid \
diff --git a/libgfortran/libgfortran.h b/libgfortran/libgfortran.h
index b5a742aac88..1179812310b 100644
--- a/libgfortran/libgfortran.h
+++ b/libgfortran/libgfortran.h
@@ -88,6 +88,10 @@  extern long double __strtold (const char *, char **);
 #include <sys/types.h>
 #endif
 
+#ifdef HAVE_SYS_UIO_H
+#include <sys/uio.h>
+#endif
+
 #ifdef __MINGW32__
 typedef off64_t gfc_offset;
 #else
@@ -701,8 +705,15 @@  internal_proto(exit_error);
 extern ssize_t estr_write (const char *);
 internal_proto(estr_write);
 
-extern int st_vprintf (const char *, va_list);
-internal_proto(st_vprintf);
+#if !defined(HAVE_WRITEV) && !defined(HAVE_SYS_UIO_H)
+struct iovec {
+  void  *iov_base;    /* Starting address */
+  size_t iov_len;     /* Number of bytes to transfer */
+};
+#endif
+
+extern ssize_t estr_writev (const struct iovec *iov, int iovcnt);
+internal_proto(estr_writev);
 
 extern int st_printf (const char *, ...)
   __attribute__((format (gfc_printf, 1, 2)));
diff --git a/libgfortran/runtime/backtrace.c b/libgfortran/runtime/backtrace.c
index b8246889fde..e0c277044b6 100644
--- a/libgfortran/runtime/backtrace.c
+++ b/libgfortran/runtime/backtrace.c
@@ -68,6 +68,7 @@  static void
 error_callback (void *data, const char *msg, int errnum)
 {
   struct mystate *state = (struct mystate *) data;
+  struct iovec iov[5];
 #define ERRHDR "\nCould not print backtrace: "
 
   if (errnum < 0)
@@ -77,21 +78,31 @@  error_callback (void *data, const char *msg, int errnum)
     }
   else if (errnum == 0)
     {
-      estr_write (ERRHDR);
-      estr_write (msg);
-      estr_write ("\n");
+      iov[0].iov_base = (char*) ERRHDR;
+      iov[0].iov_len = strlen (ERRHDR);
+      iov[1].iov_base = (char*) msg;
+      iov[1].iov_len = strlen (msg);
+      iov[2].iov_base = (char*) "\n";
+      iov[2].iov_len = 1;
+      estr_writev (iov, 3);
     }
   else
     {
       char errbuf[256];
       if (state->in_signal_handler)
 	{
-	  estr_write (ERRHDR);
-	  estr_write (msg);
-	  estr_write (", errno: ");
+	  iov[0].iov_base = (char*) ERRHDR;
+	  iov[0].iov_len = strlen (ERRHDR);
+	  iov[1].iov_base = (char*) msg;
+	  iov[1].iov_len = strlen (msg);
+	  iov[2].iov_base = (char*) ", errno: ";
+	  iov[2].iov_len = strlen (iov[2].iov_base);
 	  const char *p = gfc_itoa (errnum, errbuf, sizeof (errbuf));
-	  estr_write (p);
-	  estr_write ("\n");
+	  iov[3].iov_base = (char*) p;
+	  iov[3].iov_len = strlen (p);
+	  iov[4].iov_base = (char*) "\n";
+	  iov[4].iov_len = 1;
+	  estr_writev (iov, 5);
 	}
       else
 	st_printf (ERRHDR "%s: %s\n", msg,
diff --git a/libgfortran/runtime/error.c b/libgfortran/runtime/error.c
index 1e8b6223aca..b07a4c0b12a 100644
--- a/libgfortran/runtime/error.c
+++ b/libgfortran/runtime/error.c
@@ -114,52 +114,71 @@  estr_write (const char *str)
 }
 
 
-/* st_vprintf()-- vsnprintf-like function for error output.  We use a
-   stack allocated buffer for formatting; since this function might be
-   called from within a signal handler, printing directly to stderr
-   with vfprintf is not safe since the stderr locking might lead to a
-   deadlock.  */
+/* Write a vector of strings to standard error.  This function is
+   async-signal-safe.  */
 
-#define ST_VPRINTF_SIZE 512
+ssize_t
+estr_writev (const struct iovec *iov, int iovcnt)
+{
+#ifdef HAVE_WRITEV
+  return writev (STDERR_FILENO, iov, iovcnt);
+#else
+  ssize_t w = 0;
+  for (int i = 0; i < iovcnt; i++)
+    {
+      ssize_t r = write (STDERR_FILENO, iov[i].iov_base, iov[i].iov_len);
+      if (r == -1)
+	return r;
+      w += r;
+    }
+  return w;
+#endif
+}
 
-int
-st_vprintf (const char *format, va_list ap)
+
+#ifndef HAVE_VSNPRINTF
+static int
+gf_vsnprintf (char *str, size_t size, const char *format, va_list ap)
 {
   int written;
-  char buffer[ST_VPRINTF_SIZE];
 
-#ifdef HAVE_VSNPRINTF
-  written = vsnprintf(buffer, ST_VPRINTF_SIZE, format, ap);
-#else
   written = vsprintf(buffer, format, ap);
 
-  if (written >= ST_VPRINTF_SIZE - 1)
+  if (written >= size - 1)
     {
       /* The error message was longer than our buffer.  Ouch.  Because
 	 we may have messed up things badly, report the error and
 	 quit.  */
-#define ERROR_MESSAGE "Internal error: buffer overrun in st_vprintf()\n"
-      write (STDERR_FILENO, buffer, ST_VPRINTF_SIZE - 1);
-      write (STDERR_FILENO, ERROR_MESSAGE, strlen(ERROR_MESSAGE));
+#define ERROR_MESSAGE "Internal error: buffer overrun in gf_vsnprintf()\n"
+      write (STDERR_FILENO, buffer, size - 1);
+      write (STDERR_FILENO, ERROR_MESSAGE, strlen (ERROR_MESSAGE));
       sys_abort ();
 #undef ERROR_MESSAGE
 
     }
-#endif
-
-  written = write (STDERR_FILENO, buffer, written);
   return written;
 }
 
+#define vsnprintf gf_vsnprintf
+#endif
+
+
+/* printf() like function for for printing to stderr.  Uses a stack
+   allocated buffer and doesn't lock stderr, so it should be safe to
+   use from within a signal handler.  */
+
+#define ST_ERRBUF_SIZE 512
 
 int
 st_printf (const char * format, ...)
 {
+  char buffer[ST_ERRBUF_SIZE];
   int written;
   va_list ap;
   va_start (ap, format);
-  written = st_vprintf (format, ap);
+  written = vsnprintf (buffer, ST_ERRBUF_SIZE, format, ap);
   va_end (ap);
+  written = write (STDERR_FILENO, buffer, written);
   return written;
 }
 
@@ -340,12 +359,19 @@  void
 os_error (const char *message)
 {
   char errmsg[STRERR_MAXSZ];
+  struct iovec iov[5];
   recursion_check ();
-  estr_write ("Operating system error: ");
-  estr_write (gf_strerror (errno, errmsg, STRERR_MAXSZ));
-  estr_write ("\n");
-  estr_write (message);
-  estr_write ("\n");
+  iov[0].iov_base = (char*) "Operating system error: ";
+  iov[0].iov_len = strlen (iov[0].iov_base);
+  iov[1].iov_base = gf_strerror (errno, errmsg, STRERR_MAXSZ);
+  iov[1].iov_len = strlen (iov[1].iov_base);
+  iov[2].iov_base = (char*) "\n";
+  iov[2].iov_len = 1;
+  iov[3].iov_base = (char*) message;
+  iov[3].iov_len = strlen (message);
+  iov[4].iov_base = (char*) "\n";
+  iov[4].iov_len = 1;
+  estr_writev (iov, 5);
   exit_error (1);
 }
 iexport(os_error);
@@ -357,14 +383,25 @@  iexport(os_error);
 void
 runtime_error (const char *message, ...)
 {
+  char buffer[ST_ERRBUF_SIZE];
+  struct iovec iov[3];
   va_list ap;
+  int written;
 
   recursion_check ();
-  estr_write ("Fortran runtime error: ");
+  iov[0].iov_base = (char*) "Fortran runtime error: ";
+  iov[0].iov_len = strlen (iov[0].iov_base);
   va_start (ap, message);
-  st_vprintf (message, ap);
+  written = vsnprintf (buffer, ST_ERRBUF_SIZE, message, ap);
   va_end (ap);
-  estr_write ("\n");
+  if (written >= 0)
+    {
+      iov[1].iov_base = buffer;
+      iov[1].iov_len = written;
+      iov[2].iov_base = (char*) "\n";
+      iov[2].iov_len = 1;
+      estr_writev (iov, 3);
+    }
   exit_error (2);
 }
 iexport(runtime_error);
@@ -375,15 +412,27 @@  iexport(runtime_error);
 void
 runtime_error_at (const char *where, const char *message, ...)
 {
+  char buffer[ST_ERRBUF_SIZE];
   va_list ap;
+  struct iovec iov[4];
+  int written;
 
   recursion_check ();
-  estr_write (where);
-  estr_write ("\nFortran runtime error: ");
+  iov[0].iov_base = (char*) where;
+  iov[0].iov_len = strlen (where);
+  iov[1].iov_base = (char*) "\nFortran runtime error: ";
+  iov[1].iov_len = strlen (iov[1].iov_base);
   va_start (ap, message);
-  st_vprintf (message, ap);
+  written = vsnprintf (buffer, ST_ERRBUF_SIZE, message, ap);
   va_end (ap);
-  estr_write ("\n");
+  if (written >= 0)
+    {
+      iov[2].iov_base = buffer;
+      iov[2].iov_len = written;
+      iov[3].iov_base = (char*) "\n";
+      iov[3].iov_len = 1;
+      estr_writev (iov, 4);
+    }
   exit_error (2);
 }
 iexport(runtime_error_at);
@@ -392,14 +441,26 @@  iexport(runtime_error_at);
 void
 runtime_warning_at (const char *where, const char *message, ...)
 {
+  char buffer[ST_ERRBUF_SIZE];
   va_list ap;
+  struct iovec iov[4];
+  int written;
 
-  estr_write (where);
-  estr_write ("\nFortran runtime warning: ");
+  iov[0].iov_base = (char*) where;
+  iov[0].iov_len = strlen (where);
+  iov[1].iov_base = (char*) "\nFortran runtime warning: ";
+  iov[1].iov_len = strlen (iov[1].iov_base);
   va_start (ap, message);
-  st_vprintf (message, ap);
+  written = vsnprintf (buffer, ST_ERRBUF_SIZE, message, ap);
   va_end (ap);
-  estr_write ("\n");
+  if (written >= 0)
+    {
+      iov[2].iov_base = buffer;
+      iov[2].iov_len = written;
+      iov[3].iov_base = (char*) "\n";
+      iov[3].iov_len = 1;
+      estr_writev (iov, 4);
+    }
 }
 iexport(runtime_warning_at);
 
@@ -410,11 +471,17 @@  iexport(runtime_warning_at);
 void
 internal_error (st_parameter_common *cmp, const char *message)
 {
+  struct iovec iov[3];
+
   recursion_check ();
   show_locus (cmp);
-  estr_write ("Internal Error: ");
-  estr_write (message);
-  estr_write ("\n");
+  iov[0].iov_base = (char*) "Internal Error: ";
+  iov[0].iov_len = strlen (iov[0].iov_base);
+  iov[1].iov_base = (char*) message;
+  iov[1].iov_len = strlen (message);
+  iov[2].iov_base = (char*) "\n";
+  iov[2].iov_len = 1;
+  estr_writev (iov, 3);
 
   /* This function call is here to get the main.o object file included
      when linking statically. This works because error.o is supposed to
@@ -609,9 +676,14 @@  generate_error_common (st_parameter_common *cmp, int family, const char *message
 
   recursion_check ();
   show_locus (cmp);
-  estr_write ("Fortran runtime error: ");
-  estr_write (message);
-  estr_write ("\n");
+  struct iovec iov[3];
+  iov[0].iov_base = (char*) "Fortran runtime error: ";
+  iov[0].iov_len = strlen (iov[0].iov_base);
+  iov[1].iov_base = (char*) message;
+  iov[1].iov_len = strlen (message);
+  iov[2].iov_base = (char*) "\n";
+  iov[2].iov_len = 1;
+  estr_writev (iov, 3);
   return false;
 }
 
@@ -645,9 +717,14 @@  generate_warning (st_parameter_common *cmp, const char *message)
     message = " ";
 
   show_locus (cmp);
-  estr_write ("Fortran runtime warning: ");
-  estr_write (message);
-  estr_write ("\n");
+  struct iovec iov[3];
+  iov[0].iov_base = (char*) "Fortran runtime warning: ";
+  iov[0].iov_len = strlen (iov[0].iov_base);
+  iov[1].iov_base = (char*) message;
+  iov[1].iov_len = strlen (message);
+  iov[2].iov_base = (char*) "\n";
+  iov[2].iov_len = 1;
+  estr_writev (iov, 3);
 }
 
 
@@ -678,6 +755,7 @@  bool
 notify_std (st_parameter_common *cmp, int std, const char * message)
 {
   int warning;
+  struct iovec iov[3];
 
   if (!compile_options.pedantic)
     return true;
@@ -690,17 +768,25 @@  notify_std (st_parameter_common *cmp, int std, const char * message)
     {
       recursion_check ();
       show_locus (cmp);
-      estr_write ("Fortran runtime error: ");
-      estr_write (message);
-      estr_write ("\n");
+      iov[0].iov_base = (char*) "Fortran runtime error: ";
+      iov[0].iov_len = strlen (iov[0].iov_base);
+      iov[1].iov_base = (char*) message;
+      iov[1].iov_len = strlen (message);
+      iov[2].iov_base = (char*) "\n";
+      iov[2].iov_len = 1;
+      estr_writev (iov, 3);
       exit_error (2);
     }
   else
     {
       show_locus (cmp);
-      estr_write ("Fortran runtime warning: ");
-      estr_write (message);
-      estr_write ("\n");
+      iov[0].iov_base = (char*) "Fortran runtime warning: ";
+      iov[0].iov_len = strlen (iov[0].iov_base);
+      iov[1].iov_base = (char*) message;
+      iov[1].iov_len = strlen (message);
+      iov[2].iov_base = (char*) "\n";
+      iov[2].iov_len = 1;
+      estr_writev (iov, 3);
     }
   return false;
 }
diff --git a/libgfortran/runtime/pause.c b/libgfortran/runtime/pause.c
index 37672d4a02c..12997c7a685 100644
--- a/libgfortran/runtime/pause.c
+++ b/libgfortran/runtime/pause.c
@@ -64,11 +64,15 @@  export_proto(pause_string);
 void
 pause_string (char *string, size_t len)
 {
-  estr_write ("PAUSE ");
-  ssize_t w = write (STDERR_FILENO, string, len);
-  (void) sizeof (w); /* Avoid compiler warning about not using write
-			return val.  */
-  estr_write ("\n");
+  struct iovec iov[3];
+
+  iov[0].iov_base = (char*) "PAUSE ";
+  iov[0].iov_len = strlen (iov[0].iov_base);
+  iov[1].iov_base = string;
+  iov[1].iov_len = len;
+  iov[2].iov_base = (char*) "\n";
+  iov[2].iov_len = 1;
+  estr_writev (iov, 3);
 
   do_pause ();
 }
diff --git a/libgfortran/runtime/stop.c b/libgfortran/runtime/stop.c
index 1e6dd8c28d0..4833e7b414a 100644
--- a/libgfortran/runtime/stop.c
+++ b/libgfortran/runtime/stop.c
@@ -29,6 +29,7 @@  see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
 #include <unistd.h>
 #endif
 
+#include <string.h>
 
 /* Fortran 2008 demands: If any exception (14) is signaling on that image, the
    processor shall issue a warning indicating which exceptions are signaling;
@@ -40,7 +41,8 @@  see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
 static void
 report_exception (void)
 {
-  int set_excepts;
+  struct iovec iov[8];
+  int set_excepts, iovcnt = 1;
 
   if (!compile_options.fpe_summary)
     return;
@@ -49,33 +51,62 @@  report_exception (void)
   if ((set_excepts & compile_options.fpe_summary) == 0)
     return;
 
-  estr_write ("Note: The following floating-point exceptions are signalling:");
+  iov[0].iov_base = (char*) "Note: The following floating-point exceptions are signalling:";
+  iov[0].iov_len = strlen (iov[0].iov_base);
 
   if ((compile_options.fpe_summary & GFC_FPE_INVALID)
       && (set_excepts & GFC_FPE_INVALID))
-    estr_write (" IEEE_INVALID_FLAG");
+    {
+      iov[iovcnt].iov_base = (char*) " IEEE_INVALID_FLAG";
+      iov[iovcnt].iov_len = strlen (iov[iovcnt].iov_base);
+      iovcnt++;
+    }
 
   if ((compile_options.fpe_summary & GFC_FPE_ZERO)
       && (set_excepts & GFC_FPE_ZERO))
-    estr_write (" IEEE_DIVIDE_BY_ZERO");
+    {
+      iov[iovcnt].iov_base = (char*) " IEEE_DIVIDE_BY_ZERO";
+      iov[iovcnt].iov_len = strlen (iov[iovcnt].iov_base);
+      iovcnt++;
+    }
 
   if ((compile_options.fpe_summary & GFC_FPE_OVERFLOW)
       && (set_excepts & GFC_FPE_OVERFLOW))
-    estr_write (" IEEE_OVERFLOW_FLAG");
+    {
+      iov[iovcnt].iov_base = (char*) " IEEE_OVERFLOW_FLAG";
+      iov[iovcnt].iov_len = strlen (iov[iovcnt].iov_base);
+      iovcnt++;
+    }
 
   if ((compile_options.fpe_summary & GFC_FPE_UNDERFLOW)
       && (set_excepts & GFC_FPE_UNDERFLOW))
-    estr_write (" IEEE_UNDERFLOW_FLAG");
+    {
+      iov[iovcnt].iov_base = (char*) " IEEE_UNDERFLOW_FLAG";
+      iov[iovcnt].iov_len = strlen (iov[iovcnt].iov_base);
+      iovcnt++;
+    }
 
   if ((compile_options.fpe_summary & GFC_FPE_DENORMAL)
       && (set_excepts & GFC_FPE_DENORMAL))
-    estr_write (" IEEE_DENORMAL");
+    {
+      iov[iovcnt].iov_base = (char*) " IEEE_DENORMAL";
+      iov[iovcnt].iov_len = strlen (iov[iovcnt].iov_base);
+      iovcnt++;
+    }
 
   if ((compile_options.fpe_summary & GFC_FPE_INEXACT)
       && (set_excepts & GFC_FPE_INEXACT))
-    estr_write (" IEEE_INEXACT_FLAG");
+    {
+      iov[iovcnt].iov_base = (char*) " IEEE_INEXACT_FLAG";
+      iov[iovcnt].iov_len = strlen (iov[iovcnt].iov_base);
+      iovcnt++;
+    }
+
+  iov[iovcnt].iov_base = (char*) "\n";
+  iov[iovcnt].iov_len = 1;
+  iovcnt++;
 
-  estr_write ("\n");
+  estr_writev (iov, iovcnt);
 }
 
 
@@ -106,9 +137,14 @@  stop_string (const char *string, size_t len, bool quiet)
       report_exception ();
       if (string)
 	{
-	  estr_write ("STOP ");
-	  (void) write (STDERR_FILENO, string, len);
-	  estr_write ("\n");
+	  struct iovec iov[3];
+	  iov[0].iov_base = (char*) "STOP ";
+	  iov[0].iov_len = strlen (iov[0].iov_base);
+	  iov[1].iov_base = (char*) string;
+	  iov[1].iov_len = len;
+	  iov[2].iov_base = (char*) "\n";
+	  iov[2].iov_len = 1;
+	  estr_writev (iov, 3);
 	}
     }
   exit (0);
@@ -128,10 +164,15 @@  error_stop_string (const char *string, size_t len, bool quiet)
 {
   if (!quiet)
     {
+      struct iovec iov[3];
       report_exception ();
-      estr_write ("ERROR STOP ");
-      (void) write (STDERR_FILENO, string, len);
-      estr_write ("\n");
+      iov[0].iov_base = (char*) "ERROR STOP ";
+      iov[0].iov_len = strlen (iov[0].iov_base);
+      iov[1].iov_base = (char*) string;
+      iov[1].iov_len = len;
+      iov[2].iov_base = (char*) "\n";
+      iov[2].iov_len = 1;
+      estr_writev (iov, 3);
     }
   exit_error (1);
 }