Add _FloatN, _FloatNx tests for __builtin_fpclassify.
[official-gcc.git] / libgfortran / runtime / backtrace.c
blob5b8735d53f43554beda91ca0531ba7fa7314000f
1 /* Copyright (C) 2006-2016 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)
9 any later version.
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"
27 #include <gthr.h>
29 #include <string.h>
30 #include <stdlib.h>
31 #include <errno.h>
33 #ifdef HAVE_UNISTD_H
34 #include <unistd.h>
35 #endif
37 #include "backtrace-supported.h"
38 #include "backtrace.h"
41 /* Store our own state while backtracing. */
42 struct mystate
44 int frame;
45 bool try_simple;
46 bool in_signal_handler;
50 /* Does a function name have "_gfortran_" or "_gfortrani_" prefix, possibly
51 with additional underscore(s) at the beginning? Cannot use strncmp()
52 because we might be called from a signal handler. */
54 static int
55 has_gfortran_prefix (const char *s)
57 if (!s)
58 return 0;
60 while (*s == '_')
61 s++;
63 return (s[0] == 'g' && s[1] == 'f' && s[2] == 'o' && s[3] == 'r'
64 && s[4] == 't' && s[5] == 'r' && s[6] == 'a' && s[7] == 'n'
65 && (s[8] == '_' || (s[8] == 'i' && s[9] == '_')));
68 static void
69 error_callback (void *data, const char *msg, int errnum)
71 struct mystate *state = (struct mystate *) data;
72 #define ERRHDR "\nCould not print backtrace: "
74 if (errnum < 0)
76 state->try_simple = true;
77 return;
79 else if (errnum == 0)
81 estr_write (ERRHDR);
82 estr_write (msg);
83 estr_write ("\n");
85 else
87 char errbuf[256];
88 if (state->in_signal_handler)
90 estr_write (ERRHDR);
91 estr_write (msg);
92 estr_write (", errno: ");
93 const char *p = gfc_itoa (errnum, errbuf, sizeof (errbuf));
94 estr_write (p);
95 estr_write ("\n");
97 else
98 st_printf (ERRHDR "%s: %s\n", msg,
99 gf_strerror (errnum, errbuf, sizeof (errbuf)));
103 static int
104 simple_callback (void *data, uintptr_t pc)
106 struct mystate *state = (struct mystate *) data;
107 st_printf ("#%d 0x%lx\n", state->frame, (unsigned long) pc);
108 (state->frame)++;
109 return 0;
112 static int
113 full_callback (void *data, uintptr_t pc, const char *filename,
114 int lineno, const char *function)
116 struct mystate *state = (struct mystate *) data;
118 if (has_gfortran_prefix (function))
119 return 0;
121 st_printf ("#%d 0x%lx in %s\n", state->frame,
122 (unsigned long) pc, function == NULL ? "???" : function);
123 if (filename || lineno != 0)
124 st_printf ("\tat %s:%d\n", filename == NULL ? "???" : filename, lineno);
125 (state->frame)++;
127 if (function != NULL && strcmp (function, "main") == 0)
128 return 1;
130 return 0;
134 /* Display the backtrace. */
136 void
137 show_backtrace (bool in_signal_handler)
139 struct backtrace_state *lbstate;
140 struct mystate state = { 0, false, in_signal_handler };
142 lbstate = backtrace_create_state (NULL, __gthread_active_p (),
143 error_callback, NULL);
145 if (lbstate == NULL)
146 return;
148 if (!BACKTRACE_SUPPORTED || (in_signal_handler && BACKTRACE_USES_MALLOC))
150 /* If symbolic backtrace is not supported on this target, or would
151 require malloc() and we are in a signal handler, go with a
152 simple backtrace. */
154 backtrace_simple (lbstate, 0, simple_callback, error_callback, &state);
156 else
158 /* libbacktrace uses mmap, which is safe to call from a signal handler
159 (in practice, if not in theory). Thus we can generate a symbolic
160 backtrace, if debug symbols are available. */
162 backtrace_full (lbstate, 0, full_callback, error_callback, &state);
163 if (state.try_simple)
164 backtrace_simple (lbstate, 0, simple_callback, error_callback, &state);
170 /* Function called by the front-end translating the BACKTRACE intrinsic. */
172 extern void backtrace (void);
173 export_proto (backtrace);
175 void
176 backtrace (void)
178 show_backtrace (false);