1 /* Copyright (C) 2006, 2007, 2009, 2011, 2012 Free Software Foundation, Inc.
2 Contributed by François-Xavier Coudert
4 This file is part of the GNU Fortran 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 3, or (at your option)
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.
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.
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/>. */
25 #include "libgfortran.h"
34 #ifdef HAVE_SYS_WAIT_H
43 /* Macros for common sets of capabilities: can we fork and exec, and
44 can we use pipes to communicate with the subprocess. */
45 #define CAN_FORK (defined(HAVE_FORK) && defined(HAVE_EXECVE) \
46 && defined(HAVE_WAIT))
47 #define CAN_PIPE (CAN_FORK && defined(HAVE_PIPE) \
48 && defined(HAVE_DUP2) && defined(HAVE_CLOSE))
55 /* GDB style #NUM index for each stack frame. */
60 st_printf ("#%d ", num
);
64 /* fgets()-like function that reads a line from a fd, without
65 needing to malloc() a buffer, and does not use locks, hence should
66 be async-signal-safe. */
69 fd_gets (char *s
, int size
, int fd
)
71 for (int i
= 0; i
< size
; i
++)
74 ssize_t nread
= read (fd
, &c
, 1);
99 extern char *addr2line_path
;
101 /* Struct containing backtrace state. */
112 static _Unwind_Reason_Code
113 trace_function (struct _Unwind_Context
*context
, void *state_ptr
)
115 bt_state
* state
= (bt_state
*) state_ptr
;
117 #ifdef HAVE_GETIPINFO
118 int ip_before_insn
= 0;
119 ip
= _Unwind_GetIPInfo (context
, &ip_before_insn
);
121 /* If the unwinder gave us a 'return' address, roll it back a little
122 to ensure we get the correct line number for the call itself. */
123 if (! ip_before_insn
)
126 ip
= _Unwind_GetIP (context
);
129 if (state
->direct_output
)
131 bt_header(state
->frame_number
);
132 st_printf ("%p\n", (void*) ip
);
136 char addr_buf
[GFC_XTOA_BUF_SIZE
], func
[1024], file
[PATH_MAX
];
138 const char* addr
= gfc_xtoa (ip
, addr_buf
, sizeof (addr_buf
));
139 write (state
->outfd
, addr
, strlen (addr
));
140 write (state
->outfd
, "\n", 1);
142 if (! fd_gets (func
, sizeof(func
), state
->infd
))
147 if (! fd_gets (file
, sizeof(file
), state
->infd
))
153 for (p
= func
; *p
!= '\n' && *p
!= '\r'; p
++)
157 /* _start is a setup routine that calls main(), and main() is
158 the frontend routine that calls some setup stuff and then
159 calls MAIN__, so at this point we should stop. */
160 if (strcmp (func
, "_start") == 0 || strcmp (func
, "main") == 0)
161 return _URC_END_OF_STACK
;
163 bt_header (state
->frame_number
);
167 if (func
[0] != '?' && func
[1] != '?')
173 if (strncmp (file
, "??", 2) == 0)
184 state
->frame_number
++;
186 return _URC_NO_REASON
;
190 /* Display the backtrace. */
193 show_backtrace (void)
196 state
.frame_number
= 0;
199 estr_write ("\nBacktrace for this error:\n");
203 if (addr2line_path
== NULL
)
206 /* We attempt to extract file and line information from addr2line. */
209 /* Local variables. */
210 int f
[2], pid
, inp
[2];
212 /* Don't output an error message if something goes wrong, we'll simply
213 fall back to printing the addresses. */
218 if ((pid
= fork ()) == -1)
224 #define NUM_FIXEDARGS 7
225 char *arg
[NUM_FIXEDARGS
];
226 char *newenv
[] = { NULL
};
231 if (dup2 (inp
[0], STDIN_FILENO
) == -1)
235 close (STDERR_FILENO
);
237 if (dup2 (f
[1], STDOUT_FILENO
) == -1)
241 arg
[0] = addr2line_path
;
242 arg
[1] = (char *) "-e";
243 arg
[2] = full_exe_path ();
244 arg
[3] = (char *) "-f";
245 arg
[4] = (char *) "-s";
246 arg
[5] = (char *) "-C";
248 execve (addr2line_path
, arg
, newenv
);
253 /* Father process. */
257 state
.outfd
= inp
[1];
259 state
.direct_output
= 0;
260 _Unwind_Backtrace (trace_function
, &state
);
268 estr_write ("** Something went wrong while running addr2line. **\n"
269 "** Falling back to a simpler backtrace scheme. **\n");
274 #endif /* CAN_PIPE */
276 /* Fallback to the simple backtrace without addr2line. */
277 state
.direct_output
= 1;
278 _Unwind_Backtrace (trace_function
, &state
);