OSDN Git Service

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