1 /* Copyright (C) 2006-2013 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. */
196 state
.frame_number
= 0;
201 if (addr2line_path
== NULL
)
204 /* We attempt to extract file and line information from addr2line. */
207 /* Local variables. */
208 int f
[2], pid
, inp
[2];
210 /* Don't output an error message if something goes wrong, we'll simply
211 fall back to printing the addresses. */
216 if ((pid
= fork ()) == -1)
222 #define NUM_FIXEDARGS 7
223 char *arg
[NUM_FIXEDARGS
];
224 char *newenv
[] = { NULL
};
229 if (dup2 (inp
[0], STDIN_FILENO
) == -1)
233 close (STDERR_FILENO
);
235 if (dup2 (f
[1], STDOUT_FILENO
) == -1)
239 arg
[0] = addr2line_path
;
240 arg
[1] = (char *) "-e";
241 arg
[2] = full_exe_path ();
242 arg
[3] = (char *) "-f";
243 arg
[4] = (char *) "-s";
244 arg
[5] = (char *) "-C";
246 execve (addr2line_path
, arg
, newenv
);
251 /* Father process. */
255 state
.outfd
= inp
[1];
257 state
.direct_output
= 0;
258 _Unwind_Backtrace (trace_function
, &state
);
267 estr_write ("** Something went wrong while running addr2line. **\n"
268 "** Falling back to a simpler backtrace scheme. **\n");
273 #endif /* CAN_PIPE */
275 /* Fallback to the simple backtrace without addr2line. */
276 state
.direct_output
= 1;
277 _Unwind_Backtrace (trace_function
, &state
);