PR libfortran/54572

	* Makefile.def: Make libgfortran depend on libbacktrace.
	* Makefile.in: Regenerate.

	* config-lang.in: Add libbacktrace to target_libs.

	* Makefile.am (libgfortran_la_LDFLAGS): Link in libbacktrace.
	(AM_CPPFLAGS): Add libbacktrace directories to include paths.
	* Makefile.in: Regenerate.
	* aclocal.m4: Regenerate.
	* config.h.in: Regenerate.
	* configure: Regenerate.
	* configure.ac: Remove checks for strtok_r, wait, execve, pipe,
	and dup2. Remove call to GCC_CHECK_UNWIND_GETIPINFO.
	* libgfortran.h (full_exe_path, find_addr2line, backtrace): Remove
	prototypes.
	(show_backtrace): Add prototype.
	* runtime/backtrace.c: Rework file entirely.
	* runtime/compile_options.c (backtrace_handler): Rename backtrace
	to show_backtrace.
	(maybe_find_addr2line): Remove function.
	(set_options): Remove call to maybe_find_addr2line.
	* runtime/error.c (sys_abort): Rename backtrace to show_backtrace.
	* runtime/main.c (store_exe_path): Empty function body.
	(full_exe_path, gfstrtok_r, find_addr2line): Remove functions.
	(cleanup): Don't free removed variables.
	* runtime/minimal.c (full_exe_path): Remove function.
	(set_args): Don't set exe_path.

	* gfortran.dg/backtrace_1.f90: New test.


git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@227106 138bc75d-0d04-0410-961f-82ee72b054a4

5 files changed, 92 insertions, 400 deletions

diff --git a/libgfortran/runtime/backtrace.c b/libgfortran/runtime/backtrace.c
index 317da1f4931..0d7c1fcea22 100644
--- a/libgfortran/runtime/backtrace.c
+++ b/libgfortran/runtime/backtrace.c
@@ -31,249 +31,122 @@ see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
 #include <unistd.h>
 #endif
 
-#ifdef HAVE_SYS_WAIT_H
-#include <sys/wait.h>
-#endif
-
-#include <limits.h>
-
-#include "unwind.h"
-
+#include "backtrace-supported.h"
+#include "backtrace.h"
 
-/* Macros for common sets of capabilities: can we fork and exec, and
-   can we use pipes to communicate with the subprocess.  */
-#define CAN_FORK (defined(HAVE_FORK) && defined(HAVE_EXECVE) \
-		  && defined(HAVE_WAIT))
-#define CAN_PIPE (CAN_FORK && defined(HAVE_PIPE) \
-		  && defined(HAVE_DUP2) && defined(HAVE_CLOSE))
 
-#ifndef PATH_MAX
-#define PATH_MAX 4096
-#endif
+/* Store our own state while backtracing.  */
+struct mystate
+{
+  int try_simple;
+  int frame;
+};
 
 
-/* GDB style #NUM index for each stack frame.  */
+/* Does a function name have "_gfortran_" or "_gfortrani_" prefix, possibly
+   with additional underscore(s) at the beginning?  Cannot use strncmp()
+   because we might be called from a signal handler.  */
 
-static void 
-bt_header (int num)
+static int
+has_gfortran_prefix (const char *s)
 {
-  st_printf ("#%d  ", num);
-}
+  if (!s)
+    return 0;
 
+  while (*s == '_')
+    s++;
 
-/* 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.  */
+  return (s[0] == 'g' && s[1] == 'f' && s[2] == 'o' && s[3] == 'r'
+	  && s[4] == 't' && s[5] == 'r' && s[6] == 'a' && s[7] == 'n'
+	  && (s[8] == '_' || (s[8] == 'i' && s[9] == '_')));
+}
 
-static char *
-fd_gets (char *s, int size, int fd)
+static void
+error_callback (void *data, const char *msg, int errnum)
 {
-  for (int i = 0; i < size; i++)
+  struct mystate *state = (struct mystate *) data;
+  if (errnum < 0)
     {
-      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';
-	  if (i == 0)
-	    return NULL;
-	  break;
-	}
+      state->try_simple = 1;
+      return;
     }
-  return s;
-}
 
+  estr_write ("\nSomething went wrong while printing the backtrace: ");
+  estr_write (msg);
+  estr_write ("\n");
+}
 
-extern char *addr2line_path;
+static int
+simple_callback (void *data, uintptr_t pc)
+{
+  struct mystate *state = (struct mystate *) data;
+  st_printf ("#%d  0x%lx\n", state->frame, (unsigned long) pc);
+  (state->frame)++;
+  return 0;
+}
 
-/* Struct containing backtrace state.  */
-typedef struct
+static int
+full_callback (void *data, uintptr_t pc, const char *filename,
+	       int lineno, const char *function)
 {
-  int frame_number;
-  int direct_output;
-  int outfd;
-  int infd;
-  int error;
+  struct mystate *state = (struct mystate *) data;
+
+  if (has_gfortran_prefix (function))
+    return 0;
+
+  st_printf ("#%d  0x%lx in %s\n", state->frame,
+	     (unsigned long) pc, function == NULL ? "???" : function);
+  if (filename || lineno != 0)
+    st_printf ("\tat %s:%d\n", filename == NULL ? "???" : filename, lineno);
+  (state->frame)++;
+
+  if (function != NULL && strcmp (function, "main") == 0)
+    return 1;
+
+  return 0;
 }
-bt_state;
 
-static _Unwind_Reason_Code
-trace_function (struct _Unwind_Context *context, void *state_ptr)
+
+/* Display the backtrace.  */
+
+void
+show_backtrace (int in_signal_handler)
 {
-  bt_state* state = (bt_state*) state_ptr;
-  _Unwind_Ptr ip;
-#ifdef HAVE_GETIPINFO
-  int ip_before_insn = 0;
-  ip = _Unwind_GetIPInfo (context, &ip_before_insn);
-  
-  /* If the unwinder gave us a 'return' address, roll it back a little
-     to ensure we get the correct line number for the call itself.  */
-  if (! ip_before_insn)
-    --ip;
-#else  
-  ip = _Unwind_GetIP (context);
-#endif
+  struct backtrace_state *lbstate;
+  struct mystate state = { 0, 0 };
+ 
+  lbstate = backtrace_create_state (NULL, 1, error_callback, NULL);
 
-  if (state->direct_output)
+  if (!BACKTRACE_SUPPORTED || (in_signal_handler && BACKTRACE_USES_MALLOC))
     {
-      bt_header(state->frame_number);
-      st_printf ("%p\n", (void*) ip);
+      /* If symbolic backtrace is not supported on this target, or would
+	 require malloc() and we are in a signal handler, go with a
+	 simple backtrace.  */
+
+      backtrace_simple (lbstate, 0, simple_callback, error_callback, &state);
     }
   else
     {
-      char addr_buf[GFC_XTOA_BUF_SIZE], func[1024], file[PATH_MAX];
-      char *p;
-      const char* addr = gfc_xtoa (ip, addr_buf, sizeof (addr_buf));
-      write (state->outfd, addr, strlen (addr));
-      write (state->outfd, "\n", 1);
-
-      if (! fd_gets (func, sizeof(func), state->infd))
-	{
-	  state->error = 1;
-	  goto done;
-	}
-      if (! fd_gets (file, sizeof(file), state->infd))
-	{
-	  state->error = 1;
-	  goto done;
-	}
-	    
-	for (p = func; *p != '\n' && *p != '\r'; p++)
-	  ;
-	*p = '\0';
-	
-	/* _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)
-	  return _URC_END_OF_STACK;
-	
-	bt_header (state->frame_number);
-	estr_write ("0x");
-	estr_write (addr);
-
-	if (func[0] != '?' && func[1] != '?')
-	  {
-	    estr_write (" in ");
-	    estr_write (func);
-	  }
-	
-	if (strncmp (file, "??", 2) == 0)
-	  estr_write ("\n");
-	else
-	  {
-	    estr_write (" at ");
-	    estr_write (file);
-	  }
+      /* libbacktrace uses mmap, which is safe to call from a signal handler
+	 (in practice, if not in theory).  Thus we can generate a symbolic
+	 backtrace, if debug symbols are available.  */
+
+      backtrace_full (lbstate, 0, full_callback, error_callback, &state);
+      if (state.try_simple)
+	backtrace_simple (lbstate, 0, simple_callback, error_callback, &state);
     }
+}
 
- done:
 
-  state->frame_number++;
-  
-  return _URC_NO_REASON;
-}
 
+/* Function called by the front-end translating the BACKTRACE intrinsic.  */
 
-/* Display the backtrace.  */
+extern void backtrace (void);
+export_proto (backtrace);
 
 void
 backtrace (void)
 {
-  bt_state state;
-  state.frame_number = 0;
-  state.error = 0;
-
-#if CAN_PIPE
-
-  if (addr2line_path == NULL)
-    goto fallback_noerr;
-
-  /* We attempt to extract file and line information from addr2line.  */
-  do
-  {
-    /* Local variables.  */
-    int f[2], pid, inp[2];
-
-    /* Don't output an error message if something goes wrong, we'll simply
-       fall back to printing the addresses.  */
-    if (pipe (f) != 0)
-      break;
-    if (pipe (inp) != 0)
-      break;
-    if ((pid = fork ()) == -1)
-      break;
-
-    if (pid == 0)
-      {
-	/* Child process.  */
-#define NUM_FIXEDARGS 7
-	char *arg[NUM_FIXEDARGS];
-	char *newenv[] = { NULL };
-
-	close (f[0]);
-
-	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 (1);
-	close (f[1]);
-
-	arg[0] = addr2line_path;
-	arg[1] = (char *) "-e";
-	arg[2] = full_exe_path ();
-	arg[3] = (char *) "-f";
-	arg[4] = (char *) "-s";
-	arg[5] = (char *) "-C";
-	arg[6] = NULL;
-	execve (addr2line_path, arg, newenv);
-	_exit (1);
-#undef NUM_FIXEDARGS
-      }
-
-    /* Father process.  */
-    close (f[1]);
-    close (inp[0]);
-
-    state.outfd = inp[1];
-    state.infd = f[0];
-    state.direct_output = 0;
-    _Unwind_Backtrace (trace_function, &state);
-    if (state.error)
-      goto fallback;
-    close (inp[1]);
-    close (f[0]);
-    wait (NULL);
-    return;
-
-fallback:
-    estr_write ("** Something went wrong while running addr2line. **\n"
-		"** Falling back to a simpler backtrace scheme. **\n");
-  }
-  while (0);
-
-fallback_noerr:
-#endif /* CAN_PIPE */
-
-  /* Fallback to the simple backtrace without addr2line.  */
-  state.direct_output = 1;
-  _Unwind_Backtrace (trace_function, &state);
+  show_backtrace (0);
 }
-iexport(backtrace);
+
diff --git a/libgfortran/runtime/compile_options.c b/libgfortran/runtime/compile_options.c
index 1bae1a294d8..f44256b43b4 100644
--- a/libgfortran/runtime/compile_options.c
+++ b/libgfortran/runtime/compile_options.c
@@ -30,7 +30,7 @@ see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
 compile_options_t compile_options;
 
 #ifndef LIBGFOR_MINIMAL
-volatile sig_atomic_t fatal_error_in_progress = 0;
+static volatile sig_atomic_t fatal_error_in_progress = 0;
 
 
 /* Helper function for backtrace_handler to write information about the
@@ -126,7 +126,7 @@ backtrace_handler (int signum)
 
   show_signal (signum);
   estr_write ("\nBacktrace for this error:\n");
-  backtrace ();
+  show_backtrace (1);
 
   /* Now reraise the signal.  We reactivate the signal's
      default handling, which is to terminate the process.
@@ -136,16 +136,6 @@ backtrace_handler (int signum)
   signal (signum, SIG_DFL);
   raise (signum);
 }
-
-
-/* Helper function for set_options because we need to access the
-   global variable options which is not seen in set_options.  */
-static void
-maybe_find_addr2line (void)
-{
-  if (options.backtrace == -1)
-    find_addr2line ();
-}
 #endif
 
 /* Set the usual compile-time options.  */
@@ -211,8 +201,6 @@ set_options (int num, int options[])
 #if defined(SIGXFSZ)
       signal (SIGXFSZ, backtrace_handler);
 #endif
-
-      maybe_find_addr2line ();
     }
 #endif
 }
diff --git a/libgfortran/runtime/error.c b/libgfortran/runtime/error.c
index 098231916aa..9eb07645411 100644
--- a/libgfortran/runtime/error.c
+++ b/libgfortran/runtime/error.c
@@ -173,7 +173,7 @@ sys_abort (void)
       || (options.backtrace == -1 && compile_options.backtrace == 1))
     {
       estr_write ("\nProgram aborted. Backtrace:\n");
-      backtrace ();
+      show_backtrace (0);
       signal (SIGABRT, SIG_DFL);
     }
 
diff --git a/libgfortran/runtime/main.c b/libgfortran/runtime/main.c
index cb8e518b582..ecb613dc91d 100644
--- a/libgfortran/runtime/main.c
+++ b/libgfortran/runtime/main.c
@@ -70,162 +70,13 @@ determine_endianness (void)
 static int argc_save;
 static char **argv_save;
 
-static const char *exe_path;
-static bool please_free_exe_path_when_done;
 
-/* Save the path under which the program was called, for use in the
-   backtrace routines.  */
 void
-store_exe_path (const char * argv0)
+store_exe_path (const char * argv0 __attribute__ ((unused)))
 {
-#ifndef DIR_SEPARATOR   
-#define DIR_SEPARATOR '/'
-#endif
-
-  char *cwd, *path;
-
-  /* This can only happen if store_exe_path is called multiple times.  */
-  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
-  ssize_t len, psize = 256;
-  while (1)
-    {
-      path = xmalloc (psize);
-      len = readlink ("/proc/self/exe", path, psize);
-      if (len < 0)
-	{
-	  free (path);
-	  break;
-	}
-      else if (len < psize)
-	{
-	  path[len] = '\0';
-	  exe_path = strdup (path);
-	  free (path);
-	  please_free_exe_path_when_done = true;
-	  return;
-	}
-      /* The remaining option is len == psize.  */
-      free (path);
-      psize *= 4;
-    }
-#endif
-
-  /* If the path is absolute or on a simulator where argv is not set.  */
-#ifdef __MINGW32__
-  if (argv0 == NULL
-      || ('A' <= argv0[0] && argv0[0] <= 'Z' && argv0[1] == ':')
-      || ('a' <= argv0[0] && argv0[0] <= 'z' && argv0[1] == ':')
-      || (argv0[0] == '/' && argv0[1] == '/')
-      || (argv0[0] == '\\' && argv0[1] == '\\'))
-#else
-  if (argv0 == NULL || argv0[0] == DIR_SEPARATOR)
-#endif
-    {
-      exe_path = argv0;
-      please_free_exe_path_when_done = false;
-      return;
-    }
-
-#ifdef HAVE_GETCWD
-  size_t cwdsize = 256;
-  while (1)
-    {
-      cwd = xmalloc (cwdsize);
-      if (getcwd (cwd, cwdsize))
-	break;
-      else if (errno == ERANGE)
-	{
-	  free (cwd);
-	  cwdsize *= 4;
-	}
-      else
-	{
-	  free (cwd);
-	  cwd = NULL;
-	  break;
-	}
-    }
-#else
-  cwd = NULL;
-#endif
-
-  if (!cwd)
-    {
-      exe_path = argv0;
-      please_free_exe_path_when_done = false;
-      return;
-    }
-
-  /* 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 = xmalloc (pathlen);
-  snprintf (path, pathlen, "%s%c%s", cwd, DIR_SEPARATOR, argv0);
-  free (cwd);
-  exe_path = path;
-  please_free_exe_path_when_done = true;
-}
-
-
-/* Return the full path of the executable.  */
-char *
-full_exe_path (void)
-{
-  return (char *) exe_path;
-}
-
-
-#ifndef HAVE_STRTOK_R
-static char*
-gfstrtok_r (char *str, const char *delim, 
-	    char **saveptr __attribute__ ((unused)))
-{
-  return strtok (str, delim);
-}
-#define strtok_r gfstrtok_r
-#endif
-
-char *addr2line_path;
-
-/* Find addr2line and store the path.  */
-
-void
-find_addr2line (void)
-{
-#ifdef HAVE_ACCESS
-#define A2L_LEN 11
-  char *path = secure_getenv ("PATH");
-  if (!path)
-    return;
-  char *tp = strdup (path);
-  if (!tp)
-    return;
-  size_t n = strlen (path);
-  char *ap = xmalloc (n + A2L_LEN);
-  char *saveptr;
-  for (char *str = tp;; str = NULL)
-    {
-      char *token = strtok_r (str, ":", &saveptr);
-      if (!token)
-	break;
-      size_t toklen = strlen (token);
-      memcpy (ap, token, toklen);
-      memcpy (ap + toklen, "/addr2line", A2L_LEN);
-      if (access (ap, R_OK|X_OK) == 0)
-	{
-	  addr2line_path = strdup (ap);
-	  break;
-	}
-    }
-  free (tp);
-  free (ap);
-#endif
+  /* This function is now useless, but is retained due to ABI compatibility.
+    Remove when bumping the library ABI.  */
+  ;
 }
 
 
@@ -236,7 +87,6 @@ set_args (int argc, char **argv)
 {
   argc_save = argc;
   argv_save = argv;
-  store_exe_path (argv[0]);
 }
 iexport(set_args);
 
@@ -279,9 +129,6 @@ init (void)
   /* if (argc > 1 && strcmp(argv[1], "--resume") == 0) resume();  */
 #endif
 
-  if (options.backtrace == 1)
-    find_addr2line ();
-
   random_seed_i4 (NULL, NULL, NULL);
 }
 
@@ -292,9 +139,4 @@ static void __attribute__((destructor))
 cleanup (void)
 {
   close_units ();
-  
-  if (please_free_exe_path_when_done)
-    free ((char *) exe_path);
-
-  free (addr2line_path);
 }
diff --git a/libgfortran/runtime/minimal.c b/libgfortran/runtime/minimal.c
index 72a134a48dc..693d748222b 100644
--- a/libgfortran/runtime/minimal.c
+++ b/libgfortran/runtime/minimal.c
@@ -53,8 +53,6 @@ int big_endian = 0;
 static int argc_save;
 static char **argv_save;
 
-static const char *exe_path;
-
 /* recursion_check()-- It's possible for additional errors to occur
  * during fatal error processing.  We detect this condition here and
  * exit with code 4 immediately. */
@@ -163,14 +161,6 @@ internal_error (st_parameter_common *cmp, const char *message)
 }
 
 
-/* Return the full path of the executable.  */
-char *
-full_exe_path (void)
-{
-  return (char *) exe_path;
-}
-
-
 /* Set the saved values of the command line arguments.  */
 
 void
@@ -178,7 +168,6 @@ set_args (int argc, char **argv)
 {
   argc_save = argc;
   argv_save = argv;
-  exe_path = argv[0];
 }
 iexport(set_args);