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 <stdlib.h>
  27 #include <string.h>
  28 #include <limits.h>
  29 #include <errno.h>
  30
  31
  32 #ifdef HAVE_UNISTD_H
  33 #include <unistd.h>
  34 #endif
  35
  36 /* Stupid function to be sure the constructor is always linked in, even
  37    in the case of static linking.  See PR libfortran/22298 for details.  */
  38 void
  39 stupid_function_name_for_static_linking (void)
  40 {
  41   return;
  42 }
  43
  44 options_t options;
  45
  46 /* This will be 0 for little-endian
  47    machines and 1 for big-endian machines.
  48
  49    Currently minimal libgfortran only runs on little-endian devices
  50    which don't support constructors so this is just a constant.  */
  51 int big_endian = 0;
  52
  53 static int argc_save;
  54 static char **argv_save;
  55
  56 /* recursion_check()-- It's possible for additional errors to occur
  57  * during fatal error processing.  We detect this condition here and
  58  * exit with code 4 immediately. */
  59
  60 #define MAGIC 0x20DE8101
  61
  62 static void
  63 recursion_check (void)
  64 {
  65   static int magic = 0;
  66
  67   /* Don't even try to print something at this point */
  68   if (magic == MAGIC)
  69     sys_abort ();
  70
  71   magic = MAGIC;
  72 }
  73
  74
  75 /* os_error()-- Operating system error.  We get a message from the
  76  * operating system, show it and leave.  Some operating system errors
  77  * are caught and processed by the library.  If not, we come here. */
  78
  79 void
  80 os_error (const char *message)
  81 {
  82   recursion_check ();
  83   printf ("Operating system error: ");
  84   printf ("%s\n", message);
  85   exit (1);
  86 }
  87 iexport(os_error);
  88
  89
  90 /* void runtime_error()-- These are errors associated with an
  91  * invalid fortran program. */
  92
  93 void
  94 runtime_error (const char *message, ...)
  95 {
  96   va_list ap;
  97
  98   recursion_check ();
  99   printf ("Fortran runtime error: ");
 100   va_start (ap, message);
 101   vprintf (message, ap);
 102   va_end (ap);
 103   printf ("\n");
 104   exit (2);
 105 }
 106 iexport(runtime_error);
 107
 108 /* void runtime_error_at()-- These are errors associated with a
 109  * run time error generated by the front end compiler.  */
 110
 111 void
 112 runtime_error_at (const char *where, const char *message, ...)
 113 {
 114   va_list ap;
 115
 116   recursion_check ();
 117   printf ("%s", where);
 118   printf ("\nFortran runtime error: ");
 119   va_start (ap, message);
 120   vprintf (message, ap);
 121   va_end (ap);
 122   printf ("\n");
 123   exit (2);
 124 }
 125 iexport(runtime_error_at);
 126
 127
 128 void
 129 runtime_warning_at (const char *where, const char *message, ...)
 130 {
 131   va_list ap;
 132
 133   printf ("%s", where);
 134   printf ("\nFortran runtime warning: ");
 135   va_start (ap, message);
 136   vprintf (message, ap);
 137   va_end (ap);
 138   printf ("\n");
 139 }
 140 iexport(runtime_warning_at);
 141
 142
 143 /* void internal_error()-- These are this-can't-happen errors
 144  * that indicate something deeply wrong. */
 145
 146 void
 147 internal_error (st_parameter_common *cmp, const char *message)
 148 {
 149   recursion_check ();
 150   printf ("Internal Error: ");
 151   printf ("%s", message);
 152   printf ("\n");
 153
 154   /* This function call is here to get the main.o object file included
 155      when linking statically. This works because error.o is supposed to
 156      be always linked in (and the function call is in internal_error
 157      because hopefully it doesn't happen too often).  */
 158   stupid_function_name_for_static_linking();
 159
 160   exit (3);
 161 }
 162
 163
 164 /* Set the saved values of the command line arguments.  */
 165
 166 void
 167 set_args (int argc, char **argv)
 168 {
 169   argc_save = argc;
 170   argv_save = argv;
 171 }
 172 iexport(set_args);
 173
 174
 175 /* Retrieve the saved values of the command line arguments.  */
 176
 177 void
 178 get_args (int *argc, char ***argv)
 179 {
 180   *argc = argc_save;
 181   *argv = argv_save;
 182 }
 183
 184 /* sys_abort()-- Terminate the program showing backtrace and dumping
 185    core.  */
 186
 187 void
 188 sys_abort (void)
 189 {
 190   /* If backtracing is enabled, print backtrace and disable signal
 191      handler for ABRT.  */
 192   if (options.backtrace == 1
 193       || (options.backtrace == -1 && compile_options.backtrace == 1))
 194     {
 195       printf ("\nProgram aborted.\n");
 196     }
 197
 198   abort();
 199 }