libgfortran/runtime/minimal.c

   1 /* Copyright (C) 2002-2015 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 static const char *exe_path;
  57
  58 /* recursion_check()-- It's possible for additional errors to occur
  59  * during fatal error processing.  We detect this condition here and
  60  * exit with code 4 immediately. */
  61
  62 #define MAGIC 0x20DE8101
  63
  64 static void
  65 recursion_check (void)
  66 {
  67   static int magic = 0;
  68
  69   /* Don't even try to print something at this point */
  70   if (magic == MAGIC)
  71     sys_abort ();
  72
  73   magic = MAGIC;
  74 }
  75
  76
  77 /* os_error()-- Operating system error.  We get a message from the
  78  * operating system, show it and leave.  Some operating system errors
  79  * are caught and processed by the library.  If not, we come here. */
  80
  81 void
  82 os_error (const char *message)
  83 {
  84   recursion_check ();
  85   printf ("Operating system error: ");
  86   printf ("%s\n", message);
  87   exit (1);
  88 }
  89 iexport(os_error);
  90
  91
  92 /* void runtime_error()-- These are errors associated with an
  93  * invalid fortran program. */
  94
  95 void
  96 runtime_error (const char *message, ...)
  97 {
  98   va_list ap;
  99
 100   recursion_check ();
 101   printf ("Fortran runtime error: ");
 102   va_start (ap, message);
 103   vprintf (message, ap);
 104   va_end (ap);
 105   printf ("\n");
 106   exit (2);
 107 }
 108 iexport(runtime_error);
 109
 110 /* void runtime_error_at()-- These are errors associated with a
 111  * run time error generated by the front end compiler.  */
 112
 113 void
 114 runtime_error_at (const char *where, const char *message, ...)
 115 {
 116   va_list ap;
 117
 118   recursion_check ();
 119   printf ("%s", where);
 120   printf ("\nFortran runtime error: ");
 121   va_start (ap, message);
 122   vprintf (message, ap);
 123   va_end (ap);
 124   printf ("\n");
 125   exit (2);
 126 }
 127 iexport(runtime_error_at);
 128
 129
 130 void
 131 runtime_warning_at (const char *where, const char *message, ...)
 132 {
 133   va_list ap;
 134
 135   printf ("%s", where);
 136   printf ("\nFortran runtime warning: ");
 137   va_start (ap, message);
 138   vprintf (message, ap);
 139   va_end (ap);
 140   printf ("\n");
 141 }
 142 iexport(runtime_warning_at);
 143
 144
 145 /* void internal_error()-- These are this-can't-happen errors
 146  * that indicate something deeply wrong. */
 147
 148 void
 149 internal_error (st_parameter_common *cmp, const char *message)
 150 {
 151   recursion_check ();
 152   printf ("Internal Error: ");
 153   printf ("%s", message);
 154   printf ("\n");
 155
 156   /* This function call is here to get the main.o object file included
 157      when linking statically. This works because error.o is supposed to
 158      be always linked in (and the function call is in internal_error
 159      because hopefully it doesn't happen too often).  */
 160   stupid_function_name_for_static_linking();
 161
 162   exit (3);
 163 }
 164
 165
 166 /* Return the full path of the executable.  */
 167 char *
 168 full_exe_path (void)
 169 {
 170   return (char *) exe_path;
 171 }
 172
 173
 174 /* Set the saved values of the command line arguments.  */
 175
 176 void
 177 set_args (int argc, char **argv)
 178 {
 179   argc_save = argc;
 180   argv_save = argv;
 181   exe_path = argv[0];
 182 }
 183 iexport(set_args);
 184
 185
 186 /* Retrieve the saved values of the command line arguments.  */
 187
 188 void
 189 get_args (int *argc, char ***argv)
 190 {
 191   *argc = argc_save;
 192   *argv = argv_save;
 193 }
 194
 195 /* sys_abort()-- Terminate the program showing backtrace and dumping
 196    core.  */
 197
 198 void
 199 sys_abort (void)
 200 {
 201   /* If backtracing is enabled, print backtrace and disable signal
 202      handler for ABRT.  */
 203   if (options.backtrace == 1
 204       || (options.backtrace == -1 && compile_options.backtrace == 1))
 205     {
 206       printf ("\nProgram aborted.\n");
 207     }
 208
 209   abort();
 210 }