]>
Commit | Line | Data |
---|---|---|
7adcbafe | 1 | /* Copyright (C) 2006-2022 Free Software Foundation, Inc. |
868d75db FXC |
2 | Contributed by François-Xavier Coudert |
3 | ||
d30fe1c5 | 4 | This file is part of the GNU Fortran runtime library (libgfortran). |
868d75db FXC |
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 | |
748086b7 | 8 | the Free Software Foundation; either version 3, or (at your option) |
868d75db FXC |
9 | any later version. |
10 | ||
868d75db FXC |
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 | ||
748086b7 JJ |
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/>. */ | |
868d75db | 24 | |
36ae8a61 | 25 | #include "libgfortran.h" |
868d75db | 26 | |
c55879c8 JDA |
27 | #include <gthr.h> |
28 | ||
868d75db | 29 | #include <string.h> |
1b0b9fcb | 30 | #include <errno.h> |
868d75db | 31 | |
868d75db FXC |
32 | #ifdef HAVE_UNISTD_H |
33 | #include <unistd.h> | |
34 | #endif | |
35 | ||
ad4f95e3 FXC |
36 | #include "backtrace-supported.h" |
37 | #include "backtrace.h" | |
868d75db FXC |
38 | |
39 | ||
ad4f95e3 FXC |
40 | /* Store our own state while backtracing. */ |
41 | struct mystate | |
42 | { | |
ad4f95e3 | 43 | int frame; |
1b0b9fcb JB |
44 | bool try_simple; |
45 | bool in_signal_handler; | |
ad4f95e3 | 46 | }; |
1ff101ff | 47 | |
1cc0507d | 48 | |
ad4f95e3 FXC |
49 | /* Does a function name have "_gfortran_" or "_gfortrani_" prefix, possibly |
50 | with additional underscore(s) at the beginning? Cannot use strncmp() | |
51 | because we might be called from a signal handler. */ | |
c861db66 | 52 | |
ad4f95e3 FXC |
53 | static int |
54 | has_gfortran_prefix (const char *s) | |
eec2794c | 55 | { |
ad4f95e3 FXC |
56 | if (!s) |
57 | return 0; | |
868d75db | 58 | |
ad4f95e3 FXC |
59 | while (*s == '_') |
60 | s++; | |
868d75db | 61 | |
ad4f95e3 FXC |
62 | return (s[0] == 'g' && s[1] == 'f' && s[2] == 'o' && s[3] == 'r' |
63 | && s[4] == 't' && s[5] == 'r' && s[6] == 'a' && s[7] == 'n' | |
64 | && (s[8] == '_' || (s[8] == 'i' && s[9] == '_'))); | |
65 | } | |
868d75db | 66 | |
ad4f95e3 FXC |
67 | static void |
68 | error_callback (void *data, const char *msg, int errnum) | |
eec2794c | 69 | { |
ad4f95e3 | 70 | struct mystate *state = (struct mystate *) data; |
edaaef60 | 71 | struct iovec iov[5]; |
1b0b9fcb JB |
72 | #define ERRHDR "\nCould not print backtrace: " |
73 | ||
ad4f95e3 | 74 | if (errnum < 0) |
1028b2bd | 75 | { |
1b0b9fcb | 76 | state->try_simple = true; |
ad4f95e3 | 77 | return; |
1028b2bd | 78 | } |
1b0b9fcb JB |
79 | else if (errnum == 0) |
80 | { | |
edaaef60 JB |
81 | iov[0].iov_base = (char*) ERRHDR; |
82 | iov[0].iov_len = strlen (ERRHDR); | |
83 | iov[1].iov_base = (char*) msg; | |
84 | iov[1].iov_len = strlen (msg); | |
85 | iov[2].iov_base = (char*) "\n"; | |
86 | iov[2].iov_len = 1; | |
87 | estr_writev (iov, 3); | |
1b0b9fcb JB |
88 | } |
89 | else | |
90 | { | |
91 | char errbuf[256]; | |
92 | if (state->in_signal_handler) | |
93 | { | |
edaaef60 JB |
94 | iov[0].iov_base = (char*) ERRHDR; |
95 | iov[0].iov_len = strlen (ERRHDR); | |
96 | iov[1].iov_base = (char*) msg; | |
97 | iov[1].iov_len = strlen (msg); | |
98 | iov[2].iov_base = (char*) ", errno: "; | |
99 | iov[2].iov_len = strlen (iov[2].iov_base); | |
4ae906e4 | 100 | /* Async-signal-safe function, errnum must be positive. */ |
1b0b9fcb | 101 | const char *p = gfc_itoa (errnum, errbuf, sizeof (errbuf)); |
edaaef60 JB |
102 | iov[3].iov_base = (char*) p; |
103 | iov[3].iov_len = strlen (p); | |
104 | iov[4].iov_base = (char*) "\n"; | |
105 | iov[4].iov_len = 1; | |
106 | estr_writev (iov, 5); | |
1b0b9fcb JB |
107 | } |
108 | else | |
109 | st_printf (ERRHDR "%s: %s\n", msg, | |
110 | gf_strerror (errnum, errbuf, sizeof (errbuf))); | |
111 | } | |
ad4f95e3 | 112 | } |
868d75db | 113 | |
ad4f95e3 FXC |
114 | static int |
115 | simple_callback (void *data, uintptr_t pc) | |
116 | { | |
117 | struct mystate *state = (struct mystate *) data; | |
118 | st_printf ("#%d 0x%lx\n", state->frame, (unsigned long) pc); | |
119 | (state->frame)++; | |
120 | return 0; | |
121 | } | |
155732f5 | 122 | |
ad4f95e3 FXC |
123 | static int |
124 | full_callback (void *data, uintptr_t pc, const char *filename, | |
125 | int lineno, const char *function) | |
1ff101ff | 126 | { |
ad4f95e3 FXC |
127 | struct mystate *state = (struct mystate *) data; |
128 | ||
129 | if (has_gfortran_prefix (function)) | |
130 | return 0; | |
131 | ||
132 | st_printf ("#%d 0x%lx in %s\n", state->frame, | |
133 | (unsigned long) pc, function == NULL ? "???" : function); | |
134 | if (filename || lineno != 0) | |
135 | st_printf ("\tat %s:%d\n", filename == NULL ? "???" : filename, lineno); | |
136 | (state->frame)++; | |
137 | ||
138 | if (function != NULL && strcmp (function, "main") == 0) | |
139 | return 1; | |
140 | ||
141 | return 0; | |
1ff101ff | 142 | } |
155732f5 | 143 | |
ad4f95e3 FXC |
144 | |
145 | /* Display the backtrace. */ | |
146 | ||
147 | void | |
1b0b9fcb | 148 | show_backtrace (bool in_signal_handler) |
1ff101ff | 149 | { |
854cedfd JB |
150 | /* Note that libbacktrace allows the state to be accessed from |
151 | multiple threads, so we don't need to use a TLS variable for the | |
152 | state here. */ | |
df996c3f JB |
153 | static struct backtrace_state *lbstate_saved; |
154 | struct backtrace_state *lbstate; | |
1b0b9fcb | 155 | struct mystate state = { 0, false, in_signal_handler }; |
854cedfd | 156 | |
df996c3f | 157 | lbstate = __atomic_load_n (&lbstate_saved, __ATOMIC_RELAXED); |
854cedfd | 158 | if (!lbstate) |
df996c3f JB |
159 | { |
160 | lbstate = backtrace_create_state (NULL, __gthread_active_p (), | |
161 | error_callback, NULL); | |
162 | if (lbstate) | |
163 | __atomic_store_n (&lbstate_saved, lbstate, __ATOMIC_RELAXED); | |
164 | else | |
165 | return; | |
166 | } | |
1ff101ff | 167 | |
ad4f95e3 | 168 | if (!BACKTRACE_SUPPORTED || (in_signal_handler && BACKTRACE_USES_MALLOC)) |
1ff101ff | 169 | { |
ad4f95e3 FXC |
170 | /* If symbolic backtrace is not supported on this target, or would |
171 | require malloc() and we are in a signal handler, go with a | |
172 | simple backtrace. */ | |
173 | ||
174 | backtrace_simple (lbstate, 0, simple_callback, error_callback, &state); | |
1ff101ff JB |
175 | } |
176 | else | |
177 | { | |
ad4f95e3 FXC |
178 | /* libbacktrace uses mmap, which is safe to call from a signal handler |
179 | (in practice, if not in theory). Thus we can generate a symbolic | |
180 | backtrace, if debug symbols are available. */ | |
181 | ||
182 | backtrace_full (lbstate, 0, full_callback, error_callback, &state); | |
183 | if (state.try_simple) | |
184 | backtrace_simple (lbstate, 0, simple_callback, error_callback, &state); | |
1ff101ff | 185 | } |
ad4f95e3 | 186 | } |
1ff101ff | 187 | |
1ff101ff | 188 | |
1ff101ff | 189 | |
ad4f95e3 | 190 | /* Function called by the front-end translating the BACKTRACE intrinsic. */ |
1ff101ff | 191 | |
ad4f95e3 FXC |
192 | extern void backtrace (void); |
193 | export_proto (backtrace); | |
eec2794c | 194 | |
868d75db | 195 | void |
f0f67c96 | 196 | backtrace (void) |
868d75db | 197 | { |
1b0b9fcb | 198 | show_backtrace (false); |
868d75db | 199 | } |
ad4f95e3 | 200 |