summaryrefslogtreecommitdiff
path: root/libgfortran/runtime
diff options
context:
space:
mode:
Diffstat (limited to 'libgfortran/runtime')
-rw-r--r--libgfortran/runtime/error.c58
-rw-r--r--libgfortran/runtime/fpu.c5
-rw-r--r--libgfortran/runtime/pause.c6
-rw-r--r--libgfortran/runtime/stop.c6
-rw-r--r--libgfortran/runtime/string.c8
5 files changed, 31 insertions, 52 deletions
diff --git a/libgfortran/runtime/error.c b/libgfortran/runtime/error.c
index 64a062ab330..7f85b5ceb3a 100644
--- a/libgfortran/runtime/error.c
+++ b/libgfortran/runtime/error.c
@@ -37,6 +37,7 @@ Boston, MA 02110-1301, USA. */
#include "libgfortran.h"
#include "../io/io.h"
+#include "../io/unix.h"
/* Error conditions. The tricky part here is printing a message when
* it is the I/O subsystem that is severely wounded. Our goal is to
@@ -53,17 +54,6 @@ Boston, MA 02110-1301, USA. */
* Other error returns are reserved for the STOP statement with a numeric code.
*/
-/* locus variables. These are optionally set by a caller before a
- * library subroutine is called. They are always cleared on exit so
- * that files that report loci and those that do not can be linked
- * together without reporting an erroneous position. */
-
-char *filename = 0;
-iexport_data(filename);
-
-unsigned line = 0;
-iexport_data(line);
-
/* gfc_itoa()-- Integer to decimal conversion. */
const char *
@@ -145,9 +135,10 @@ st_printf (const char *format, ...)
const char *q;
stream *s;
char itoa_buf[GFC_ITOA_BUF_SIZE];
+ unix_stream err_stream;
total = 0;
- s = init_error_stream ();
+ s = init_error_stream (&err_stream);
va_start (arg, format);
for (;;)
@@ -288,12 +279,12 @@ st_sprintf (char *buffer, const char *format, ...)
* something went wrong */
void
-show_locus (void)
+show_locus (st_parameter_common *cmp)
{
- if (!options.locus || filename == NULL)
+ if (!options.locus || cmp == NULL || cmp->filename == NULL)
return;
- st_printf ("At line %d of file %s\n", line, filename);
+ st_printf ("At line %d of file %s\n", cmp->line, cmp->filename);
}
@@ -324,7 +315,6 @@ void
os_error (const char *message)
{
recursion_check ();
- show_locus ();
st_printf ("Operating system error: %s\n%s\n", get_oserror (), message);
sys_exit (1);
}
@@ -337,7 +327,6 @@ void
runtime_error (const char *message)
{
recursion_check ();
- show_locus ();
st_printf ("Fortran runtime error: %s\n", message);
sys_exit (2);
}
@@ -348,10 +337,10 @@ iexport(runtime_error);
* that indicate something deeply wrong. */
void
-internal_error (const char *message)
+internal_error (st_parameter_common *cmp, const char *message)
{
recursion_check ();
- show_locus ();
+ show_locus (cmp);
st_printf ("Internal Error: %s\n", message);
/* This function call is here to get the main.o object file included
@@ -452,48 +441,52 @@ translate_error (int code)
* the most recent operating system error is used. */
void
-generate_error (int family, const char *message)
+generate_error (st_parameter_common *cmp, int family, const char *message)
{
/* Set the error status. */
- if (ioparm.iostat != NULL)
- *ioparm.iostat = family;
+ if ((cmp->flags & IOPARM_HAS_IOSTAT))
+ *cmp->iostat = family;
if (message == NULL)
message =
(family == ERROR_OS) ? get_oserror () : translate_error (family);
- if (ioparm.iomsg)
- cf_strcpy (ioparm.iomsg, ioparm.iomsg_len, message);
+ if (cmp->flags & IOPARM_HAS_IOMSG)
+ cf_strcpy (cmp->iomsg, cmp->iomsg_len, message);
/* Report status back to the compiler. */
+ cmp->flags &= ~IOPARM_LIBRETURN_MASK;
switch (family)
{
case ERROR_EOR:
- ioparm.library_return = LIBRARY_EOR;
- if (ioparm.eor != 0)
+ cmp->flags |= IOPARM_LIBRETURN_EOR;
+ if ((cmp->flags & IOPARM_EOR))
return;
break;
case ERROR_END:
- ioparm.library_return = LIBRARY_END;
- if (ioparm.end != 0)
+ cmp->flags |= IOPARM_LIBRETURN_END;
+ if ((cmp->flags & IOPARM_END))
return;
break;
default:
- ioparm.library_return = LIBRARY_ERROR;
- if (ioparm.err != 0)
+ cmp->flags |= IOPARM_LIBRETURN_ERROR;
+ if ((cmp->flags & IOPARM_ERR))
return;
break;
}
/* Return if the user supplied an iostat variable. */
- if (ioparm.iostat != NULL)
+ if ((cmp->flags & IOPARM_HAS_IOSTAT))
return;
/* Terminate the program */
- runtime_error (message);
+ recursion_check ();
+ show_locus (cmp);
+ st_printf ("Fortran runtime error: %s\n", message);
+ sys_exit (2);
}
@@ -511,7 +504,6 @@ notify_std (int std, const char * message)
if ((compile_options.allow_std & std) != 0 && !warning)
return SUCCESS;
- show_locus ();
if (!warning)
{
st_printf ("Fortran runtime error: %s\n", message);
diff --git a/libgfortran/runtime/fpu.c b/libgfortran/runtime/fpu.c
index 4a2c1f1d431..f81a3b05a42 100644
--- a/libgfortran/runtime/fpu.c
+++ b/libgfortran/runtime/fpu.c
@@ -1,8 +1,3 @@
-/* This is needed for fpu-glibc.h, before all other includes */
-#ifdef HAVE_FENV_H
-#define _GNU_SOURCE
-#endif
-
#include "libgfortran.h"
/* We include the platform-dependent code. */
diff --git a/libgfortran/runtime/pause.c b/libgfortran/runtime/pause.c
index 516e7441f3c..95572e1128b 100644
--- a/libgfortran/runtime/pause.c
+++ b/libgfortran/runtime/pause.c
@@ -1,5 +1,5 @@
/* Implementation of the STOP statement.
- Copyright 2002 Free Software Foundation, Inc.
+ Copyright 2002, 2005 Free Software Foundation, Inc.
Contributed by Paul Brook <paul@nowt.org>
This file is part of the GNU Fortran 95 runtime library (libgfortran).
@@ -55,8 +55,6 @@ export_proto(pause_numeric);
void
pause_numeric (GFC_INTEGER_4 code)
{
- show_locus ();
-
if (code == -1)
st_printf ("PAUSE\n");
else
@@ -71,8 +69,6 @@ export_proto(pause_string);
void
pause_string (char *string, GFC_INTEGER_4 len)
{
- show_locus ();
-
st_printf ("PAUSE ");
while (len--)
st_printf ("%c", *(string++));
diff --git a/libgfortran/runtime/stop.c b/libgfortran/runtime/stop.c
index 920cc2c4f45..e4c3620e51f 100644
--- a/libgfortran/runtime/stop.c
+++ b/libgfortran/runtime/stop.c
@@ -1,5 +1,5 @@
/* Implementation of the STOP statement.
- Copyright 2002 Free Software Foundation, Inc.
+ Copyright 2002, 2005 Free Software Foundation, Inc.
Contributed by Paul Brook <paul@nowt.org>
This file is part of the GNU Fortran 95 runtime library (libgfortran).
@@ -37,8 +37,6 @@ Boston, MA 02110-1301, USA. */
void
stop_numeric (GFC_INTEGER_4 code)
{
- show_locus ();
-
if (code == -1)
code = 0;
else
@@ -55,8 +53,6 @@ export_proto(stop_string);
void
stop_string (const char *string, GFC_INTEGER_4 len)
{
- show_locus ();
-
st_printf ("STOP ");
while (len--)
st_printf ("%c", *(string++));
diff --git a/libgfortran/runtime/string.c b/libgfortran/runtime/string.c
index d7963b7498b..00dfc298305 100644
--- a/libgfortran/runtime/string.c
+++ b/libgfortran/runtime/string.c
@@ -31,7 +31,7 @@ Boston, MA 02110-1301, USA. */
#include <string.h>
#include "libgfortran.h"
-
+#include "../io/io.h"
/* Compare a C-style string with a fortran style string in a case-insensitive
manner. Used for decoding string options to various statements. Returns
@@ -104,14 +104,14 @@ cf_strcpy (char *dest, int dest_len, const char *src)
if no default is provided. */
int
-find_option (const char *s1, int s1_len, const st_option * opts,
- const char *error_message)
+find_option (st_parameter_common *cmp, const char *s1, int s1_len,
+ const st_option * opts, const char *error_message)
{
for (; opts->name; opts++)
if (compare0 (s1, s1_len, opts->name))
return opts->value;
- generate_error (ERROR_BAD_OPTION, error_message);
+ generate_error (cmp, ERROR_BAD_OPTION, error_message);
return -1;
}
View Lorry Controller Status