OSDN Git Service

* trans-array.c (gfc_trans_array_constructor): Loop over the parents.
[pf3gnuchains/gcc-fork.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_FD))
58 #define CAN_PIPE (CAN_FORK && defined(HAVE_PIPE) \
59                   && defined(HAVE_DUP2) && defined(HAVE_FDOPEN) \
60                   && defined(HAVE_CLOSE))
61
62
63 /* GDB style #NUM index for each stack frame.  */
64
65 static void 
66 bt_header (int num)
67 {
68   st_printf (" #%d  ", num);
69 }
70
71
72 /* fgets()-like function that reads a line from a fd, without
73    needing to malloc() a buffer, and does not use locks, hence should
74    be async-signal-safe.  */
75
76 static char *
77 fd_gets (char *s, int size, int fd)
78 {
79   for (int i = 0; i < size; i++)
80     {
81       char c;
82       ssize_t nread = read (fd, &c, 1);
83       if (nread == 1)
84         {
85           s[i] = c;
86           if (c == '\n')
87             {
88               if (i + 1 < size)
89                 s[i+1] = '\0';
90               else
91                 s[i] = '\0';
92               break;
93             }
94         }
95       else
96         {
97           s[i] = '\0';
98           if (i == 0)
99             return NULL;
100           break;
101         }
102     }
103   return s;
104 }
105
106
107 extern char *addr2line_path;
108
109
110 /* show_backtrace displays the backtrace, currently obtained by means of
111    the glibc backtrace* functions.  */
112
113 void
114 show_backtrace (void)
115 {
116 #if GLIBC_BACKTRACE
117
118 #define DEPTH 50
119 #define BUFSIZE 1024
120
121   void *trace[DEPTH];
122   int depth;
123
124   depth = backtrace (trace, DEPTH);
125   if (depth <= 0)
126     return;
127
128 #if CAN_PIPE
129
130   if (addr2line_path == NULL)
131     goto fallback_noerr;
132
133   /* We attempt to extract file and line information from addr2line.  */
134   do
135   {
136     /* Local variables.  */
137     int f[2], pid, bt[2], inp[2];
138     char addr_buf[GFC_XTOA_BUF_SIZE], func[BUFSIZE], file[BUFSIZE];
139     char *p;
140
141     /* Don't output an error message if something goes wrong, we'll simply
142        fall back to the pstack and glibc backtraces.  */
143     if (pipe (f) != 0)
144       break;
145     if (pipe (inp) != 0)
146       break;
147     if ((pid = fork ()) == -1)
148       break;
149
150     if (pid == 0)
151       {
152         /* Child process.  */
153 #define NUM_FIXEDARGS 7
154         char *arg[NUM_FIXEDARGS];
155         char *newenv[] = { NULL };
156
157         close (f[0]);
158
159         close (inp[1]);
160         if (dup2 (inp[0], STDIN_FILENO) == -1)
161           _exit (1);
162         close (inp[0]);
163
164         close (STDERR_FILENO);
165
166         if (dup2 (f[1], STDOUT_FILENO) == -1)
167           _exit (1);
168         close (f[1]);
169
170         arg[0] = addr2line_path;
171         arg[1] = (char *) "-e";
172         arg[2] = full_exe_path ();
173         arg[3] = (char *) "-f";
174         arg[4] = (char *) "-s";
175         arg[5] = (char *) "-C";
176         arg[6] = NULL;
177         execve (addr2line_path, arg, newenv);
178         _exit (1);
179 #undef NUM_FIXEDARGS
180       }
181
182     /* Father process.  */
183     close (f[1]);
184     close (inp[0]);
185     if (pipe (bt) != 0)
186       break;
187     backtrace_symbols_fd (trace, depth, bt[1]);
188     close (bt[1]);
189
190     estr_write ("\nBacktrace for this error:\n");
191     for (int j = 0; j < depth; j++)
192       {
193         const char *addr = gfc_xtoa 
194           ((GFC_UINTEGER_LARGEST) (intptr_t) trace[j], 
195            addr_buf, sizeof (addr_buf));
196
197         write (inp[1], addr, strlen (addr));
198         write (inp[1], "\n", 1);
199         
200         if (! fd_gets (func, sizeof(func), f[0]))
201           goto fallback;
202         if (! fd_gets (file, sizeof(file), f[0]))
203           goto fallback;
204             
205         for (p = func; *p != '\n' && *p != '\r'; p++)
206           ;
207         *p = '\0';
208         
209         /* If we only have the address, use the glibc backtrace.  */
210         if (func[0] == '?' && func[1] == '?' && file[0] == '?'
211             && file[1] == '?')
212           {
213             bt_header (j);
214             while (1)
215               {
216                 char bc;
217                 ssize_t nread = read (bt[0], &bc, 1);
218                 if (nread != 1 || bc == '\n')
219                   break;
220                 write (STDERR_FILENO, &bc, 1);
221               }
222             estr_write ("\n");
223             continue;
224           }
225         else
226           {
227             /* Forward to the next entry in the backtrace. */
228             while (1)
229               {
230                 char bc;
231                 ssize_t nread = read (bt[0], &bc, 1);
232                 if (nread != 1 || bc == '\n')
233                   break;
234               }
235           }
236
237         /* _start is a setup routine that calls main(), and main() is
238            the frontend routine that calls some setup stuff and then
239            calls MAIN__, so at this point we should stop.  */
240         if (strcmp (func, "_start") == 0 || strcmp (func, "main") == 0)
241           break;
242         
243         bt_header (j);
244         estr_write (full_exe_path ());
245         estr_write ("[0x");
246         estr_write (addr);
247         estr_write ("] in ");
248         estr_write (func);
249         
250         if (strncmp (file, "??", 2) == 0)
251           estr_write ("\n");
252         else
253           {
254             estr_write (" at ");
255             estr_write (file);
256           }
257       } /* Loop over each hex address.  */
258     close (inp[1]);
259     close (bt[0]);
260     wait (NULL);
261     return;
262
263 fallback:
264     estr_write ("** Something went wrong while running addr2line. **\n"
265                 "** Falling back  to a simpler  backtrace scheme. **\n");
266   }
267   while (0);
268
269 #undef DEPTH
270 #undef BUFSIZE
271
272 #endif /* CAN_PIPE */
273
274 fallback_noerr:
275   /* Fallback to the glibc backtrace.  */
276   estr_write ("\nBacktrace for this error:\n");
277   backtrace_symbols_fd (trace, depth, STDERR_FILENO);
278   return;
279
280 #elif defined(CAN_FORK) && defined(HAVE_GETPPID)
281   /* Try to call pstack.  */
282   do
283   {
284     /* Local variables.  */
285     int pid;
286
287     /* Don't output an error message if something goes wrong, we'll simply
288        fall back to the pstack and glibc backtraces.  */
289     if ((pid = fork ()) == -1)
290       break;
291
292     if (pid == 0)
293       {
294         /* Child process.  */
295 #define NUM_ARGS 2
296         char *arg[NUM_ARGS+1];
297         char buf[20];
298
299         estr_write ("\nBacktrace for this error:\n");
300         arg[0] = (char *) "pstack";
301         snprintf (buf, sizeof(buf), "%d", (int) getppid ());
302         arg[1] = buf;
303         arg[2] = NULL;
304         execvp (arg[0], arg);
305 #undef NUM_ARGS
306
307         /* pstack didn't work.  */
308         estr_write ("  unable to produce a backtrace, sorry!\n");
309         _exit (1);
310       }
311
312     /* Father process.  */
313     wait (NULL);
314     return;
315   }
316   while(0);
317 #else
318   estr_write ("\nBacktrace not yet available on this platform, sorry!\n");
319 #endif
320 }