libgfortran/runtime/minimal.c

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