Error printing thread safety, remove GFORTRAN_USE_STDERR
[gcc.git] / libgfortran / runtime / backtrace.c
1 /* Copyright (C) 2006, 2007, 2009, 2011 Free Software Foundation, Inc.
2 Contributed by François-Xavier Coudert
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
27 #include <string.h>
28
29 #ifdef HAVE_STDLIB_H
30 #include <stdlib.h>
31 #endif
32
33 #ifdef HAVE_INTTYPES_H
34 #include <inttypes.h>
35 #endif
36
37 #ifdef HAVE_UNISTD_H
38 #include <unistd.h>
39 #endif
40
41 #ifdef HAVE_EXECINFO_H
42 #include <execinfo.h>
43 #endif
44
45 #ifdef HAVE_SYS_WAIT_H
46 #include <sys/wait.h>
47 #endif
48
49 #include <ctype.h>
50
51
52 /* Macros for common sets of capabilities: can we fork and exec, can
53 we use glibc-style backtrace functions, and can we use pipes. */
54 #define CAN_FORK (defined(HAVE_FORK) && defined(HAVE_EXECVP) \
55 && defined(HAVE_WAIT))
56 #define GLIBC_BACKTRACE (defined(HAVE_BACKTRACE) \
57 && defined(HAVE_BACKTRACE_SYMBOLS))
58 #define CAN_PIPE (CAN_FORK && defined(HAVE_PIPE) \
59 && defined(HAVE_DUP2) && defined(HAVE_FDOPEN) \
60 && defined(HAVE_CLOSE))
61
62
63 #if GLIBC_BACKTRACE && CAN_PIPE
64 static char *
65 local_strcasestr (const char *s1, const char *s2)
66 {
67 #ifdef HAVE_STRCASESTR
68 return strcasestr (s1, s2);
69 #else
70
71 const char *p = s1;
72 const size_t len = strlen (s2);
73 const char u = *s2, v = isupper((int) *s2) ? tolower((int) *s2)
74 : (islower((int) *s2) ? toupper((int) *s2)
75 : *s2);
76
77 while (1)
78 {
79 while (*p != u && *p != v && *p)
80 p++;
81 if (*p == 0)
82 return NULL;
83 if (strncasecmp (p, s2, len) == 0)
84 return (char *)p;
85 }
86 #endif
87 }
88 #endif
89
90
91 #if GLIBC_BACKTRACE
92 static void
93 dump_glibc_backtrace (int depth, char *str[])
94 {
95 int i;
96
97 for (i = 0; i < depth; i++)
98 {
99 estr_write (" + ");
100 estr_write (str[i]);
101 estr_write ("\n");
102 }
103
104 free (str);
105 }
106 #endif
107
108 /* show_backtrace displays the backtrace, currently obtained by means of
109 the glibc backtrace* functions. */
110 void
111 show_backtrace (void)
112 {
113 #if GLIBC_BACKTRACE
114
115 #define DEPTH 50
116 #define BUFSIZE 1024
117
118 void *trace[DEPTH];
119 char **str;
120 int depth;
121
122 depth = backtrace (trace, DEPTH);
123 if (depth <= 0)
124 return;
125
126 str = backtrace_symbols (trace, depth);
127
128 #if CAN_PIPE
129
130 #ifndef STDIN_FILENO
131 #define STDIN_FILENO 0
132 #endif
133
134 #ifndef STDOUT_FILENO
135 #define STDOUT_FILENO 1
136 #endif
137
138 #ifndef STDERR_FILENO
139 #define STDERR_FILENO 2
140 #endif
141
142 /* We attempt to extract file and line information from addr2line. */
143 do
144 {
145 /* Local variables. */
146 int f[2], pid, line, i;
147 FILE *output;
148 char addr_buf[DEPTH][GFC_XTOA_BUF_SIZE], func[BUFSIZE], file[BUFSIZE];
149 char *p, *end;
150 const char *addr[DEPTH];
151
152 /* Write the list of addresses in hexadecimal format. */
153 for (i = 0; i < depth; i++)
154 addr[i] = gfc_xtoa ((GFC_UINTEGER_LARGEST) (intptr_t) trace[i], addr_buf[i],
155 sizeof (addr_buf[i]));
156
157 /* Don't output an error message if something goes wrong, we'll simply
158 fall back to the pstack and glibc backtraces. */
159 if (pipe (f) != 0)
160 break;
161 if ((pid = fork ()) == -1)
162 break;
163
164 if (pid == 0)
165 {
166 /* Child process. */
167 #define NUM_FIXEDARGS 5
168 char *arg[DEPTH+NUM_FIXEDARGS+1];
169
170 close (f[0]);
171 close (STDIN_FILENO);
172 close (STDERR_FILENO);
173
174 if (dup2 (f[1], STDOUT_FILENO) == -1)
175 _exit (0);
176 close (f[1]);
177
178 arg[0] = (char *) "addr2line";
179 arg[1] = (char *) "-e";
180 arg[2] = full_exe_path ();
181 arg[3] = (char *) "-f";
182 arg[4] = (char *) "-s";
183 for (i = 0; i < depth; i++)
184 arg[NUM_FIXEDARGS+i] = (char *) addr[i];
185 arg[NUM_FIXEDARGS+depth] = NULL;
186 execvp (arg[0], arg);
187 _exit (0);
188 #undef NUM_FIXEDARGS
189 }
190
191 /* Father process. */
192 close (f[1]);
193 wait (NULL);
194 output = fdopen (f[0], "r");
195 i = -1;
196
197 if (fgets (func, sizeof(func), output))
198 {
199 estr_write ("\nBacktrace for this error:\n");
200
201 do
202 {
203 if (! fgets (file, sizeof(file), output))
204 goto fallback;
205
206 i++;
207
208 for (p = func; *p != '\n' && *p != '\r'; p++)
209 ;
210
211 *p = '\0';
212
213 /* Try to recognize the internal libgfortran functions. */
214 if (strncasecmp (func, "*_gfortran", 10) == 0
215 || strncasecmp (func, "_gfortran", 9) == 0
216 || strcmp (func, "main") == 0 || strcmp (func, "_start") == 0
217 || strcmp (func, "_gfortrani_handler") == 0)
218 continue;
219
220 if (local_strcasestr (str[i], "libgfortran.so") != NULL
221 || local_strcasestr (str[i], "libgfortran.dylib") != NULL
222 || local_strcasestr (str[i], "libgfortran.a") != NULL)
223 continue;
224
225 /* If we only have the address, use the glibc backtrace. */
226 if (func[0] == '?' && func[1] == '?' && file[0] == '?'
227 && file[1] == '?')
228 {
229 estr_write (" + ");
230 estr_write (str[i]);
231 estr_write ("\n");
232 continue;
233 }
234
235 /* Extract the line number. */
236 for (end = NULL, p = file; *p; p++)
237 if (*p == ':')
238 end = p;
239 if (end != NULL)
240 {
241 *end = '\0';
242 line = atoi (++end);
243 }
244 else
245 line = -1;
246
247 if (strcmp (func, "MAIN__") == 0)
248 estr_write (" + in the main program\n");
249 else
250 {
251 estr_write (" + function ");
252 estr_write (func);
253 estr_write (" (0x");
254 estr_write (addr[i]);
255 estr_write (")\n");
256 }
257
258 if (line <= 0 && strcmp (file, "??") == 0)
259 continue;
260
261 if (line <= 0)
262 {
263 estr_write (" from file ");
264 estr_write (file);
265 estr_write ("\n");
266 }
267 else
268 st_printf (" at line %d of file %s\n", line, file);
269 }
270 while (fgets (func, sizeof(func), output));
271
272 free (str);
273 return;
274
275 fallback:
276 estr_write ("** Something went wrong while running addr2line. **\n"
277 "** Falling back to a simpler backtrace scheme. **\n");
278 }
279 }
280 while (0);
281
282 #undef DEPTH
283 #undef BUFSIZE
284
285 #endif
286 #endif
287
288 #if CAN_FORK && defined(HAVE_GETPPID)
289 /* Try to call pstack. */
290 do
291 {
292 /* Local variables. */
293 int pid;
294
295 /* Don't output an error message if something goes wrong, we'll simply
296 fall back to the pstack and glibc backtraces. */
297 if ((pid = fork ()) == -1)
298 break;
299
300 if (pid == 0)
301 {
302 /* Child process. */
303 #define NUM_ARGS 2
304 char *arg[NUM_ARGS+1];
305 char buf[20];
306
307 estr_write ("\nBacktrace for this error:\n");
308 arg[0] = (char *) "pstack";
309 snprintf (buf, sizeof(buf), "%d", (int) getppid ());
310 arg[1] = buf;
311 arg[2] = NULL;
312 execvp (arg[0], arg);
313 #undef NUM_ARGS
314
315 /* pstack didn't work, so we fall back to dumping the glibc
316 backtrace if we can. */
317 #if GLIBC_BACKTRACE
318 dump_glibc_backtrace (depth, str);
319 #else
320 estr_write (" unable to produce a backtrace, sorry!\n");
321 #endif
322
323 _exit (0);
324 }
325
326 /* Father process. */
327 wait (NULL);
328 return;
329 }
330 while(0);
331 #endif
332
333 #if GLIBC_BACKTRACE
334 /* Fallback to the glibc backtrace. */
335 estr_write ("\nBacktrace for this error:\n");
336 dump_glibc_backtrace (depth, str);
337 #endif
338 }