1 /* Copyright (C) 2006 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. */
39 #ifdef HAVE_INTTYPES_H
48 # define INTPTR_T intptr_t
53 #ifdef HAVE_EXECINFO_H
57 #ifdef HAVE_SYS_WAIT_H
67 #include "libgfortran.h"
71 #ifndef HAVE_STRCASESTR
72 #define HAVE_STRCASESTR 1
74 strcasestr (const char *s1
, const char *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)
94 #define CAN_FORK (defined(HAVE_FORK) && defined(HAVE_EXECVP) \
95 && defined(HAVE_WAIT))
96 #define GLIBC_BACKTRACE (defined(HAVE_BACKTRACE) \
97 && defined(HAVE_BACKTRACE_SYMBOLS))
98 #define CAN_PIPE (CAN_FORK && defined(HAVE_PIPE) \
99 && defined(HAVE_DUP2) && defined(HAVE_FDOPEN) \
100 && defined(HAVE_CLOSE))
105 dump_glibc_backtrace (int depth
, char *str
[])
109 for (i
= 0; i
< depth
; i
++)
110 st_printf (" + %s\n", str
[i
]);
116 /* show_backtrace displays the backtrace, currently obtained by means of
117 the glibc backtrace* functions. */
119 show_backtrace (void)
130 depth
= backtrace (trace
, DEPTH
);
134 str
= backtrace_symbols (trace
, depth
);
139 #define STDIN_FILENO 0
142 #ifndef STDOUT_FILENO
143 #define STDOUT_FILENO 1
146 #ifndef STDERR_FILENO
147 #define STDERR_FILENO 2
150 /* We attempt to extract file and line information from addr2line. */
153 /* Local variables. */
154 int f
[2], pid
, line
, i
;
156 char addr_buf
[DEPTH
][GFC_XTOA_BUF_SIZE
], func
[BUFSIZE
], file
[BUFSIZE
];
158 const char *addr
[DEPTH
];
160 /* Write the list of addresses in hexadecimal format. */
161 for (i
= 0; i
< depth
; i
++)
162 addr
[i
] = xtoa ((GFC_UINTEGER_LARGEST
) (INTPTR_T
) trace
[i
], addr_buf
[i
],
163 sizeof (addr_buf
[i
]));
165 /* Don't output an error message if something goes wrong, we'll simply
166 fall back to the pstack and glibc backtraces. */
169 if ((pid
= fork ()) == -1)
175 #define NUM_FIXEDARGS 5
176 char *arg
[DEPTH
+NUM_FIXEDARGS
+1];
179 close (STDIN_FILENO
);
180 close (STDERR_FILENO
);
182 if (dup2 (f
[1], STDOUT_FILENO
) == -1)
186 arg
[0] = (char *) "addr2line";
187 arg
[1] = (char *) "-e";
188 arg
[2] = full_exe_path ();
189 arg
[3] = (char *) "-f";
190 arg
[4] = (char *) "-s";
191 for (i
= 0; i
< depth
; i
++)
192 arg
[NUM_FIXEDARGS
+i
] = (char *) addr
[i
];
193 arg
[NUM_FIXEDARGS
+depth
] = NULL
;
194 execvp (arg
[0], arg
);
199 /* Father process. */
202 output
= fdopen (f
[0], "r");
205 if (fgets (func
, sizeof(func
), output
))
207 st_printf ("\nBacktrace for this error:\n");
211 if (! fgets (file
, sizeof(file
), output
))
216 for (p
= func
; *p
!= '\n' && *p
!= '\r'; p
++)
221 /* Try to recognize the internal libgfortran functions. */
222 if (strncasecmp (func
, "*_gfortran", 10) == 0
223 || strncasecmp (func
, "_gfortran", 9) == 0
224 || strcmp (func
, "main") == 0 || strcmp (func
, "_start") == 0)
227 if (strcasestr (str
[i
], "libgfortran.so") != NULL
228 || strcasestr (str
[i
], "libgfortran.dylib") != NULL
229 || strcasestr (str
[i
], "libgfortran.a") != NULL
)
232 /* If we only have the address, use the glibc backtrace. */
233 if (func
[0] == '?' && func
[1] == '?' && file
[0] == '?'
236 st_printf (" + %s\n", str
[i
]);
240 /* Extract the line number. */
241 for (end
= NULL
, p
= file
; *p
; p
++)
252 if (strcmp (func
, "MAIN__") == 0)
253 st_printf (" + in the main program\n");
255 st_printf (" + function %s (0x%s)\n", func
, addr
[i
]);
257 if (line
<= 0 && strcmp (file
, "??") == 0)
261 st_printf (" from file %s\n", file
);
263 st_printf (" at line %d of file %s\n", line
, file
);
265 while (fgets (func
, sizeof(func
), output
));
271 st_printf ("** Something went wrong while running addr2line. **\n"
272 "** Falling back to a simpler backtrace scheme. **\n");
283 #if CAN_FORK && defined(HAVE_GETPPID)
284 /* Try to call pstack. */
287 /* Local variables. */
290 /* Don't output an error message if something goes wrong, we'll simply
291 fall back to the pstack and glibc backtraces. */
292 if ((pid
= fork ()) == -1)
299 char *arg
[NUM_ARGS
+1];
302 st_printf ("\nBacktrace for this error:\n");
303 arg
[0] = (char *) "pstack";
304 snprintf (buf
, sizeof(buf
), "%d", (int) getppid ());
307 execvp (arg
[0], arg
);
310 /* pstack didn't work, so we fall back to dumping the glibc
311 backtrace if we can. */
313 dump_glibc_backtrace (depth
, str
);
315 st_printf (" unable to produce a backtrace, sorry!\n");
321 /* Father process. */
329 /* Fallback to the glibc backtrace. */
330 st_printf ("\nBacktrace for this error:\n");
331 dump_glibc_backtrace (depth
, str
);