libgfortran/runtime/backtrace.c

   1 /* Copyright (C) 2006, 2007 Free Software Foundation, Inc.
   2    Contributed by François-Xavier Coudert
   3
   4 This file is part of the GNU Fortran 95 runtime library (libgfortran).
   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
   8 the Free Software Foundation; either version 2, or (at your option)
   9 any later version.
  10
  11 In addition to the permissions in the GNU General Public License, the
  12 Free Software Foundation gives you unlimited permission to link the
  13 compiled version of this file into combinations with other programs,
  14 and to distribute those combinations without any restriction coming
  15 from the use of this file.  (The General Public License restrictions
  16 do apply in other respects; for example, they cover modification of
  17 the file, and distribution when not linked into a combine
  18 executable.)
  19
  20 Libgfortran is distributed in the hope that it will be useful,
  21 but WITHOUT ANY WARRANTY; without even the implied warranty of
  22 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  23 GNU General Public License for more details.
  24
  25 You should have received a copy of the GNU General Public License
  26 along with libgfortran; see the file COPYING.  If not, write to
  27 the Free Software Foundation, 51 Franklin Street, Fifth Floor,
  28 Boston, MA 02110-1301, USA.  */
  29
  30 #include "libgfortran.h"
  31
  32 #include <string.h>
  33
  34 #ifdef HAVE_STDLIB_H
  35 #include <stdlib.h>
  36 #endif
  37
  38 #ifdef HAVE_INTTYPES_H
  39 #include <inttypes.h>
  40 #endif
  41
  42 #ifdef HAVE_UNISTD_H
  43 #include <unistd.h>
  44 #endif
  45
  46 #ifdef HAVE_EXECINFO_H
  47 #include <execinfo.h>
  48 #endif
  49
  50 #ifdef HAVE_SYS_WAIT_H
  51 #include <sys/wait.h>
  52 #endif
  53
  54 #include <ctype.h>
  55
  56
  57 /* Macros for common sets of capabilities: can we fork and exec, can
  58    we use glibc-style backtrace functions, and can we use pipes.  */
  59 #define CAN_FORK (defined(HAVE_FORK) && defined(HAVE_EXECVP) \
  60                   && defined(HAVE_WAIT))
  61 #define GLIBC_BACKTRACE (defined(HAVE_BACKTRACE) \
  62                          && defined(HAVE_BACKTRACE_SYMBOLS))
  63 #define CAN_PIPE (CAN_FORK && defined(HAVE_PIPE) \
  64                   && defined(HAVE_DUP2) && defined(HAVE_FDOPEN) \
  65                   && defined(HAVE_CLOSE))
  66
  67
  68 #if GLIBC_BACKTRACE && CAN_PIPE
  69 static char *
  70 local_strcasestr (const char *s1, const char *s2)
  71 {
  72 #ifdef HAVE_STRCASESTR
  73   return strcasestr (s1, s2);
  74 #else
  75
  76   const char *p = s1;
  77   const size_t len = strlen (s2);
  78   const char u = *s2, v = isupper((int) *s2) ? tolower((int) *s2)
  79                                   : (islower((int) *s2) ? toupper((int) *s2)
  80                                                         : *s2);
  81
  82   while (1)
  83     {
  84       while (*p != u && *p != v && *p)
  85         p++;
  86       if (*p == 0)
  87         return NULL;
  88       if (strncasecmp (p, s2, len) == 0)
  89         return (char *)p;
  90     }
  91 #endif
  92 }
  93 #endif
  94
  95
  96 #if GLIBC_BACKTRACE
  97 static void
  98 dump_glibc_backtrace (int depth, char *str[])
  99 {
 100   int i;
 101
 102   for (i = 0; i < depth; i++)
 103     st_printf ("  + %s\n", str[i]);
 104
 105   free (str);
 106 }
 107 #endif
 108
 109 /* show_backtrace displays the backtrace, currently obtained by means of
 110    the glibc backtrace* functions.  */
 111 void
 112 show_backtrace (void)
 113 {
 114 #if GLIBC_BACKTRACE
 115
 116 #define DEPTH 50
 117 #define BUFSIZE 1024
 118
 119   void *trace[DEPTH];
 120   char **str;
 121   int depth;
 122
 123   depth = backtrace (trace, DEPTH);
 124   if (depth <= 0)
 125     return;
 126
 127   str = backtrace_symbols (trace, depth);
 128
 129 #if CAN_PIPE
 130
 131 #ifndef STDIN_FILENO
 132 #define STDIN_FILENO 0
 133 #endif
 134
 135 #ifndef STDOUT_FILENO
 136 #define STDOUT_FILENO 1
 137 #endif
 138
 139 #ifndef STDERR_FILENO
 140 #define STDERR_FILENO 2
 141 #endif
 142
 143   /* We attempt to extract file and line information from addr2line.  */
 144   do
 145   {
 146     /* Local variables.  */
 147     int f[2], pid, line, i;
 148     FILE *output;
 149     char addr_buf[DEPTH][GFC_XTOA_BUF_SIZE], func[BUFSIZE], file[BUFSIZE];
 150     char *p, *end;
 151     const char *addr[DEPTH];
 152
 153     /* Write the list of addresses in hexadecimal format.  */
 154     for (i = 0; i < depth; i++)
 155       addr[i] = xtoa ((GFC_UINTEGER_LARGEST) (intptr_t) trace[i], addr_buf[i],
 156                       sizeof (addr_buf[i]));
 157
 158     /* Don't output an error message if something goes wrong, we'll simply
 159        fall back to the pstack and glibc backtraces.  */
 160     if (pipe (f) != 0)
 161       break;
 162     if ((pid = fork ()) == -1)
 163       break;
 164
 165     if (pid == 0)
 166       {
 167         /* Child process.  */
 168 #define NUM_FIXEDARGS 5
 169         char *arg[DEPTH+NUM_FIXEDARGS+1];
 170
 171         close (f[0]);
 172         close (STDIN_FILENO);
 173         close (STDERR_FILENO);
 174
 175         if (dup2 (f[1], STDOUT_FILENO) == -1)
 176           _exit (0);
 177         close (f[1]);
 178
 179         arg[0] = (char *) "addr2line";
 180         arg[1] = (char *) "-e";
 181         arg[2] = full_exe_path ();
 182         arg[3] = (char *) "-f";
 183         arg[4] = (char *) "-s";
 184         for (i = 0; i < depth; i++)
 185           arg[NUM_FIXEDARGS+i] = (char *) addr[i];
 186         arg[NUM_FIXEDARGS+depth] = NULL;
 187         execvp (arg[0], arg);
 188         _exit (0);
 189 #undef NUM_FIXEDARGS
 190       }
 191
 192     /* Father process.  */
 193     close (f[1]);
 194     wait (NULL);
 195     output = fdopen (f[0], "r");
 196     i = -1;
 197
 198     if (fgets (func, sizeof(func), output))
 199       {
 200         st_printf ("\nBacktrace for this error:\n");
 201
 202         do
 203           {
 204             if (! fgets (file, sizeof(file), output))
 205               goto fallback;
 206
 207             i++;
 208
 209             for (p = func; *p != '\n' && *p != '\r'; p++)
 210               ;
 211
 212             *p = '\0';
 213
 214             /* Try to recognize the internal libgfortran functions.  */
 215             if (strncasecmp (func, "*_gfortran", 10) == 0
 216                 || strncasecmp (func, "_gfortran", 9) == 0
 217                 || strcmp (func, "main") == 0 || strcmp (func, "_start") == 0
 218                 || strcmp (func, "_gfortrani_handler") == 0)
 219               continue;
 220
 221             if (local_strcasestr (str[i], "libgfortran.so") != NULL
 222                 || local_strcasestr (str[i], "libgfortran.dylib") != NULL
 223                 || local_strcasestr (str[i], "libgfortran.a") != NULL)
 224               continue;
 225
 226             /* If we only have the address, use the glibc backtrace.  */
 227             if (func[0] == '?' && func[1] == '?' && file[0] == '?'
 228                 && file[1] == '?')
 229               {
 230                 st_printf ("  + %s\n", str[i]);
 231                 continue;
 232               }
 233
 234             /* Extract the line number.  */
 235             for (end = NULL, p = file; *p; p++)
 236               if (*p == ':')
 237                 end = p;
 238             if (end != NULL)
 239               {
 240                 *end = '\0';
 241                 line = atoi (++end);
 242               }
 243             else
 244               line = -1;
 245
 246             if (strcmp (func, "MAIN__") == 0)
 247               st_printf ("  + in the main program\n");
 248             else
 249               st_printf ("  + function %s (0x%s)\n", func, addr[i]);
 250
 251             if (line <= 0 && strcmp (file, "??") == 0)
 252               continue;
 253
 254             if (line <= 0)
 255               st_printf ("    from file %s\n", file);
 256             else
 257               st_printf ("    at line %d of file %s\n", line, file);
 258           }
 259         while (fgets (func, sizeof(func), output));
 260
 261         free (str);
 262         return;
 263
 264 fallback:
 265         st_printf ("** Something went wrong while running addr2line. **\n"
 266                    "** Falling back  to a simpler  backtrace scheme. **\n");
 267       }
 268     }
 269   while (0);
 270
 271 #undef DEPTH
 272 #undef BUFSIZE
 273
 274 #endif
 275 #endif
 276
 277 #if CAN_FORK && defined(HAVE_GETPPID)
 278   /* Try to call pstack.  */
 279   do
 280   {
 281     /* Local variables.  */
 282     int pid;
 283
 284     /* Don't output an error message if something goes wrong, we'll simply
 285        fall back to the pstack and glibc backtraces.  */
 286     if ((pid = fork ()) == -1)
 287       break;
 288
 289     if (pid == 0)
 290       {
 291         /* Child process.  */
 292 #define NUM_ARGS 2
 293         char *arg[NUM_ARGS+1];
 294         char buf[20];
 295
 296         st_printf ("\nBacktrace for this error:\n");
 297         arg[0] = (char *) "pstack";
 298 #ifdef HAVE_SNPRINTF
 299         snprintf (buf, sizeof(buf), "%d", (int) getppid ());
 300 #else
 301         sprintf (buf, "%d", (int) getppid ());
 302 #endif
 303         arg[1] = buf;
 304         arg[2] = NULL;
 305         execvp (arg[0], arg);
 306 #undef NUM_ARGS
 307
 308         /* pstack didn't work, so we fall back to dumping the glibc
 309            backtrace if we can.  */
 310 #if GLIBC_BACKTRACE
 311         dump_glibc_backtrace (depth, str);
 312 #else
 313         st_printf ("  unable to produce a backtrace, sorry!\n");
 314 #endif
 315
 316         _exit (0);
 317       }
 318
 319     /* Father process.  */
 320     wait (NULL);
 321     return;
 322   }
 323   while(0);
 324 #endif
 325
 326 #if GLIBC_BACKTRACE
 327   /* Fallback to the glibc backtrace.  */
 328   st_printf ("\nBacktrace for this error:\n");
 329   dump_glibc_backtrace (depth, str);
 330 #endif
 331 }