libgfortran/runtime/backtrace.c

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