aboutsummaryrefslogtreecommitdiff
path: root/libgfortran/runtime
diff options
context:
space:
mode:
Diffstat (limited to 'libgfortran/runtime')
-rw-r--r--libgfortran/runtime/backtrace.c27
-rw-r--r--libgfortran/runtime/error.c188
-rw-r--r--libgfortran/runtime/pause.c14
-rw-r--r--libgfortran/runtime/stop.c71
4 files changed, 221 insertions, 79 deletions
diff --git a/libgfortran/runtime/backtrace.c b/libgfortran/runtime/backtrace.c
index b824688..e0c2770 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 1e8b622..b07a4c0 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 37672d4..12997c7 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 1e6dd8c..4833e7b 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);
}
generated by cgit v1.1 at 2025-05-28 06:43:41 +0000