]> git.ipfire.org Git - thirdparty/gcc.git/blame - libgfortran/runtime/backtrace.c
Update copyright years.
[thirdparty/gcc.git] / libgfortran / runtime / backtrace.c
CommitLineData
7adcbafe 1/* Copyright (C) 2006-2022 Free Software Foundation, Inc.
868d75db
FXC
2 Contributed by François-Xavier Coudert
3
d30fe1c5 4This file is part of the GNU Fortran runtime library (libgfortran).
868d75db
FXC
5
6Libgfortran is free software; you can redistribute it and/or modify
7it under the terms of the GNU General Public License as published by
748086b7 8the Free Software Foundation; either version 3, or (at your option)
868d75db
FXC
9any later version.
10
868d75db
FXC
11Libgfortran is distributed in the hope that it will be useful,
12but WITHOUT ANY WARRANTY; without even the implied warranty of
13MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14GNU General Public License for more details.
15
748086b7
JJ
16Under Section 7 of GPL version 3, you are granted additional
17permissions described in the GCC Runtime Library Exception, version
183.1, as published by the Free Software Foundation.
19
20You should have received a copy of the GNU General Public License and
21a copy of the GCC Runtime Library Exception along with this program;
22see 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. */
41struct 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
53static int
54has_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
67static void
68error_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
114static int
115simple_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
123static int
124full_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
147void
1b0b9fcb 148show_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
192extern void backtrace (void);
193export_proto (backtrace);
eec2794c 194
868d75db 195void
f0f67c96 196backtrace (void)
868d75db 197{
1b0b9fcb 198 show_backtrace (false);
868d75db 199}
ad4f95e3 200