/* Copyright (C) 2006, 2007, 2009 Free Software Foundation, Inc.
   Contributed by François-Xavier Coudert

This file is part of the GNU Fortran 95 runtime library (libgfortran).

Libgfortran is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 3, or (at your option)
any later version.

Libgfortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

Under Section 7 of GPL version 3, you are granted additional
permissions described in the GCC Runtime Library Exception, version
3.1, as published by the Free Software Foundation.

You should have received a copy of the GNU General Public License and
a copy of the GCC Runtime Library Exception along with this program;
see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
<http://www.gnu.org/licenses/>.  */

#include "libgfortran.h"

#include <string.h>

#ifdef HAVE_STDLIB_H
#include <stdlib.h>
#endif

#ifdef HAVE_INTTYPES_H
#include <inttypes.h>
#endif

#ifdef HAVE_UNISTD_H
#include <unistd.h>
#endif

#ifdef HAVE_EXECINFO_H
#include <execinfo.h>
#endif

#ifdef HAVE_SYS_WAIT_H
#include <sys/wait.h>
#endif

#include <ctype.h>


/* Macros for common sets of capabilities: can we fork and exec, can
   we use glibc-style backtrace functions, and can we use pipes.  */
#define CAN_FORK (defined(HAVE_FORK) && defined(HAVE_EXECVP) \
		  && defined(HAVE_WAIT))
#define GLIBC_BACKTRACE (defined(HAVE_BACKTRACE) \
			 && defined(HAVE_BACKTRACE_SYMBOLS))
#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

  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
}
#endif


#if GLIBC_BACKTRACE
static void
dump_glibc_backtrace (int depth, char *str[])
{
  int i;

  for (i = 0; i < depth; i++)
    st_printf ("  + %s\n", str[i]);

  free (str);
}
#endif

/* show_backtrace displays the backtrace, currently obtained by means of
   the glibc backtrace* functions.  */
void
show_backtrace (void)
{
#if GLIBC_BACKTRACE

#define DEPTH 50
#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];
    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 ((pid = fork ()) == -1)
      break;

    if (pid == 0)
      {
	/* Child process.  */
#define NUM_FIXEDARGS 5
	char *arg[DEPTH+NUM_FIXEDARGS+1];

	close (f[0]);
	close (STDIN_FILENO);
	close (STDERR_FILENO);

	if (dup2 (f[1], STDOUT_FILENO) == -1)
	  _exit (0);
	close (f[1]);

	arg[0] = (char *) "addr2line";
	arg[1] = (char *) "-e";
	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;
	execvp (arg[0], arg);
	_exit (0);
#undef NUM_FIXEDARGS
      }

    /* Father process.  */
    close (f[1]);
    wait (NULL);
    output = fdopen (f[0], "r");
    i = -1;

    if (fgets (func, sizeof(func), output))
      {
	st_printf ("\nBacktrace for this error:\n");

	do
	  {
	    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_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] == '?')
	      {
	        st_printf ("  + %s\n", str[i]);
	        continue;
	      }

	    /* 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)
	      st_printf ("  + in the main program\n");
	    else
	      st_printf ("  + function %s (0x%s)\n", func, addr[i]);

	    if (line <= 0 && strcmp (file, "??") == 0)
	      continue;

	    if (line <= 0)
	      st_printf ("    from file %s\n", file);
	    else
	      st_printf ("    at line %d of file %s\n", line, file);
	  }
	while (fgets (func, sizeof(func), output));

	free (str);
	return;

fallback:
	st_printf ("** Something went wrong while running addr2line. **\n"
		   "** Falling back  to a simpler  backtrace scheme. **\n");
      }
    }
  while (0);

#undef DEPTH
#undef BUFSIZE

#endif
#endif

#if CAN_FORK && defined(HAVE_GETPPID)
  /* Try to call pstack.  */
  do
  {
    /* Local variables.  */
    int pid;

    /* Don't output an error message if something goes wrong, we'll simply
       fall back to the pstack and glibc backtraces.  */
    if ((pid = fork ()) == -1)
      break;

    if (pid == 0)
      {
	/* Child process.  */
#define NUM_ARGS 2
	char *arg[NUM_ARGS+1];
	char buf[20];

	st_printf ("\nBacktrace for this error:\n");
	arg[0] = (char *) "pstack";
#ifdef HAVE_SNPRINTF
	snprintf (buf, sizeof(buf), "%d", (int) getppid ());
#else
	sprintf (buf, "%d", (int) getppid ());
#endif
	arg[1] = buf;
	arg[2] = NULL;
	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
	st_printf ("  unable to produce a backtrace, sorry!\n");
#endif

	_exit (0);
      }

    /* Father process.  */
    wait (NULL);
    return;
  }
  while(0);
#endif

#if GLIBC_BACKTRACE
  /* Fallback to the glibc backtrace.  */
  st_printf ("\nBacktrace for this error:\n");
  dump_glibc_backtrace (depth, str);
#endif
}