libgfortran/runtime/compile_options.c

   1 /* Handling of compile-time options that influence the library.
   2    Copyright (C) 2005, 2007, 2009 Free Software Foundation, Inc.
   3
   4 This file is part of the GNU Fortran 95 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
  27 #ifdef HAVE_SIGNAL_H
  28 #include <signal.h>
  29 #endif
  30
  31
  32 /* Useful compile-time options will be stored in here.  */
  33 compile_options_t compile_options;
  34
  35
  36 /* A signal handler to allow us to output a backtrace.  */
  37 void
  38 handler (int signum)
  39 {
  40   const char * name = NULL, * desc = NULL;
  41
  42   switch (signum)
  43     {
  44 #if defined(SIGSEGV)
  45       case SIGSEGV:
  46         name = "SIGSEGV";
  47         desc = "Segmentation fault";
  48         break;
  49 #endif
  50
  51 #if defined(SIGBUS)
  52       case SIGBUS:
  53         name = "SIGBUS";
  54         desc = "Bus error";
  55         break;
  56 #endif
  57
  58 #if defined(SIGILL)
  59       case SIGILL:
  60         name = "SIGILL";
  61         desc = "Illegal instruction";
  62         break;
  63 #endif
  64
  65 #if defined(SIGFPE)
  66       case SIGFPE:
  67         name = "SIGFPE";
  68         desc = "Floating-point exception";
  69         break;
  70 #endif
  71     }
  72
  73   if (name)
  74     st_printf ("\nProgram received signal %d (%s): %s.\n", signum, name, desc);
  75   else
  76     st_printf ("\nProgram received signal %d.\n", signum);
  77
  78   sys_exit (5);
  79 }
  80
  81
  82 /* Set the usual compile-time options.  */
  83 extern void set_options (int , int []);
  84 export_proto(set_options);
  85
  86 void
  87 set_options (int num, int options[])
  88 {
  89   if (num >= 1)
  90     compile_options.warn_std = options[0];
  91   if (num >= 2)
  92     compile_options.allow_std = options[1];
  93   if (num >= 3)
  94     compile_options.pedantic = options[2];
  95   if (num >= 4)
  96     compile_options.dump_core = options[3];
  97   if (num >= 5)
  98     compile_options.backtrace = options[4];
  99   if (num >= 6)
 100     compile_options.sign_zero = options[5];
 101   if (num >= 7)
 102     compile_options.bounds_check = options[6];
 103   if (num >= 8)
 104     compile_options.range_check = options[7];
 105
 106   /* If backtrace is required, we set signal handlers on most common
 107      signals.  */
 108 #if defined(HAVE_SIGNAL) && (defined(SIGSEGV) || defined(SIGBUS) \
 109                              || defined(SIGILL) || defined(SIGFPE))
 110   if (compile_options.backtrace)
 111     {
 112 #if defined(SIGSEGV)
 113       signal (SIGSEGV, handler);
 114 #endif
 115
 116 #if defined(SIGBUS)
 117       signal (SIGBUS, handler);
 118 #endif
 119
 120 #if defined(SIGILL)
 121       signal (SIGILL, handler);
 122 #endif
 123
 124 #if defined(SIGFPE)
 125       signal (SIGFPE, handler);
 126 #endif
 127     }
 128 #endif
 129
 130 }
 131
 132
 133 /* Default values for the compile-time options.  Keep in sync with
 134    gcc/fortran/options.c (gfc_init_options).  */
 135 void
 136 init_compile_options (void)
 137 {
 138   compile_options.warn_std = GFC_STD_F95_DEL | GFC_STD_LEGACY;
 139   compile_options.allow_std = GFC_STD_F95_OBS | GFC_STD_F95_DEL
 140     | GFC_STD_F2003 | GFC_STD_F2008 | GFC_STD_F95 | GFC_STD_F77
 141     | GFC_STD_GNU | GFC_STD_LEGACY;
 142   compile_options.pedantic = 0;
 143   compile_options.dump_core = 0;
 144   compile_options.backtrace = 0;
 145   compile_options.sign_zero = 1;
 146   compile_options.range_check = 1;
 147 }
 148
 149 /* Function called by the front-end to tell us the
 150    default for unformatted data conversion.  */
 151
 152 extern void set_convert (int);
 153 export_proto (set_convert);
 154
 155 void
 156 set_convert (int conv)
 157 {
 158   compile_options.convert = conv;
 159 }
 160
 161 extern void set_record_marker (int);
 162 export_proto (set_record_marker);
 163
 164
 165 void
 166 set_record_marker (int val)
 167 {
 168
 169   switch(val)
 170     {
 171     case 4:
 172       compile_options.record_marker = sizeof (GFC_INTEGER_4);
 173       break;
 174
 175     case 8:
 176       compile_options.record_marker = sizeof (GFC_INTEGER_8);
 177       break;
 178
 179     default:
 180       runtime_error ("Invalid value for record marker");
 181       break;
 182     }
 183 }
 184
 185 extern void set_max_subrecord_length (int);
 186 export_proto (set_max_subrecord_length);
 187
 188 void set_max_subrecord_length(int val)
 189 {
 190   if (val > GFC_MAX_SUBRECORD_LENGTH || val < 1)
 191     {
 192       runtime_error ("Invalid value for maximum subrecord length");
 193       return;
 194     }
 195
 196   compile_options.max_subrecord_length = val;
 197 }