PR 78534, 83704 Handle large formatted I/O

[gcc.git] / libgfortran / runtime / minimal.c

diff --git a/libgfortran/runtime/minimal.c b/libgfortran/runtime/minimal.c
index 7ef46474dd1ec607aa1dc9f4495f5c543d179276..42011751825b6e5a2110ae310de990d4ba883400 100644 (file)
--- a/libgfortran/runtime/minimal.c
+++ b/libgfortran/runtime/minimal.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 2002-2015 Free Software Foundation, Inc.
+/* Copyright (C) 2002-2018 Free Software Foundation, Inc.
    Contributed by Andy Vaught and Paul Brook <paul@nowt.org>
 
 This file is part of the GNU Fortran runtime library (libgfortran).
@@ -23,10 +23,7 @@ see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
 <http://www.gnu.org/licenses/>.  */
 
 #include "libgfortran.h"
-#include <stdlib.h>
 #include <string.h>
-#include <limits.h>
-#include <errno.h>
 
 
 #ifdef HAVE_UNISTD_H
@@ -43,18 +40,9 @@ stupid_function_name_for_static_linking (void)
 
 options_t options;
 
-/* This will be 0 for little-endian
-   machines and 1 for big-endian machines.
-
-   Currently minimal libgfortran only runs on little-endian devices
-   which don't support constructors so this is just a constant.  */
-int big_endian = 0;
-
 static int argc_save;
 static char **argv_save;
 
-static const char *exe_path;
-
 /* recursion_check()-- It's possible for additional errors to occur
  * during fatal error processing.  We detect this condition here and
  * exit with code 4 immediately. */
@@ -73,7 +61,10 @@ recursion_check (void)
   magic = MAGIC;
 }
 
-#define STRERR_MAXSZ 256
+
+/* os_error()-- Operating system error.  We get a message from the
+ * operating system, show it and leave.  Some operating system errors
+ * are caught and processed by the library.  If not, we come here. */
 
 void
 os_error (const char *message)
@@ -85,6 +76,10 @@ os_error (const char *message)
 }
 iexport(os_error);
 
+
+/* void runtime_error()-- These are errors associated with an
+ * invalid fortran program. */
+
 void
 runtime_error (const char *message, ...)
 {
@@ -109,7 +104,8 @@ runtime_error_at (const char *where, const char *message, ...)
   va_list ap;
 
   recursion_check ();
-  printf ("Fortran runtime error: ");
+  printf ("%s", where);
+  printf ("\nFortran runtime error: ");
   va_start (ap, message);
   vprintf (message, ap);
   va_end (ap);
@@ -118,11 +114,40 @@ runtime_error_at (const char *where, const char *message, ...)
 }
 iexport(runtime_error_at);
 
-/* Return the full path of the executable.  */
-char *
-full_exe_path (void)
+
+void
+runtime_warning_at (const char *where, const char *message, ...)
+{
+  va_list ap;
+
+  printf ("%s", where);
+  printf ("\nFortran runtime warning: ");
+  va_start (ap, message);
+  vprintf (message, ap);
+  va_end (ap);
+  printf ("\n");
+}
+iexport(runtime_warning_at);
+
+
+/* void internal_error()-- These are this-can't-happen errors
+ * that indicate something deeply wrong. */
+
+void
+internal_error (st_parameter_common *cmp, const char *message)
 {
-  return (char *) exe_path;
+  recursion_check ();
+  printf ("Internal Error: ");
+  printf ("%s", message);
+  printf ("\n");
+
+  /* This function call is here to get the main.o object file included
+     when linking statically. This works because error.o is supposed to
+     be always linked in (and the function call is in internal_error
+     because hopefully it doesn't happen too often).  */
+  stupid_function_name_for_static_linking();
+
+  exit (3);
 }
 
 
@@ -133,7 +158,6 @@ set_args (int argc, char **argv)
 {
   argc_save = argc;
   argv_save = argv;
-  exe_path = argv[0];
 }
 iexport(set_args);
 
@@ -153,6 +177,13 @@ get_args (int *argc, char ***argv)
 void
 sys_abort (void)
 {
-  printf ("Abort called.\n");
+  /* If backtracing is enabled, print backtrace and disable signal
+     handler for ABRT.  */
+  if (options.backtrace == 1
+      || (options.backtrace == -1 && compile_options.backtrace == 1))
+    {
+      printf ("\nProgram aborted.\n");
+    }
+
   abort();
 }