libgfortran/runtime/minimal.c

   1 /* Copyright (C) 2002-2016 Free Software Foundation, Inc.
   2    Contributed by Andy Vaught and Paul Brook <paul@nowt.org>
   3
   4 This file is part of the GNU Fortran runtime library (libgfortran).
   5
   6 Libgfortran is free software; you can redistribute it and/or modify
   7 it under the terms of the GNU General Public License as published by
   8 the Free Software Foundation; either version 3, or (at your option)
   9 any later version.
  10
  11 Libgfortran is distributed in the hope that it will be useful,
  12 but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 GNU General Public License for more details.
  15
  16 Under Section 7 of GPL version 3, you are granted additional
  17 permissions described in the GCC Runtime Library Exception, version
  18 3.1, as published by the Free Software Foundation.
  19
  20 You should have received a copy of the GNU General Public License and
  21 a copy of the GCC Runtime Library Exception along with this program;
  22 see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
  23 <http://www.gnu.org/licenses/>.  */
  24
  25 #include "libgfortran.h"
  26 #include <string.h>
  27 #include <limits.h>
  28 #include <errno.h>
  29
  30
  31 #ifdef HAVE_UNISTD_H
  32 #include <unistd.h>
  33 #endif
  34
  35 /* Stupid function to be sure the constructor is always linked in, even
  36    in the case of static linking.  See PR libfortran/22298 for details.  */
  37 void
  38 stupid_function_name_for_static_linking (void)
  39 {
  40   return;
  41 }
  42
  43 options_t options;
  44
  45 /* This will be 0 for little-endian
  46    machines and 1 for big-endian machines.
  47
  48    Currently minimal libgfortran only runs on little-endian devices
  49    which don't support constructors so this is just a constant.  */
  50 int big_endian = 0;
  51
  52 static int argc_save;
  53 static char **argv_save;
  54
  55 /* recursion_check()-- It's possible for additional errors to occur
  56  * during fatal error processing.  We detect this condition here and
  57  * exit with code 4 immediately. */
  58
  59 #define MAGIC 0x20DE8101
  60
  61 static void
  62 recursion_check (void)
  63 {
  64   static int magic = 0;
  65
  66   /* Don't even try to print something at this point */
  67   if (magic == MAGIC)
  68     sys_abort ();
  69
  70   magic = MAGIC;
  71 }
  72
  73
  74 /* os_error()-- Operating system error.  We get a message from the
  75  * operating system, show it and leave.  Some operating system errors
  76  * are caught and processed by the library.  If not, we come here. */
  77
  78 void
  79 os_error (const char *message)
  80 {
  81   recursion_check ();
  82   printf ("Operating system error: ");
  83   printf ("%s\n", message);
  84   exit (1);
  85 }
  86 iexport(os_error);
  87
  88
  89 /* void runtime_error()-- These are errors associated with an
  90  * invalid fortran program. */
  91
  92 void
  93 runtime_error (const char *message, ...)
  94 {
  95   va_list ap;
  96
  97   recursion_check ();
  98   printf ("Fortran runtime error: ");
  99   va_start (ap, message);
 100   vprintf (message, ap);
 101   va_end (ap);
 102   printf ("\n");
 103   exit (2);
 104 }
 105 iexport(runtime_error);
 106
 107 /* void runtime_error_at()-- These are errors associated with a
 108  * run time error generated by the front end compiler.  */
 109
 110 void
 111 runtime_error_at (const char *where, const char *message, ...)
 112 {
 113   va_list ap;
 114
 115   recursion_check ();
 116   printf ("%s", where);
 117   printf ("\nFortran runtime error: ");
 118   va_start (ap, message);
 119   vprintf (message, ap);
 120   va_end (ap);
 121   printf ("\n");
 122   exit (2);
 123 }
 124 iexport(runtime_error_at);
 125
 126
 127 void
 128 runtime_warning_at (const char *where, const char *message, ...)
 129 {
 130   va_list ap;
 131
 132   printf ("%s", where);
 133   printf ("\nFortran runtime warning: ");
 134   va_start (ap, message);
 135   vprintf (message, ap);
 136   va_end (ap);
 137   printf ("\n");
 138 }
 139 iexport(runtime_warning_at);
 140
 141
 142 /* void internal_error()-- These are this-can't-happen errors
 143  * that indicate something deeply wrong. */
 144
 145 void
 146 internal_error (st_parameter_common *cmp, const char *message)
 147 {
 148   recursion_check ();
 149   printf ("Internal Error: ");
 150   printf ("%s", message);
 151   printf ("\n");
 152
 153   /* This function call is here to get the main.o object file included
 154      when linking statically. This works because error.o is supposed to
 155      be always linked in (and the function call is in internal_error
 156      because hopefully it doesn't happen too often).  */
 157   stupid_function_name_for_static_linking();
 158
 159   exit (3);
 160 }
 161
 162
 163 /* Set the saved values of the command line arguments.  */
 164
 165 void
 166 set_args (int argc, char **argv)
 167 {
 168   argc_save = argc;
 169   argv_save = argv;
 170 }
 171 iexport(set_args);
 172
 173
 174 /* Retrieve the saved values of the command line arguments.  */
 175
 176 void
 177 get_args (int *argc, char ***argv)
 178 {
 179   *argc = argc_save;
 180   *argv = argv_save;
 181 }
 182
 183 /* sys_abort()-- Terminate the program showing backtrace and dumping
 184    core.  */
 185
 186 void
 187 sys_abort (void)
 188 {
 189   /* If backtracing is enabled, print backtrace and disable signal
 190      handler for ABRT.  */
 191   if (options.backtrace == 1
 192       || (options.backtrace == -1 && compile_options.backtrace == 1))
 193     {
 194       printf ("\nProgram aborted.\n");
 195     }
 196
 197   abort();
 198 }