1 /* Copyright (C) 2006, 2007, 2009 Free Software Foundation, Inc.
2 Contributed by François-Xavier Coudert
4 This file is part of the GNU Fortran 95 runtime library (libgfortran).
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 2, or (at your option)
11 In addition to the permissions in the GNU General Public License, the
12 Free Software Foundation gives you unlimited permission to link the
13 compiled version of this file into combinations with other programs,
14 and to distribute those combinations without any restriction coming
15 from the use of this file. (The General Public License restrictions
16 do apply in other respects; for example, they cover modification of
17 the file, and distribution when not linked into a combine
20 Libgfortran is distributed in the hope that it will be useful,
21 but WITHOUT ANY WARRANTY; without even the implied warranty of
22 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
23 GNU General Public License for more details.
25 You should have received a copy of the GNU General Public License
26 along with libgfortran; see the file COPYING. If not, write to
27 the Free Software Foundation, 51 Franklin Street, Fifth Floor,
28 Boston, MA 02110-1301, USA. */
30 #include "libgfortran.h"
38 #ifdef HAVE_INTTYPES_H
46 #ifdef HAVE_EXECINFO_H
50 #ifdef HAVE_SYS_WAIT_H
57 /* Macros for common sets of capabilities: can we fork and exec, can
58 we use glibc-style backtrace functions, and can we use pipes. */
59 #define CAN_FORK (defined(HAVE_FORK) && defined(HAVE_EXECVP) \
60 && defined(HAVE_WAIT))
61 #define GLIBC_BACKTRACE (defined(HAVE_BACKTRACE) \
62 && defined(HAVE_BACKTRACE_SYMBOLS))
63 #define CAN_PIPE (CAN_FORK && defined(HAVE_PIPE) \
64 && defined(HAVE_DUP2) && defined(HAVE_FDOPEN) \
65 && defined(HAVE_CLOSE))
68 #if GLIBC_BACKTRACE && CAN_PIPE
70 local_strcasestr (const char *s1, const char *s2)
72 #ifdef HAVE_STRCASESTR
73 return strcasestr (s1, s2);
77 const size_t len = strlen (s2);
78 const char u = *s2, v = isupper((int) *s2) ? tolower((int) *s2)
79 : (islower((int) *s2) ? toupper((int) *s2)
84 while (*p != u && *p != v && *p)
88 if (strncasecmp (p, s2, len) == 0)
98 dump_glibc_backtrace (int depth, char *str[])
102 for (i = 0; i < depth; i++)
103 st_printf (" + %s\n", str[i]);
109 /* show_backtrace displays the backtrace, currently obtained by means of
110 the glibc backtrace* functions. */
112 show_backtrace (void)
123 depth = backtrace (trace, DEPTH);
127 str = backtrace_symbols (trace, depth);
132 #define STDIN_FILENO 0
135 #ifndef STDOUT_FILENO
136 #define STDOUT_FILENO 1
139 #ifndef STDERR_FILENO
140 #define STDERR_FILENO 2
143 /* We attempt to extract file and line information from addr2line. */
146 /* Local variables. */
147 int f[2], pid, line, i;
149 char addr_buf[DEPTH][GFC_XTOA_BUF_SIZE], func[BUFSIZE], file[BUFSIZE];
151 const char *addr[DEPTH];
153 /* Write the list of addresses in hexadecimal format. */
154 for (i = 0; i < depth; i++)
155 addr[i] = gfc_xtoa ((GFC_UINTEGER_LARGEST) (intptr_t) trace[i], addr_buf[i],
156 sizeof (addr_buf[i]));
158 /* Don't output an error message if something goes wrong, we'll simply
159 fall back to the pstack and glibc backtraces. */
162 if ((pid = fork ()) == -1)
168 #define NUM_FIXEDARGS 5
169 char *arg[DEPTH+NUM_FIXEDARGS+1];
172 close (STDIN_FILENO);
173 close (STDERR_FILENO);
175 if (dup2 (f[1], STDOUT_FILENO) == -1)
179 arg[0] = (char *) "addr2line";
180 arg[1] = (char *) "-e";
181 arg[2] = full_exe_path ();
182 arg[3] = (char *) "-f";
183 arg[4] = (char *) "-s";
184 for (i = 0; i < depth; i++)
185 arg[NUM_FIXEDARGS+i] = (char *) addr[i];
186 arg[NUM_FIXEDARGS+depth] = NULL;
187 execvp (arg[0], arg);
192 /* Father process. */
195 output = fdopen (f[0], "r");
198 if (fgets (func, sizeof(func), output))
200 st_printf ("\nBacktrace for this error:\n");
204 if (! fgets (file, sizeof(file), output))
209 for (p = func; *p != '\n' && *p != '\r'; p++)
214 /* Try to recognize the internal libgfortran functions. */
215 if (strncasecmp (func, "*_gfortran", 10) == 0
216 || strncasecmp (func, "_gfortran", 9) == 0
217 || strcmp (func, "main") == 0 || strcmp (func, "_start") == 0
218 || strcmp (func, "_gfortrani_handler") == 0)
221 if (local_strcasestr (str[i], "libgfortran.so") != NULL
222 || local_strcasestr (str[i], "libgfortran.dylib") != NULL
223 || local_strcasestr (str[i], "libgfortran.a") != NULL)
226 /* If we only have the address, use the glibc backtrace. */
227 if (func[0] == '?' && func[1] == '?' && file[0] == '?'
230 st_printf (" + %s\n", str[i]);
234 /* Extract the line number. */
235 for (end = NULL, p = file; *p; p++)
246 if (strcmp (func, "MAIN__") == 0)
247 st_printf (" + in the main program\n");
249 st_printf (" + function %s (0x%s)\n", func, addr[i]);
251 if (line <= 0 && strcmp (file, "??") == 0)
255 st_printf (" from file %s\n", file);
257 st_printf (" at line %d of file %s\n", line, file);
259 while (fgets (func, sizeof(func), output));
265 st_printf ("** Something went wrong while running addr2line. **\n"
266 "** Falling back to a simpler backtrace scheme. **\n");
277 #if CAN_FORK && defined(HAVE_GETPPID)
278 /* Try to call pstack. */
281 /* Local variables. */
284 /* Don't output an error message if something goes wrong, we'll simply
285 fall back to the pstack and glibc backtraces. */
286 if ((pid = fork ()) == -1)
293 char *arg[NUM_ARGS+1];
296 st_printf ("\nBacktrace for this error:\n");
297 arg[0] = (char *) "pstack";
299 snprintf (buf, sizeof(buf), "%d", (int) getppid ());
301 sprintf (buf, "%d", (int) getppid ());
305 execvp (arg[0], arg);
308 /* pstack didn't work, so we fall back to dumping the glibc
309 backtrace if we can. */
311 dump_glibc_backtrace (depth, str);
313 st_printf (" unable to produce a backtrace, sorry!\n");
319 /* Father process. */
327 /* Fallback to the glibc backtrace. */
328 st_printf ("\nBacktrace for this error:\n");
329 dump_glibc_backtrace (depth, str);