]>
Commit | Line | Data |
---|---|---|
f1717362 | 1 | /* Copyright (C) 2002-2016 Free Software Foundation, Inc. |
eb00e55c | 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 | ||
eb00e55c | 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 | ||
83ba0e65 | 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. */ | |
eb00e55c | 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 | ||
83ba0e65 | 89 | |
90 | /* void runtime_error()-- These are errors associated with an | |
91 | * invalid fortran program. */ | |
92 | ||
eb00e55c | 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 (); | |
83ba0e65 | 117 | printf ("%s", where); |
118 | printf ("\nFortran runtime error: "); | |
eb00e55c | 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 | ||
83ba0e65 | 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 | ||
eb00e55c | 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; | |
eb00e55c | 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 | { | |
83ba0e65 | 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 | ||
eb00e55c | 198 | abort(); |
199 | } |