]>
Commit | Line | Data |
---|---|---|
8b67b708 | 1 | /* Handling of compile-time options that influence the library. |
8d9254fc | 2 | Copyright (C) 2005-2020 Free Software Foundation, Inc. |
8b67b708 | 3 | |
58fc89f6 | 4 | This file is part of the GNU Fortran runtime library (libgfortran). |
8b67b708 FXC |
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 | |
748086b7 | 8 | the Free Software Foundation; either version 3, or (at your option) |
8b67b708 FXC |
9 | any later version. |
10 | ||
8b67b708 FXC |
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 | ||
748086b7 JJ |
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/>. */ | |
8b67b708 | 24 | |
8b67b708 | 25 | #include "libgfortran.h" |
2b840e50 | 26 | #include <signal.h> |
2b840e50 | 27 | |
8b67b708 FXC |
28 | |
29 | /* Useful compile-time options will be stored in here. */ | |
30 | compile_options_t compile_options; | |
31 | ||
ee95f928 | 32 | #ifndef LIBGFOR_MINIMAL |
ad4f95e3 | 33 | static volatile sig_atomic_t fatal_error_in_progress = 0; |
de8bd142 | 34 | |
3881a3de HA |
35 | |
36 | /* Helper function for backtrace_handler to write information about the | |
37 | received signal to stderr before actually giving the backtrace. */ | |
38 | static void | |
39 | show_signal (int signum) | |
40 | { | |
41 | const char * name = NULL, * desc = NULL; | |
42 | ||
43 | switch (signum) | |
44 | { | |
59c61547 TB |
45 | #if defined(SIGQUIT) |
46 | case SIGQUIT: | |
47 | name = "SIGQUIT"; | |
48 | desc = "Terminal quit signal"; | |
49 | break; | |
50 | #endif | |
51 | ||
52 | /* The following 4 signals are defined by C89. */ | |
53 | case SIGILL: | |
54 | name = "SIGILL"; | |
55 | desc = "Illegal instruction"; | |
56 | break; | |
57 | ||
58 | case SIGABRT: | |
59 | name = "SIGABRT"; | |
60 | desc = "Process abort signal"; | |
61 | break; | |
62 | ||
63 | case SIGFPE: | |
64 | name = "SIGFPE"; | |
65 | desc = "Floating-point exception - erroneous arithmetic operation"; | |
66 | break; | |
67 | ||
3881a3de HA |
68 | case SIGSEGV: |
69 | name = "SIGSEGV"; | |
59c61547 | 70 | desc = "Segmentation fault - invalid memory reference"; |
3881a3de | 71 | break; |
3881a3de HA |
72 | |
73 | #if defined(SIGBUS) | |
74 | case SIGBUS: | |
75 | name = "SIGBUS"; | |
59c61547 | 76 | desc = "Access to an undefined portion of a memory object"; |
3881a3de HA |
77 | break; |
78 | #endif | |
79 | ||
59c61547 TB |
80 | #if defined(SIGSYS) |
81 | case SIGSYS: | |
82 | name = "SIGSYS"; | |
83 | desc = "Bad system call"; | |
3881a3de HA |
84 | break; |
85 | #endif | |
86 | ||
59c61547 TB |
87 | #if defined(SIGTRAP) |
88 | case SIGTRAP: | |
89 | name = "SIGTRAP"; | |
90 | desc = "Trace/breakpoint trap"; | |
91 | break; | |
92 | #endif | |
93 | ||
94 | #if defined(SIGXCPU) | |
95 | case SIGXCPU: | |
96 | name = "SIGXCPU"; | |
97 | desc = "CPU time limit exceeded"; | |
98 | break; | |
99 | #endif | |
100 | ||
101 | #if defined(SIGXFSZ) | |
102 | case SIGXFSZ: | |
103 | name = "SIGXFSZ"; | |
104 | desc = "File size limit exceeded"; | |
3881a3de HA |
105 | break; |
106 | #endif | |
107 | } | |
108 | ||
109 | if (name) | |
59c61547 | 110 | st_printf ("\nProgram received signal %s: %s.\n", name, desc); |
3881a3de HA |
111 | else |
112 | st_printf ("\nProgram received signal %d.\n", signum); | |
113 | } | |
114 | ||
115 | ||
2b840e50 FXC |
116 | /* A signal handler to allow us to output a backtrace. */ |
117 | void | |
de8bd142 | 118 | backtrace_handler (int signum) |
2b840e50 | 119 | { |
de8bd142 JB |
120 | /* Since this handler is established for more than one kind of signal, |
121 | it might still get invoked recursively by delivery of some other kind | |
122 | of signal. Use a static variable to keep track of that. */ | |
123 | if (fatal_error_in_progress) | |
124 | raise (signum); | |
125 | fatal_error_in_progress = 1; | |
126 | ||
3881a3de | 127 | show_signal (signum); |
f0f67c96 | 128 | estr_write ("\nBacktrace for this error:\n"); |
1b0b9fcb | 129 | show_backtrace (true); |
de8bd142 JB |
130 | |
131 | /* Now reraise the signal. We reactivate the signal's | |
132 | default handling, which is to terminate the process. | |
133 | We could just call exit or abort, | |
134 | but reraising the signal sets the return status | |
135 | from the process correctly. */ | |
136 | signal (signum, SIG_DFL); | |
137 | raise (signum); | |
2b840e50 | 138 | } |
ee95f928 | 139 | #endif |
155732f5 | 140 | |
2bb6de3a JD |
141 | /* Set the usual compile-time options. */ |
142 | extern void set_options (int , int []); | |
143 | export_proto(set_options); | |
8b67b708 FXC |
144 | |
145 | void | |
2bb6de3a | 146 | set_options (int num, int options[]) |
8b67b708 | 147 | { |
2bb6de3a JD |
148 | if (num >= 1) |
149 | compile_options.warn_std = options[0]; | |
150 | if (num >= 2) | |
151 | compile_options.allow_std = options[1]; | |
152 | if (num >= 3) | |
153 | compile_options.pedantic = options[2]; | |
75b07bb4 FXC |
154 | if (num >= 4) |
155 | compile_options.backtrace = options[3]; | |
2bb6de3a | 156 | if (num >= 5) |
75b07bb4 | 157 | compile_options.sign_zero = options[4]; |
2bb6de3a | 158 | if (num >= 6) |
75b07bb4 | 159 | compile_options.bounds_check = options[5]; |
18fe404f | 160 | if (num >= 7) |
75b07bb4 | 161 | compile_options.fpe_summary = options[6]; |
2b840e50 | 162 | |
ee95f928 | 163 | #ifndef LIBGFOR_MINIMAL |
de8bd142 JB |
164 | /* If backtrace is required, we set signal handlers on the POSIX |
165 | 2001 signals with core action. */ | |
2b840e50 FXC |
166 | if (compile_options.backtrace) |
167 | { | |
de8bd142 JB |
168 | #if defined(SIGQUIT) |
169 | signal (SIGQUIT, backtrace_handler); | |
170 | #endif | |
171 | ||
74544378 | 172 | /* The following 4 signals are defined by C89. */ |
de8bd142 | 173 | signal (SIGILL, backtrace_handler); |
de8bd142 | 174 | signal (SIGABRT, backtrace_handler); |
de8bd142 | 175 | signal (SIGFPE, backtrace_handler); |
de8bd142 | 176 | signal (SIGSEGV, backtrace_handler); |
2b840e50 FXC |
177 | |
178 | #if defined(SIGBUS) | |
de8bd142 | 179 | signal (SIGBUS, backtrace_handler); |
2b840e50 FXC |
180 | #endif |
181 | ||
de8bd142 JB |
182 | #if defined(SIGSYS) |
183 | signal (SIGSYS, backtrace_handler); | |
2b840e50 FXC |
184 | #endif |
185 | ||
de8bd142 JB |
186 | #if defined(SIGTRAP) |
187 | signal (SIGTRAP, backtrace_handler); | |
188 | #endif | |
189 | ||
190 | #if defined(SIGXCPU) | |
191 | signal (SIGXCPU, backtrace_handler); | |
192 | #endif | |
193 | ||
194 | #if defined(SIGXFSZ) | |
195 | signal (SIGXFSZ, backtrace_handler); | |
2b840e50 FXC |
196 | #endif |
197 | } | |
ee95f928 | 198 | #endif |
8b67b708 FXC |
199 | } |
200 | ||
201 | ||
202 | /* Default values for the compile-time options. Keep in sync with | |
203 | gcc/fortran/options.c (gfc_init_options). */ | |
204 | void | |
205 | init_compile_options (void) | |
206 | { | |
5fb41e29 | 207 | compile_options.warn_std = GFC_STD_F95_DEL | GFC_STD_LEGACY; |
8b67b708 | 208 | compile_options.allow_std = GFC_STD_F95_OBS | GFC_STD_F95_DEL |
5fb41e29 | 209 | | GFC_STD_F2003 | GFC_STD_F2008 | GFC_STD_F95 | GFC_STD_F77 |
58fc89f6 | 210 | | GFC_STD_F2008_OBS | GFC_STD_GNU | GFC_STD_LEGACY; |
5f8f5313 | 211 | compile_options.pedantic = 0; |
868d75db | 212 | compile_options.backtrace = 0; |
2bb6de3a | 213 | compile_options.sign_zero = 1; |
fa86f4f9 | 214 | compile_options.fpe_summary = 0; |
8b67b708 | 215 | } |
eaa90d25 TK |
216 | |
217 | /* Function called by the front-end to tell us the | |
218 | default for unformatted data conversion. */ | |
219 | ||
220 | extern void set_convert (int); | |
221 | export_proto (set_convert); | |
222 | ||
223 | void | |
224 | set_convert (int conv) | |
225 | { | |
226 | compile_options.convert = conv; | |
227 | } | |
d67ab5ee TK |
228 | |
229 | extern void set_record_marker (int); | |
230 | export_proto (set_record_marker); | |
231 | ||
232 | ||
233 | void | |
234 | set_record_marker (int val) | |
235 | { | |
236 | ||
237 | switch(val) | |
238 | { | |
239 | case 4: | |
07b3bbf2 | 240 | compile_options.record_marker = sizeof (GFC_INTEGER_4); |
d67ab5ee TK |
241 | break; |
242 | ||
243 | case 8: | |
07b3bbf2 | 244 | compile_options.record_marker = sizeof (GFC_INTEGER_8); |
d67ab5ee TK |
245 | break; |
246 | ||
247 | default: | |
248 | runtime_error ("Invalid value for record marker"); | |
249 | break; | |
250 | } | |
251 | } | |
07b3bbf2 TK |
252 | |
253 | extern void set_max_subrecord_length (int); | |
254 | export_proto (set_max_subrecord_length); | |
255 | ||
256 | void set_max_subrecord_length(int val) | |
257 | { | |
258 | if (val > GFC_MAX_SUBRECORD_LENGTH || val < 1) | |
259 | { | |
260 | runtime_error ("Invalid value for maximum subrecord length"); | |
261 | return; | |
262 | } | |
263 | ||
264 | compile_options.max_subrecord_length = val; | |
265 | } |