Re: [Patch, libfortran] PR 48931 Async-signal-safety of backtrace signal handler

Re: [Patch, libfortran] PR 48931 Async-signal-safety of backtrace signal handler

[FX]

Dear Janne,

Sorry I'm a bit late on this, but since async-signal-safe code is so hard to get right (at least for me), I wanted to help review your new code. It's very nice to have this instead of my initial ugly implementation, and I have only spotted on issue: AFAICT, execvp() is not safe to use here; only execle() and execve() are.

Cheers!
FX

Re: [Patch, libfortran] PR 48931 Async-signal-safety of backtrace signal handler

[Janne Blomqvist]

On Sun, May 22, 2011 at 23:21, FX <fxcoudert@gmail.com> wrote:
> Dear Janne,
>
> Sorry I'm a bit late on this, but since async-signal-safe code is so hard to get right (at least for me), I wanted to help review your new code. It's very nice to have this instead of my initial ugly implementation, and I have only spotted on issue: AFAICT, execvp() is not safe to use here; only execle() and execve() are.

Ah, good catch! That's a bit of a bummer though, since the nice thing
about execvp() is that it searches the path for the executable, so
it'll work even if the user has addr2line installed somewhere else
than /usr/bin. For execve(), one needs to provide an absolute path.

One solution could be to search the PATH for addr2line during library
initialization (where we don't need to be async-signal-safe), and then
store it somewhere and use it in show_backtrace().

-- 
Janne Blomqvist

Re: [Patch, libfortran] PR 48931 Async-signal-safety of backtrace signal handler

[FX]

> Ah, good catch! That's a bit of a bummer though, since the nice thing
> about execvp() is that it searches the path for the executable, so
> it'll work even if the user has addr2line installed somewhere else
> than /usr/bin. For execve(), one needs to provide an absolute path.

Yes, I know. Sorry :)

> One solution could be to search the PATH for addr2line during library
> initialization (where we don't need to be async-signal-safe), and then
> store it somewhere and use it in show_backtrace().

That's one way. Another way is just to store a copy of the PATH during initialization, and only search addr2line when really needed (which can be done with a static buffer and a series of call to execve(), can't it?)

FX

Re: [Patch, libfortran] PR 48931 Async-signal-safety of backtrace signal handler

[N.M. Maclaren]

On May 24 2011, FX wrote:
>
>> One solution could be to search the PATH for addr2line during library
>> initialization (where we don't need to be async-signal-safe), and then
>> store it somewhere and use it in show_backtrace().
>
> That's one way. Another way is just to store a copy of the PATH during 
> initialization, and only search addr2line when really needed (which can 
> be done with a static buffer and a series of call to execve(), can't it?)

Well, yes, but it is better design to do as little as possible in such
handlers.  No matter what POSIX says, calling fork or exec is intrinsically
problematic - for example, ANY signal (including SIGCONT!) can cause
chaos if it is received in such circumstances, and the actual rules for
which processes get which signals are foul beyond belief, even when the
term 'rules' makes sense :-(

That favours Janne's approach.

Regards,
Nick Maclaren.

Re: [Patch, libfortran] PR 48931 Async-signal-safety of backtrace signal handler

[Steve Kargl]

On Sun, May 15, 2011 at 02:12:58PM +0300, Janne Blomqvist wrote:
> 
> so, here is take 3 (sigh). Compared to take 2, it no longer uses
> stdio, since opening a stdio FILE stream probably malloc()'s a buffer,
> which is not async-signal-safe.
> 
> Regtested on x86_64-unknown-linux-gnu, Ok for trunk?
> 
> 2011-05-15  Janne Blomqvist  <jb@gcc.gnu.org>
> 
> 	PR libfortran/48931
> 	* configure.ac: Check for backtrace_symbols_fd instead of
> 	backtrace_symbols, check for readlink.
> 	* config.h.in: Regenerated.
> 	* configure: Regenerated.
> 	* runtime/backtrace.c (local_strcasestr): Remove.
> 	(bt_header): New function.
> 	(dump_glibc_backtrace): Remove.
> 	(fd_gets): New function.
> 	(show_backtrace): Rework to use backtrace_symbols_fd and pipes,
> 	reformat output.
> 	* runtime/main.c (store_exe_path): Try to check /proc/self/exe
> 	first.
> 

OK.

-- 
Steve

Re: [Patch, libfortran] PR 48931 Async-signal-safety of backtrace signal handler

[Janne Blomqvist]

PING

On Sun, May 15, 2011 at 14:12, Janne Blomqvist
<blomqvist.janne@gmail.com> wrote:
> Hi,
>
> so, here is take 3 (sigh). Compared to take 2, it no longer uses
> stdio, since opening a stdio FILE stream probably malloc()'s a buffer,
> which is not async-signal-safe.
>
> Regtested on x86_64-unknown-linux-gnu, Ok for trunk?
>
> 2011-05-15  Janne Blomqvist  <jb@gcc.gnu.org>
>
>        PR libfortran/48931
>        * configure.ac: Check for backtrace_symbols_fd instead of
>        backtrace_symbols, check for readlink.
>        * config.h.in: Regenerated.
>        * configure: Regenerated.
>        * runtime/backtrace.c (local_strcasestr): Remove.
>        (bt_header): New function.
>        (dump_glibc_backtrace): Remove.
>        (fd_gets): New function.
>        (show_backtrace): Rework to use backtrace_symbols_fd and pipes,
>        reformat output.
>        * runtime/main.c (store_exe_path): Try to check /proc/self/exe
>        first.
>
>
>
> --
> Janne Blomqvist
>



-- 
Janne Blomqvist

Re: [Patch, libfortran] PR 48931 Async-signal-safety of backtrace signal handler

[Toon Moene]

On 05/17/2011 07:50 PM, Toon Moene wrote:

> On 05/14/2011 09:40 PM, Janne Blomqvist wrote:
>
>> Hi,
>>
>> the current version of showing the backtrace is not async-signal-safe
>> as it uses backtrace_symbols() which, in turn, uses malloc(). The
>> attached patch changes the backtrace printing functionality to instead
>> use backtrace_symbols_fd() and pipes.
>
> Great - this would solve a problem I filed a bugzilla report for years
> ago (unfortunately, I do not know the number of it).

It was 33905 (2007-10-26).

-- 
Toon Moene - e-mail: toon@moene.org - phone: +31 346 214290
Saturnushof 14, 3738 XG  Maartensdijk, The Netherlands
At home: http://moene.org/~toon/; weather: http://moene.org/~hirlam/
Progress of GNU Fortran: http://gcc.gnu.org/wiki/GFortran#news

Re: [Patch, libfortran] PR 48931 Async-signal-safety of backtrace signal handler

[Toon Moene]

On 05/14/2011 09:40 PM, Janne Blomqvist wrote:

> Hi,
>
> the current version of showing the backtrace is not async-signal-safe
> as it uses backtrace_symbols() which, in turn, uses malloc(). The
> attached patch changes the backtrace printing functionality to instead
> use backtrace_symbols_fd() and pipes.

Great - this would solve a problem I filed a bugzilla report for years 
ago (unfortunately, I do not know the number of it).

I closed it WONTFIX, because neither FX nor I could come up with an 
alternative way *not* using malloc.

[ The problem was getting a traceback after corruption of the
   malloc arena, which just hangs under the current implementation. ]

-- 
Toon Moene - e-mail: toon@moene.org - phone: +31 346 214290
Saturnushof 14, 3738 XG  Maartensdijk, The Netherlands
At home: http://moene.org/~toon/; weather: http://moene.org/~hirlam/
Progress of GNU Fortran: http://gcc.gnu.org/wiki/GFortran#news

Re: [Patch, libfortran] PR 48931 Async-signal-safety of backtrace signal handler

[Janne Blomqvist]

[-- Attachment #1: Type: text/plain, Size: 767 bytes --]

Hi,

so, here is take 3 (sigh). Compared to take 2, it no longer uses
stdio, since opening a stdio FILE stream probably malloc()'s a buffer,
which is not async-signal-safe.

Regtested on x86_64-unknown-linux-gnu, Ok for trunk?

2011-05-15  Janne Blomqvist  <jb@gcc.gnu.org>

	PR libfortran/48931
	* configure.ac: Check for backtrace_symbols_fd instead of
	backtrace_symbols, check for readlink.
	* config.h.in: Regenerated.
	* configure: Regenerated.
	* runtime/backtrace.c (local_strcasestr): Remove.
	(bt_header): New function.
	(dump_glibc_backtrace): Remove.
	(fd_gets): New function.
	(show_backtrace): Rework to use backtrace_symbols_fd and pipes,
	reformat output.
	* runtime/main.c (store_exe_path): Try to check /proc/self/exe
	first.



-- 
Janne Blomqvist

[-- Attachment #2: bt3.diff --]
[-- Type: text/x-patch, Size: 12031 bytes --]

diff --git a/libgfortran/configure.ac b/libgfortran/configure.ac
index cf38fb0..74cfe44 100644
--- a/libgfortran/configure.ac
+++ b/libgfortran/configure.ac
@@ -264,10 +264,10 @@ AC_CHECK_FUNCS(sleep time ttyname signal alarm clock access fork execl)
 AC_CHECK_FUNCS(wait setmode execvp pipe dup2 close fdopen strcasestr getrlimit)
 AC_CHECK_FUNCS(gettimeofday stat fstat lstat getpwuid vsnprintf dup getcwd)
 AC_CHECK_FUNCS(localtime_r gmtime_r strerror_r getpwuid_r ttyname_r)
-AC_CHECK_FUNCS(clock_gettime strftime)
+AC_CHECK_FUNCS(clock_gettime strftime readlink)
 
 # Check for glibc backtrace functions
-AC_CHECK_FUNCS(backtrace backtrace_symbols)
+AC_CHECK_FUNCS(backtrace backtrace_symbols_fd)
 
 # Check libc for getgid, getpid, getuid
 AC_CHECK_LIB([c],[getgid],[AC_DEFINE([HAVE_GETGID],[1],[libc includes getgid])])
diff --git a/libgfortran/runtime/backtrace.c b/libgfortran/runtime/backtrace.c
index 10917d3..04246a9 100644
--- a/libgfortran/runtime/backtrace.c
+++ b/libgfortran/runtime/backtrace.c
@@ -54,59 +54,57 @@ see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
 #define CAN_FORK (defined(HAVE_FORK) && defined(HAVE_EXECVP) \
 		  && defined(HAVE_WAIT))
 #define GLIBC_BACKTRACE (defined(HAVE_BACKTRACE) \
-			 && defined(HAVE_BACKTRACE_SYMBOLS))
+			 && defined(HAVE_BACKTRACE_SYMBOLS_FD))
 #define CAN_PIPE (CAN_FORK && defined(HAVE_PIPE) \
 		  && defined(HAVE_DUP2) && defined(HAVE_FDOPEN) \
 		  && defined(HAVE_CLOSE))
 
 
-#if GLIBC_BACKTRACE && CAN_PIPE
-static char *
-local_strcasestr (const char *s1, const char *s2)
-{
-#ifdef HAVE_STRCASESTR
-  return strcasestr (s1, s2);
-#else
+/* GDB style #NUM index for each stack frame.  */
 
-  const char *p = s1;
-  const size_t len = strlen (s2);
-  const char u = *s2, v = isupper((int) *s2) ? tolower((int) *s2)
-				  : (islower((int) *s2) ? toupper((int) *s2)
-							: *s2);
-
-  while (1)
-    {
-      while (*p != u && *p != v && *p)
-	p++;
-      if (*p == 0)
-	return NULL;
-      if (strncasecmp (p, s2, len) == 0)
-	return (char *)p;
-    }
-#endif
+static void 
+bt_header (int num)
+{
+  st_printf ("  #%d  ", num);
 }
-#endif
 
 
-#if GLIBC_BACKTRACE
-static void
-dump_glibc_backtrace (int depth, char *str[])
-{
-  int i;
+/* fgets()-like function that reads a line from a fd, without
+   needing to malloc() a buffer, and does not use locks, hence should
+   be async-signal-safe.  */
 
-  for (i = 0; i < depth; i++)
+static char *
+fd_gets (char *s, int size, int fd)
+{
+  for (int i = 0; i < size; i++)
     {
-      estr_write ("  + ");
-      estr_write (str[i]);
-      estr_write ("\n");
+      char c;
+      ssize_t nread = read (fd, &c, 1);
+      if (nread == 1)
+	{
+	  s[i] = c;
+	  if (c == '\n')
+	    {
+	      if (i + 1 < size)
+		s[i+1] = '\0';
+	      else
+		s[i] = '\0';
+	      break;
+	    }
+	}
+      else
+	{
+	  s[i] = '\0';
+	  break;
+	}
     }
-
-  free (str);
+  return s;
 }
-#endif
+
 
 /* show_backtrace displays the backtrace, currently obtained by means of
    the glibc backtrace* functions.  */
+
 void
 show_backtrace (void)
 {
@@ -116,176 +114,184 @@ show_backtrace (void)
 #define BUFSIZE 1024
 
   void *trace[DEPTH];
-  char **str;
   int depth;
 
   depth = backtrace (trace, DEPTH);
   if (depth <= 0)
     return;
 
-  str = backtrace_symbols (trace, depth);
-
 #if CAN_PIPE
 
-#ifndef STDIN_FILENO
-#define STDIN_FILENO 0
-#endif
-
-#ifndef STDOUT_FILENO
-#define STDOUT_FILENO 1
-#endif
-
-#ifndef STDERR_FILENO
-#define STDERR_FILENO 2
-#endif
-
   /* We attempt to extract file and line information from addr2line.  */
   do
   {
     /* Local variables.  */
-    int f[2], pid, line, i;
-    FILE *output;
-    char addr_buf[DEPTH][GFC_XTOA_BUF_SIZE], func[BUFSIZE], file[BUFSIZE];
+    int f[2], pid, line, bt[2], inp[2];
+    char addr_buf[GFC_XTOA_BUF_SIZE], func[BUFSIZE], file[BUFSIZE];
     char *p, *end;
-    const char *addr[DEPTH];
 
-    /* Write the list of addresses in hexadecimal format.  */
-    for (i = 0; i < depth; i++)
-      addr[i] = gfc_xtoa ((GFC_UINTEGER_LARGEST) (intptr_t) trace[i], addr_buf[i],
-		      sizeof (addr_buf[i]));
+    char *exe_path = full_exe_path ();
+    if (exe_path == NULL)
+      exe_path = (char *) "a.out";
 
     /* Don't output an error message if something goes wrong, we'll simply
        fall back to the pstack and glibc backtraces.  */
     if (pipe (f) != 0)
       break;
+    if (pipe (inp) != 0)
+      break;
     if ((pid = fork ()) == -1)
       break;
 
     if (pid == 0)
       {
 	/* Child process.  */
-#define NUM_FIXEDARGS 5
-	char *arg[DEPTH+NUM_FIXEDARGS+1];
+#define NUM_FIXEDARGS 7
+	char *arg[NUM_FIXEDARGS];
 
 	close (f[0]);
-	close (STDIN_FILENO);
+
+	close (inp[1]);
+	if (dup2 (inp[0], STDIN_FILENO) == -1)
+	  _exit (1);
+	close (inp[0]);
+
 	close (STDERR_FILENO);
 
 	if (dup2 (f[1], STDOUT_FILENO) == -1)
-	  _exit (0);
+	  _exit (1);
 	close (f[1]);
 
 	arg[0] = (char *) "addr2line";
 	arg[1] = (char *) "-e";
-	arg[2] = full_exe_path ();
+	arg[2] = exe_path;
 	arg[3] = (char *) "-f";
 	arg[4] = (char *) "-s";
-	for (i = 0; i < depth; i++)
-	  arg[NUM_FIXEDARGS+i] = (char *) addr[i];
-	arg[NUM_FIXEDARGS+depth] = NULL;
+	arg[5] = (char *) "-C";
+	arg[6] = NULL;
 	execvp (arg[0], arg);
-	_exit (0);
+	_exit (1);
 #undef NUM_FIXEDARGS
       }
 
     /* Father process.  */
     close (f[1]);
-    wait (NULL);
-    output = fdopen (f[0], "r");
-    i = -1;
+    close (inp[0]);
+    if (pipe (bt) != 0)
+      break;
+    backtrace_symbols_fd (trace, depth, bt[1]);
+    close (bt[1]);
 
-    if (fgets (func, sizeof(func), output))
+    estr_write ("\nBacktrace for this error:\n");
+    for (int j = 0; j < depth; j++)
       {
-	estr_write ("\nBacktrace for this error:\n");
-
-	do
+	const char *addr = gfc_xtoa 
+	  ((GFC_UINTEGER_LARGEST) (intptr_t) trace[j], 
+	   addr_buf, sizeof (addr_buf));
+
+	write (inp[1], addr, strlen (addr));
+	write (inp[1], "\n", 1);
+	
+	if (! fd_gets (func, sizeof(func), f[0]))
+	  goto fallback;
+	if (! fd_gets (file, sizeof(file), f[0]))
+	  goto fallback;
+	    
+	for (p = func; *p != '\n' && *p != '\r'; p++)
+	  ;
+	*p = '\0';
+	
+	/* If we only have the address, use the glibc backtrace.  */
+	if (func[0] == '?' && func[1] == '?' && file[0] == '?'
+	    && file[1] == '?')
 	  {
-	    if (! fgets (file, sizeof(file), output))
-	      goto fallback;
-
-	    i++;
-
-	    for (p = func; *p != '\n' && *p != '\r'; p++)
-	      ;
-
-	    *p = '\0';
-
-	    /* Try to recognize the internal libgfortran functions.  */
-	    if (strncasecmp (func, "*_gfortran", 10) == 0
-		|| strncasecmp (func, "_gfortran", 9) == 0
-		|| strcmp (func, "main") == 0 || strcmp (func, "_start") == 0
-		|| strcmp (func, "_gfortrani_backtrace_handler") == 0)
-	      continue;
-
-	    if (local_strcasestr (str[i], "libgfortran.so") != NULL
-		|| local_strcasestr (str[i], "libgfortran.dylib") != NULL
-		|| local_strcasestr (str[i], "libgfortran.a") != NULL)
-	      continue;
-
-	    /* If we only have the address, use the glibc backtrace.  */
-	    if (func[0] == '?' && func[1] == '?' && file[0] == '?'
-		&& file[1] == '?')
+	    bt_header (j);
+	    while (1)
 	      {
-		estr_write ("  + ");
-		estr_write (str[i]);
-		estr_write ("\n");
-	        continue;
+		char bc;
+		ssize_t nread = read (bt[0], &bc, 1);
+		if (nread != 1 || bc == '\n')
+		  break;
+		write (STDERR_FILENO, &bc, 1);
 	      }
-
-	    /* Extract the line number.  */
-	    for (end = NULL, p = file; *p; p++)
-	      if (*p == ':')
-		end = p;
-	    if (end != NULL)
-	      {
-		*end = '\0';
-		line = atoi (++end);
-	      }
-	    else
-	      line = -1;
-
-	    if (strcmp (func, "MAIN__") == 0)
-	      estr_write ("  + in the main program\n");
-	    else
+	    estr_write ("\n");
+	    continue;
+	  }
+	else
+	  {
+	    /* Forward to the next entry in the backtrace. */
+	    while (1)
 	      {
-		estr_write ("  + function ");
-		estr_write (func);
-		estr_write (" (0x");
-		estr_write (addr[i]);
-		estr_write (")\n");
+		char bc;
+		ssize_t nread = read (bt[0], &bc, 1);
+		if (nread != 1 || bc == '\n')
+		  break;
 	      }
+	  }
 
-	    if (line <= 0 && strcmp (file, "??") == 0)
-	      continue;
+	/* _start is a setup routine that calls main(), and main() is
+	   the frontend routine that calls some setup stuff and then
+	   calls MAIN__, so at this point we should stop.  */
+	if (strcmp (func, "_start") == 0 || strcmp (func, "main") == 0)
+	  break;
+	
+	/* Extract the line number.  */
+	for (end = NULL, p = file; *p; p++)
+	  if (*p == ':')
+	    end = p;
+	if (end != NULL)
+	  {
+	    *end = '\0';
+	    line = atoi (++end);
+	  }
+	else
+	  line = -1;
+	
+	bt_header (j);
+	estr_write (exe_path);
+	estr_write ("[0x");
+	estr_write (addr);
+	estr_write ("] in ");
+	estr_write (func);
+	
+	if (line <= 0 && strcmp (file, "??") == 0)
+	  {
+	    estr_write ("\n");
+	    continue;
+	  }
 
-	    if (line <= 0)
-	      {
-		estr_write ("    from file ");
-		estr_write (file);
-		estr_write ("\n");
-	      }
-	    else
-	      st_printf ("    at line %d of file %s\n", line, file);
+	if (line <= 0)
+	  {
+	    estr_write (" at ");
+	    estr_write (file);
+	    estr_write ("\n");
 	  }
-	while (fgets (func, sizeof(func), output));
+	else
+	  st_printf (" at %s:%d\n", file, line);
 
-	free (str);
-	return;
+      } /* Loop over each hex address.  */
+    close (inp[1]);
+    close (bt[0]);
+    wait (NULL);
+    return;
 
 fallback:
-	estr_write ("** Something went wrong while running addr2line. **\n"
-		    "** Falling back  to a simpler  backtrace scheme. **\n");
-      }
-    }
+    estr_write ("** Something went wrong while running addr2line. **\n"
+		"** Falling back  to a simpler  backtrace scheme. **\n");
+  }
   while (0);
 
 #undef DEPTH
 #undef BUFSIZE
 
-#endif
-#endif
+#endif /* CAN_PIPE */
+
+  /* Fallback to the glibc backtrace.  */
+  estr_write ("\nBacktrace for this error:\n");
+  backtrace_symbols_fd (trace, depth, STDERR_FILENO);
+  return;
 
-#if CAN_FORK && defined(HAVE_GETPPID)
+#elif defined(CAN_FORK) && defined(HAVE_GETPPID)
   /* Try to call pstack.  */
   do
   {
@@ -312,15 +318,9 @@ fallback:
 	execvp (arg[0], arg);
 #undef NUM_ARGS
 
-	/* pstack didn't work, so we fall back to dumping the glibc
-	   backtrace if we can.  */
-#if GLIBC_BACKTRACE
-	dump_glibc_backtrace (depth, str);
-#else
+	/* pstack didn't work.  */
 	estr_write ("  unable to produce a backtrace, sorry!\n");
-#endif
-
-	_exit (0);
+	_exit (1);
       }
 
     /* Father process.  */
@@ -328,13 +328,7 @@ fallback:
     return;
   }
   while(0);
-#endif
-
-#if GLIBC_BACKTRACE
-  /* Fallback to the glibc backtrace.  */
-  estr_write ("\nBacktrace for this error:\n");
-  dump_glibc_backtrace (depth, str);
-  return;
-#endif
+#else
   estr_write ("\nBacktrace not yet available on this platform, sorry!\n");
+#endif
 }
diff --git a/libgfortran/runtime/main.c b/libgfortran/runtime/main.c
index f5d4721..54d9e09 100644
--- a/libgfortran/runtime/main.c
+++ b/libgfortran/runtime/main.c
@@ -92,6 +92,19 @@ store_exe_path (const char * argv0)
   if (please_free_exe_path_when_done)
     free ((char *) exe_path);
 
+  /* Reading the /proc/self/exe symlink is Linux-specific(?), but if
+     it works it gives the correct answer.  */
+#ifdef HAVE_READLINK
+  int len;
+  if ((len = readlink ("/proc/self/exe", buf, sizeof (buf) - 1)) != -1)
+    {
+      buf[len] = '\0';
+      exe_path = strdup (buf);
+      please_free_exe_path_when_done = 1;
+      return;
+    }
+#endif
+
   /* On the simulator argv is not set.  */
   if (argv0 == NULL || argv0[0] == '/')
     {
@@ -107,7 +120,9 @@ store_exe_path (const char * argv0)
   cwd = "";
 #endif
 
-  /* exe_path will be cwd + "/" + argv[0] + "\0" */
+  /* exe_path will be cwd + "/" + argv[0] + "\0".  This will not work
+     if the executable is not in the cwd, but at this point we're out
+     of better ideas.  */
   size_t pathlen = strlen (cwd) + 1 + strlen (argv0) + 1;
   path = malloc (pathlen);
   snprintf (path, pathlen, "%s%c%s", cwd, DIR_SEPARATOR, argv0);

Re: [Patch, libfortran] PR 48931 Async-signal-safety of backtrace signal handler

[Janne Blomqvist]

[-- Attachment #1: Type: text/plain, Size: 2952 bytes --]

On Sat, May 14, 2011 at 22:40, Janne Blomqvist
<blomqvist.janne@gmail.com> wrote:
> Hi
>
> the current version of showing the backtrace is not async-signal-safe
> as it uses backtrace_symbols() which, in turn, uses malloc(). The
> attached patch changes the backtrace printing functionality to instead
> use backtrace_symbols_fd() and pipes.
>
> Also, it does some other work on backtrace printing:
>
> - Nowadays the main program has the same debug symbol name as whatever
> the name of the main program is, rather than MAIN__. Therefore remove
> special case logic related to that.

FWIW, I noticed that if debug symbols are not included, the MAIN__ is
printed. So should I add back the special casing of MAIN__?

> - Don't filter out stack frames from inside libgfortran, as this might
> lose information in case the reason for the crash is in the library.
>
> - Reformat the output slightly, so the each stack frame fits on one
> line, and begins with #NUM, similar to GDB.

I reformatted it some more, now it includes the file name, so the output is like

Backtrace for this error:
  #0  /home/janne/src/gfortran/trunk/install/lib64/libgfortran.so.3(+0x18357)[0x7fd385e51357]
  #1  /home/janne/src/gfortran/trunk/install/lib64/libgfortran.so.3(+0x19de7)[0x7fd385e52de7]
  #2  /home/janne/src/gfortran/trunk/install/lib64/libgfortran.so.3(+0xe1f69)[0x7fd385f1af69]
  #3  /home/janne/src/gfortran/my-patches/pr48931-backtrace-abort/a.out[0x400612]
in b_ at bt.f90:5
  #4  /home/janne/src/gfortran/my-patches/pr48931-backtrace-abort/a.out[0x400620]
in b_ at bt.f90:7
  #5  /home/janne/src/gfortran/my-patches/pr48931-backtrace-abort/a.out[0x400630]
in a_ at bt.f90:11
  #6  /home/janne/src/gfortran/my-patches/pr48931-backtrace-abort/a.out[0x400640]
in bt at bt.f90:15
Aborted

Similar to GDB, the address is now printed before function and
file:line number info. And similar to backtrace_symbols_fd() output (3
first stack frames above), the file name is printed before the
address.

I also improved the logic for figuring out the executable path, as the
old way doesn't work if the executable is not in the current working
directory.  The improved logic is, I believe, Linux-specific, but
since the only user of full_exe_path() is the glibc-specific
backtracing stuff I don't think that is a big loss.

Regtested on x86_64-unknown-linux-gnu, Ok for trunk?

2011-05-15  Janne Blomqvist  <jb@gcc.gnu.org>

	PR libfortran/48931
	* configure.ac: Check for backtrace_symbols_fd instead of
	backtrace_symbols, check for readlink.
	* config.h.in: Regenerated.
	* configure: Regenerated.
	* runtime/backtrace.c (local_strcasestr): Remove.
	(bt_header): New function.
	(dump_glibc_backtrace): Remove.
	(show_backtrace): Rework to use backtrace_symbols_fd and pipes,
	reformat output.
	* runtime/main.c (store_exe_path): Try to check /proc/self/exe
	first.
	(full_exe_path): If the path is NULL, try to figure it out before
	returning.


-- 
Janne Blomqvist

[-- Attachment #2: bt2.diff --]
[-- Type: text/x-patch, Size: 11760 bytes --]

diff --git a/libgfortran/configure.ac b/libgfortran/configure.ac
index cf38fb0..74cfe44 100644
--- a/libgfortran/configure.ac
+++ b/libgfortran/configure.ac
@@ -264,10 +264,10 @@ AC_CHECK_FUNCS(sleep time ttyname signal alarm clock access fork execl)
 AC_CHECK_FUNCS(wait setmode execvp pipe dup2 close fdopen strcasestr getrlimit)
 AC_CHECK_FUNCS(gettimeofday stat fstat lstat getpwuid vsnprintf dup getcwd)
 AC_CHECK_FUNCS(localtime_r gmtime_r strerror_r getpwuid_r ttyname_r)
-AC_CHECK_FUNCS(clock_gettime strftime)
+AC_CHECK_FUNCS(clock_gettime strftime readlink)
 
 # Check for glibc backtrace functions
-AC_CHECK_FUNCS(backtrace backtrace_symbols)
+AC_CHECK_FUNCS(backtrace backtrace_symbols_fd)
 
 # Check libc for getgid, getpid, getuid
 AC_CHECK_LIB([c],[getgid],[AC_DEFINE([HAVE_GETGID],[1],[libc includes getgid])])
diff --git a/libgfortran/runtime/backtrace.c b/libgfortran/runtime/backtrace.c
index 10917d3..c591b01 100644
--- a/libgfortran/runtime/backtrace.c
+++ b/libgfortran/runtime/backtrace.c
@@ -54,57 +54,20 @@ see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
 #define CAN_FORK (defined(HAVE_FORK) && defined(HAVE_EXECVP) \
 		  && defined(HAVE_WAIT))
 #define GLIBC_BACKTRACE (defined(HAVE_BACKTRACE) \
-			 && defined(HAVE_BACKTRACE_SYMBOLS))
+			 && defined(HAVE_BACKTRACE_SYMBOLS_FD))
 #define CAN_PIPE (CAN_FORK && defined(HAVE_PIPE) \
 		  && defined(HAVE_DUP2) && defined(HAVE_FDOPEN) \
 		  && defined(HAVE_CLOSE))
 
 
-#if GLIBC_BACKTRACE && CAN_PIPE
-static char *
-local_strcasestr (const char *s1, const char *s2)
+/* GDB style #NUM index for each stack frame.  */
+static void 
+bt_header (int num)
 {
-#ifdef HAVE_STRCASESTR
-  return strcasestr (s1, s2);
-#else
-
-  const char *p = s1;
-  const size_t len = strlen (s2);
-  const char u = *s2, v = isupper((int) *s2) ? tolower((int) *s2)
-				  : (islower((int) *s2) ? toupper((int) *s2)
-							: *s2);
-
-  while (1)
-    {
-      while (*p != u && *p != v && *p)
-	p++;
-      if (*p == 0)
-	return NULL;
-      if (strncasecmp (p, s2, len) == 0)
-	return (char *)p;
-    }
-#endif
+  st_printf ("  #%d  ", num);
 }
-#endif
 
 
-#if GLIBC_BACKTRACE
-static void
-dump_glibc_backtrace (int depth, char *str[])
-{
-  int i;
-
-  for (i = 0; i < depth; i++)
-    {
-      estr_write ("  + ");
-      estr_write (str[i]);
-      estr_write ("\n");
-    }
-
-  free (str);
-}
-#endif
-
 /* show_backtrace displays the backtrace, currently obtained by means of
    the glibc backtrace* functions.  */
 void
@@ -116,176 +79,186 @@ show_backtrace (void)
 #define BUFSIZE 1024
 
   void *trace[DEPTH];
-  char **str;
   int depth;
 
   depth = backtrace (trace, DEPTH);
   if (depth <= 0)
     return;
 
-  str = backtrace_symbols (trace, depth);
-
 #if CAN_PIPE
 
-#ifndef STDIN_FILENO
-#define STDIN_FILENO 0
-#endif
-
-#ifndef STDOUT_FILENO
-#define STDOUT_FILENO 1
-#endif
-
-#ifndef STDERR_FILENO
-#define STDERR_FILENO 2
-#endif
-
   /* We attempt to extract file and line information from addr2line.  */
   do
   {
     /* Local variables.  */
-    int f[2], pid, line, i;
+    int f[2], pid, line, bt[2], inp[2];
     FILE *output;
-    char addr_buf[DEPTH][GFC_XTOA_BUF_SIZE], func[BUFSIZE], file[BUFSIZE];
+    char addr_buf[GFC_XTOA_BUF_SIZE], func[BUFSIZE], file[BUFSIZE];
     char *p, *end;
-    const char *addr[DEPTH];
 
-    /* Write the list of addresses in hexadecimal format.  */
-    for (i = 0; i < depth; i++)
-      addr[i] = gfc_xtoa ((GFC_UINTEGER_LARGEST) (intptr_t) trace[i], addr_buf[i],
-		      sizeof (addr_buf[i]));
+    char *exe_path = full_exe_path ();
+    if (exe_path == NULL)
+      exe_path = (char *) "a.out";
 
     /* Don't output an error message if something goes wrong, we'll simply
        fall back to the pstack and glibc backtraces.  */
     if (pipe (f) != 0)
       break;
+    if (pipe (inp) != 0)
+      break;
     if ((pid = fork ()) == -1)
       break;
 
     if (pid == 0)
       {
 	/* Child process.  */
-#define NUM_FIXEDARGS 5
-	char *arg[DEPTH+NUM_FIXEDARGS+1];
+#define NUM_FIXEDARGS 7
+	char *arg[NUM_FIXEDARGS];
 
 	close (f[0]);
-	close (STDIN_FILENO);
+
+	close (inp[1]);
+	if (dup2 (inp[0], STDIN_FILENO) == -1)
+	  _exit (1);
+	close (inp[0]);
+
 	close (STDERR_FILENO);
 
 	if (dup2 (f[1], STDOUT_FILENO) == -1)
-	  _exit (0);
+	  _exit (1);
 	close (f[1]);
 
 	arg[0] = (char *) "addr2line";
 	arg[1] = (char *) "-e";
-	arg[2] = full_exe_path ();
+	arg[2] = exe_path;
 	arg[3] = (char *) "-f";
 	arg[4] = (char *) "-s";
-	for (i = 0; i < depth; i++)
-	  arg[NUM_FIXEDARGS+i] = (char *) addr[i];
-	arg[NUM_FIXEDARGS+depth] = NULL;
+	arg[5] = (char *) "-C";
+	arg[6] = NULL;
 	execvp (arg[0], arg);
-	_exit (0);
+	_exit (1);
 #undef NUM_FIXEDARGS
       }
 
     /* Father process.  */
     close (f[1]);
-    wait (NULL);
+    close (inp[0]);
+    if (pipe (bt) != 0)
+      break;
+    backtrace_symbols_fd (trace, depth, bt[1]);
+    close (bt[1]);
     output = fdopen (f[0], "r");
-    i = -1;
 
-    if (fgets (func, sizeof(func), output))
+    estr_write ("\nBacktrace for this error:\n");
+    for (int j = 0; j < depth; j++)
       {
-	estr_write ("\nBacktrace for this error:\n");
-
-	do
+	const char *addr = gfc_xtoa 
+	  ((GFC_UINTEGER_LARGEST) (intptr_t) trace[j], 
+	   addr_buf, sizeof (addr_buf));
+
+	write (inp[1], addr, strlen (addr));
+	write (inp[1], "\n", 1);
+	
+	if (! fgets (func, sizeof(func), output))
+	  goto fallback;
+	if (! fgets (file, sizeof(file), output))
+	  goto fallback;
+	    
+	for (p = func; *p != '\n' && *p != '\r'; p++)
+	  ;
+	*p = '\0';
+	
+	/* If we only have the address, use the glibc backtrace.  */
+	if (func[0] == '?' && func[1] == '?' && file[0] == '?'
+	    && file[1] == '?')
 	  {
-	    if (! fgets (file, sizeof(file), output))
-	      goto fallback;
-
-	    i++;
-
-	    for (p = func; *p != '\n' && *p != '\r'; p++)
-	      ;
-
-	    *p = '\0';
-
-	    /* Try to recognize the internal libgfortran functions.  */
-	    if (strncasecmp (func, "*_gfortran", 10) == 0
-		|| strncasecmp (func, "_gfortran", 9) == 0
-		|| strcmp (func, "main") == 0 || strcmp (func, "_start") == 0
-		|| strcmp (func, "_gfortrani_backtrace_handler") == 0)
-	      continue;
-
-	    if (local_strcasestr (str[i], "libgfortran.so") != NULL
-		|| local_strcasestr (str[i], "libgfortran.dylib") != NULL
-		|| local_strcasestr (str[i], "libgfortran.a") != NULL)
-	      continue;
-
-	    /* If we only have the address, use the glibc backtrace.  */
-	    if (func[0] == '?' && func[1] == '?' && file[0] == '?'
-		&& file[1] == '?')
-	      {
-		estr_write ("  + ");
-		estr_write (str[i]);
-		estr_write ("\n");
-	        continue;
-	      }
-
-	    /* Extract the line number.  */
-	    for (end = NULL, p = file; *p; p++)
-	      if (*p == ':')
-		end = p;
-	    if (end != NULL)
+	    bt_header (j);
+	    while (1)
 	      {
-		*end = '\0';
-		line = atoi (++end);
+		char bc;
+		ssize_t nread = read (bt[0], &bc, 1);
+		if (nread != 1 || bc == '\n')
+		  break;
+		write (STDERR_FILENO, &bc, 1);
 	      }
-	    else
-	      line = -1;
-
-	    if (strcmp (func, "MAIN__") == 0)
-	      estr_write ("  + in the main program\n");
-	    else
+	    estr_write ("\n");
+	    continue;
+	  }
+	else
+	  {
+	    /* Forward to the next entry in the backtrace. */
+	    while (1)
 	      {
-		estr_write ("  + function ");
-		estr_write (func);
-		estr_write (" (0x");
-		estr_write (addr[i]);
-		estr_write (")\n");
+		char bc;
+		ssize_t nread = read (bt[0], &bc, 1);
+		if (nread != 1 || bc == '\n')
+		  break;
 	      }
+	  }
 
-	    if (line <= 0 && strcmp (file, "??") == 0)
-	      continue;
+	/* _start is a setup routine that calls main(), and main() is
+	   the frontend routine that calls some setup stuff and then
+	   calls MAIN__, so at this point we should stop.  */
+	if (strcmp (func, "_start") == 0 || strcmp (func, "main") == 0)
+	  break;
+	
+	/* Extract the line number.  */
+	for (end = NULL, p = file; *p; p++)
+	  if (*p == ':')
+	    end = p;
+	if (end != NULL)
+	  {
+	    *end = '\0';
+	    line = atoi (++end);
+	  }
+	else
+	  line = -1;
+	
+	bt_header (j);
+	estr_write (exe_path);
+	estr_write ("[0x");
+	estr_write (addr);
+	estr_write ("] in ");
+	estr_write (func);
+	
+	if (line <= 0 && strcmp (file, "??") == 0)
+	  {
+	    estr_write ("\n");
+	    continue;
+	  }
 
-	    if (line <= 0)
-	      {
-		estr_write ("    from file ");
-		estr_write (file);
-		estr_write ("\n");
-	      }
-	    else
-	      st_printf ("    at line %d of file %s\n", line, file);
+	if (line <= 0)
+	  {
+	    estr_write (" at ");
+	    estr_write (file);
+	    estr_write ("\n");
 	  }
-	while (fgets (func, sizeof(func), output));
+	else
+	  st_printf (" at %s:%d\n", file, line);
 
-	free (str);
-	return;
+      } /* Loop over each hex address.  */
+    close (inp[1]);
+    close (bt[0]);
+    wait (NULL);
+    return;
 
 fallback:
-	estr_write ("** Something went wrong while running addr2line. **\n"
-		    "** Falling back  to a simpler  backtrace scheme. **\n");
-      }
-    }
+    estr_write ("** Something went wrong while running addr2line. **\n"
+		"** Falling back  to a simpler  backtrace scheme. **\n");
+  }
   while (0);
 
 #undef DEPTH
 #undef BUFSIZE
 
-#endif
-#endif
+#endif /* CAN_PIPE */
 
-#if CAN_FORK && defined(HAVE_GETPPID)
+  /* Fallback to the glibc backtrace.  */
+  estr_write ("\nBacktrace for this error:\n");
+  backtrace_symbols_fd (trace, depth, STDERR_FILENO);
+  return;
+
+#elif defined(CAN_FORK) && defined(HAVE_GETPPID)
   /* Try to call pstack.  */
   do
   {
@@ -312,15 +285,9 @@ fallback:
 	execvp (arg[0], arg);
 #undef NUM_ARGS
 
-	/* pstack didn't work, so we fall back to dumping the glibc
-	   backtrace if we can.  */
-#if GLIBC_BACKTRACE
-	dump_glibc_backtrace (depth, str);
-#else
+	/* pstack didn't work.  */
 	estr_write ("  unable to produce a backtrace, sorry!\n");
-#endif
-
-	_exit (0);
+	_exit (1);
       }
 
     /* Father process.  */
@@ -328,13 +295,7 @@ fallback:
     return;
   }
   while(0);
-#endif
-
-#if GLIBC_BACKTRACE
-  /* Fallback to the glibc backtrace.  */
-  estr_write ("\nBacktrace for this error:\n");
-  dump_glibc_backtrace (depth, str);
-  return;
-#endif
+#else
   estr_write ("\nBacktrace not yet available on this platform, sorry!\n");
+#endif
 }
diff --git a/libgfortran/runtime/main.c b/libgfortran/runtime/main.c
index f5d4721..402dca7 100644
--- a/libgfortran/runtime/main.c
+++ b/libgfortran/runtime/main.c
@@ -92,6 +92,19 @@ store_exe_path (const char * argv0)
   if (please_free_exe_path_when_done)
     free ((char *) exe_path);
 
+  /* Reading the /proc/self/exe symlink is Linux-specific(?), but if
+     it works it gives the correct answer.  */
+#ifdef HAVE_READLINK
+  int len;
+  if ((len = readlink ("/proc/self/exe", buf, sizeof (buf) - 1)) != -1)
+    {
+      buf[len] = '\0';
+      exe_path = strdup (buf);
+      please_free_exe_path_when_done = 1;
+      return;
+    }
+#endif
+
   /* On the simulator argv is not set.  */
   if (argv0 == NULL || argv0[0] == '/')
     {
@@ -107,7 +120,9 @@ store_exe_path (const char * argv0)
   cwd = "";
 #endif
 
-  /* exe_path will be cwd + "/" + argv[0] + "\0" */
+  /* exe_path will be cwd + "/" + argv[0] + "\0".  This will not work
+     if the executable is not in the cwd, but at this point we're out
+     of better ideas.  */
   size_t pathlen = strlen (cwd) + 1 + strlen (argv0) + 1;
   path = malloc (pathlen);
   snprintf (path, pathlen, "%s%c%s", cwd, DIR_SEPARATOR, argv0);
@@ -120,6 +135,10 @@ store_exe_path (const char * argv0)
 char *
 full_exe_path (void)
 {
+  /* If a non-Fortran main program has not called set_args(), try to
+     figure out the executable path nonetheless.  */
+  if (exe_path == NULL)
+    store_exe_path (NULL);
   return (char *) exe_path;
 }
 

[Patch, libfortran] PR 48931 Async-signal-safety of backtrace signal handler

[Janne Blomqvist]

[-- Attachment #1: Type: text/plain, Size: 2424 bytes --]

Hi,

the current version of showing the backtrace is not async-signal-safe
as it uses backtrace_symbols() which, in turn, uses malloc(). The
attached patch changes the backtrace printing functionality to instead
use backtrace_symbols_fd() and pipes.

Also, it does some other work on backtrace printing:

- Nowadays the main program has the same debug symbol name as whatever
the name of the main program is, rather than MAIN__. Therefore remove
special case logic related to that.

- Don't filter out stack frames from inside libgfortran, as this might
lose information in case the reason for the crash is in the library.

- Reformat the output slightly, so the each stack frame fits on one
line, and begins with #NUM, similar to GDB.

For instance, the small program

subroutine c
  call abort ()
end subroutine c

subroutine b
  call c
end subroutine b

subroutine a
  call b
end subroutine a

program bt
  call a
end program bt


compiled with -g -fno-whole-file now generates


Backtrace for this error:
  #0  /home/janne/src/gfortran/trunk/install/lib64/libgfortran.so.3(+0x182b7)[0x7f9c8a2c42b7]
  #1  /home/janne/src/gfortran/trunk/install/lib64/libgfortran.so.3(+0x19d07)[0x7f9c8a2c5d07]
  #2  /home/janne/src/gfortran/trunk/install/lib64/libgfortran.so.3(+0xe1e49)[0x7f9c8a38de49]
  #3  in b_ at bt.f90:5 (0x400612)
  #4  in b_ at bt.f90:7 (0x400620)
  #5  in a_ at bt.f90:11 (0x400630)
  #6  in bt at bt.f90:15 (0x400640)
Aborted

In this case the 3 first frames are the output from
backtrace_symbols_fd() since addr2line can't get the symbols from
libgfortran. With static linking addr2line can see it:


Backtrace for this error:
  #0  in _gfortrani_show_backtrace at backtrace.c:85 (0x405427)
  #1  in _gfortrani_sys_abort at error.c:176 (0x4007B7)
  #2  in _gfortran_abort (0x404469)
  #3  in b_ at bt.f90:5 (0x400402)
  #4  in b_ at bt.f90:7 (0x400410)
  #5  in a_ at bt.f90:11 (0x400420)
  #6  in bt at bt.f90:15 (0x400430)
Aborted

Regtested on x86_64-unknown-linux-gnu, Ok for trunk?

2011-05-14  Janne Blomqvist  <jb@gcc.gnu.org>

	PR libfortran/48931
	* configure.ac: Check for backtrace_symbols_fd instead of
	backtrace_symbols.
	* config.h.in: Regenerated.
	* configure: Regenerated.
	* runtime/backtrace.c (local_strcasestr): Remove.
	(bt_header): New function.
	(dump_glibc_backtrace): Remove.
	(show_backtrace): Rework to use backtrace_symbols_fd and pipes,
	reformat output.


-- 
Janne Blomqvist

[-- Attachment #2: bt.diff --]
[-- Type: text/x-patch, Size: 9891 bytes --]

diff --git a/libgfortran/configure.ac b/libgfortran/configure.ac
index cf38fb0..9bb6210 100644
--- a/libgfortran/configure.ac
+++ b/libgfortran/configure.ac
@@ -267,7 +267,7 @@ AC_CHECK_FUNCS(localtime_r gmtime_r strerror_r getpwuid_r ttyname_r)
 AC_CHECK_FUNCS(clock_gettime strftime)
 
 # Check for glibc backtrace functions
-AC_CHECK_FUNCS(backtrace backtrace_symbols)
+AC_CHECK_FUNCS(backtrace backtrace_symbols_fd)
 
 # Check libc for getgid, getpid, getuid
 AC_CHECK_LIB([c],[getgid],[AC_DEFINE([HAVE_GETGID],[1],[libc includes getgid])])
diff --git a/libgfortran/runtime/backtrace.c b/libgfortran/runtime/backtrace.c
index 10917d3..ce1a0c7 100644
--- a/libgfortran/runtime/backtrace.c
+++ b/libgfortran/runtime/backtrace.c
@@ -54,56 +54,19 @@ see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
 #define CAN_FORK (defined(HAVE_FORK) && defined(HAVE_EXECVP) \
 		  && defined(HAVE_WAIT))
 #define GLIBC_BACKTRACE (defined(HAVE_BACKTRACE) \
-			 && defined(HAVE_BACKTRACE_SYMBOLS))
+			 && defined(HAVE_BACKTRACE_SYMBOLS_FD))
 #define CAN_PIPE (CAN_FORK && defined(HAVE_PIPE) \
 		  && defined(HAVE_DUP2) && defined(HAVE_FDOPEN) \
 		  && defined(HAVE_CLOSE))
 
 
-#if GLIBC_BACKTRACE && CAN_PIPE
-static char *
-local_strcasestr (const char *s1, const char *s2)
+/* GDB style #NUM index for each stack frame.  */
+static void 
+bt_header (int num)
 {
-#ifdef HAVE_STRCASESTR
-  return strcasestr (s1, s2);
-#else
-
-  const char *p = s1;
-  const size_t len = strlen (s2);
-  const char u = *s2, v = isupper((int) *s2) ? tolower((int) *s2)
-				  : (islower((int) *s2) ? toupper((int) *s2)
-							: *s2);
-
-  while (1)
-    {
-      while (*p != u && *p != v && *p)
-	p++;
-      if (*p == 0)
-	return NULL;
-      if (strncasecmp (p, s2, len) == 0)
-	return (char *)p;
-    }
-#endif
+  st_printf ("  #%d  ", num);
 }
-#endif
-
-
-#if GLIBC_BACKTRACE
-static void
-dump_glibc_backtrace (int depth, char *str[])
-{
-  int i;
-
-  for (i = 0; i < depth; i++)
-    {
-      estr_write ("  + ");
-      estr_write (str[i]);
-      estr_write ("\n");
-    }
 
-  free (str);
-}
-#endif
 
 /* show_backtrace displays the backtrace, currently obtained by means of
    the glibc backtrace* functions.  */
@@ -116,63 +79,49 @@ show_backtrace (void)
 #define BUFSIZE 1024
 
   void *trace[DEPTH];
-  char **str;
   int depth;
 
   depth = backtrace (trace, DEPTH);
   if (depth <= 0)
     return;
 
-  str = backtrace_symbols (trace, depth);
-
 #if CAN_PIPE
 
-#ifndef STDIN_FILENO
-#define STDIN_FILENO 0
-#endif
-
-#ifndef STDOUT_FILENO
-#define STDOUT_FILENO 1
-#endif
-
-#ifndef STDERR_FILENO
-#define STDERR_FILENO 2
-#endif
-
   /* We attempt to extract file and line information from addr2line.  */
   do
   {
     /* Local variables.  */
-    int f[2], pid, line, i;
+    int f[2], pid, line, bt[2], inp[2];
     FILE *output;
-    char addr_buf[DEPTH][GFC_XTOA_BUF_SIZE], func[BUFSIZE], file[BUFSIZE];
+    char addr_buf[GFC_XTOA_BUF_SIZE], func[BUFSIZE], file[BUFSIZE];
     char *p, *end;
-    const char *addr[DEPTH];
-
-    /* Write the list of addresses in hexadecimal format.  */
-    for (i = 0; i < depth; i++)
-      addr[i] = gfc_xtoa ((GFC_UINTEGER_LARGEST) (intptr_t) trace[i], addr_buf[i],
-		      sizeof (addr_buf[i]));
 
     /* Don't output an error message if something goes wrong, we'll simply
        fall back to the pstack and glibc backtraces.  */
     if (pipe (f) != 0)
       break;
+    if (pipe (inp) != 0)
+      break;
     if ((pid = fork ()) == -1)
       break;
 
     if (pid == 0)
       {
 	/* Child process.  */
-#define NUM_FIXEDARGS 5
-	char *arg[DEPTH+NUM_FIXEDARGS+1];
+#define NUM_FIXEDARGS 7
+	char *arg[NUM_FIXEDARGS];
 
 	close (f[0]);
-	close (STDIN_FILENO);
+
+	close (inp[1]);
+	if (dup2 (inp[0], STDIN_FILENO) == -1)
+	  _exit (1);
+	close (inp[0]);
+
 	close (STDERR_FILENO);
 
 	if (dup2 (f[1], STDOUT_FILENO) == -1)
-	  _exit (0);
+	  _exit (1);
 	close (f[1]);
 
 	arg[0] = (char *) "addr2line";
@@ -180,112 +129,133 @@ show_backtrace (void)
 	arg[2] = full_exe_path ();
 	arg[3] = (char *) "-f";
 	arg[4] = (char *) "-s";
-	for (i = 0; i < depth; i++)
-	  arg[NUM_FIXEDARGS+i] = (char *) addr[i];
-	arg[NUM_FIXEDARGS+depth] = NULL;
+	arg[5] = (char *) "-C";
+	arg[6] = NULL;
 	execvp (arg[0], arg);
-	_exit (0);
+	_exit (1);
 #undef NUM_FIXEDARGS
       }
 
     /* Father process.  */
     close (f[1]);
-    wait (NULL);
+    close (inp[0]);
+    if (pipe (bt) != 0)
+      break;
+    backtrace_symbols_fd (trace, depth, bt[1]);
+    close (bt[1]);
     output = fdopen (f[0], "r");
-    i = -1;
 
-    if (fgets (func, sizeof(func), output))
+    estr_write ("\nBacktrace for this error:\n");
+    for (int j = 0; j < depth; j++)
       {
-	estr_write ("\nBacktrace for this error:\n");
-
-	do
+	const char *addr = gfc_xtoa 
+	  ((GFC_UINTEGER_LARGEST) (intptr_t) trace[j], 
+	   addr_buf, sizeof (addr_buf));
+
+	write (inp[1], addr, strlen (addr));
+	write (inp[1], "\n", 1);
+	
+	if (! fgets (func, sizeof(func), output))
+	  goto fallback;
+	if (! fgets (file, sizeof(file), output))
+	  goto fallback;
+	    
+	for (p = func; *p != '\n' && *p != '\r'; p++)
+	  ;
+	*p = '\0';
+	
+	/* If we only have the address, use the glibc backtrace.  */
+	if (func[0] == '?' && func[1] == '?' && file[0] == '?'
+	    && file[1] == '?')
 	  {
-	    if (! fgets (file, sizeof(file), output))
-	      goto fallback;
-
-	    i++;
-
-	    for (p = func; *p != '\n' && *p != '\r'; p++)
-	      ;
-
-	    *p = '\0';
-
-	    /* Try to recognize the internal libgfortran functions.  */
-	    if (strncasecmp (func, "*_gfortran", 10) == 0
-		|| strncasecmp (func, "_gfortran", 9) == 0
-		|| strcmp (func, "main") == 0 || strcmp (func, "_start") == 0
-		|| strcmp (func, "_gfortrani_backtrace_handler") == 0)
-	      continue;
-
-	    if (local_strcasestr (str[i], "libgfortran.so") != NULL
-		|| local_strcasestr (str[i], "libgfortran.dylib") != NULL
-		|| local_strcasestr (str[i], "libgfortran.a") != NULL)
-	      continue;
-
-	    /* If we only have the address, use the glibc backtrace.  */
-	    if (func[0] == '?' && func[1] == '?' && file[0] == '?'
-		&& file[1] == '?')
+	    bt_header (j);
+	    while (1)
 	      {
-		estr_write ("  + ");
-		estr_write (str[i]);
-		estr_write ("\n");
-	        continue;
+		char bc;
+		ssize_t nread = read (bt[0], &bc, 1);
+		if (nread != 1 || bc == '\n')
+		  break;
+		write (STDERR_FILENO, &bc, 1);
 	      }
-
-	    /* Extract the line number.  */
-	    for (end = NULL, p = file; *p; p++)
-	      if (*p == ':')
-		end = p;
-	    if (end != NULL)
-	      {
-		*end = '\0';
-		line = atoi (++end);
-	      }
-	    else
-	      line = -1;
-
-	    if (strcmp (func, "MAIN__") == 0)
-	      estr_write ("  + in the main program\n");
-	    else
-	      {
-		estr_write ("  + function ");
-		estr_write (func);
-		estr_write (" (0x");
-		estr_write (addr[i]);
-		estr_write (")\n");
-	      }
-
-	    if (line <= 0 && strcmp (file, "??") == 0)
-	      continue;
-
-	    if (line <= 0)
+	    estr_write ("\n");
+	    continue;
+	  }
+	else
+	  {
+	    /* Forward to the next entry in the backtrace. */
+	    while (1)
 	      {
-		estr_write ("    from file ");
-		estr_write (file);
-		estr_write ("\n");
+		char bc;
+		ssize_t nread = read (bt[0], &bc, 1);
+		if (nread != 1 || bc == '\n')
+		  break;
 	      }
-	    else
-	      st_printf ("    at line %d of file %s\n", line, file);
 	  }
-	while (fgets (func, sizeof(func), output));
 
-	free (str);
-	return;
+	/* _start is a setup routine that calls main(), and main() is
+	   the frontend routine that calls some setup stuff and then
+	   calls MAIN__, so at this point we should stop.  */
+	if (strcmp (func, "_start") == 0 || strcmp (func, "main") == 0)
+	  break;
+	
+	/* Extract the line number.  */
+	for (end = NULL, p = file; *p; p++)
+	  if (*p == ':')
+	    end = p;
+	if (end != NULL)
+	  {
+	    *end = '\0';
+	    line = atoi (++end);
+	  }
+	else
+	  line = -1;
+	
+	bt_header (j);
+	estr_write ("in ");
+	estr_write (func);
+	
+	if (line <= 0 && strcmp (file, "??") == 0)
+	  {
+	    estr_write (" (0x");
+	    estr_write (addr);
+	    estr_write (")\n");
+	    continue;
+	  }
+	
+	if (line <= 0)
+	  {
+	    estr_write (" at ");
+	    estr_write (file);
+	  }
+	else
+	  st_printf (" at %s:%d", file, line);
+
+	estr_write (" (0x");
+	estr_write (addr);
+	estr_write (")\n");
+      } /* Loop over each hex address.  */
+    close (inp[1]);
+    close (bt[0]);
+    wait (NULL);
+    return;
 
 fallback:
-	estr_write ("** Something went wrong while running addr2line. **\n"
-		    "** Falling back  to a simpler  backtrace scheme. **\n");
-      }
-    }
+    estr_write ("** Something went wrong while running addr2line. **\n"
+		"** Falling back  to a simpler  backtrace scheme. **\n");
+  }
   while (0);
 
 #undef DEPTH
 #undef BUFSIZE
 
-#endif
-#endif
+#endif /* CAN_PIPE */
 
-#if CAN_FORK && defined(HAVE_GETPPID)
+  /* Fallback to the glibc backtrace.  */
+  estr_write ("\nBacktrace for this error:\n");
+  backtrace_symbols_fd (trace, depth, STDERR_FILENO);
+  return;
+
+#elif defined(CAN_FORK) && defined(HAVE_GETPPID)
   /* Try to call pstack.  */
   do
   {
@@ -312,15 +282,9 @@ fallback:
 	execvp (arg[0], arg);
 #undef NUM_ARGS
 
-	/* pstack didn't work, so we fall back to dumping the glibc
-	   backtrace if we can.  */
-#if GLIBC_BACKTRACE
-	dump_glibc_backtrace (depth, str);
-#else
+	/* pstack didn't work.  */
 	estr_write ("  unable to produce a backtrace, sorry!\n");
-#endif
-
-	_exit (0);
+	_exit (1);
       }
 
     /* Father process.  */
@@ -328,13 +292,7 @@ fallback:
     return;
   }
   while(0);
-#endif
-
-#if GLIBC_BACKTRACE
-  /* Fallback to the glibc backtrace.  */
-  estr_write ("\nBacktrace for this error:\n");
-  dump_glibc_backtrace (depth, str);
-  return;
-#endif
+#else
   estr_write ("\nBacktrace not yet available on this platform, sorry!\n");
+#endif
 }