[thirdparty/gcc.git] / libgfortran / runtime / backtrace.c

/* 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
}
Commit	Line	Data
f9bfed22	1	/* Copyright (C) 2006, 2007, 2009 Free Software Foundation, Inc.
868d75db FXC	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
748086b7	8	the Free Software Foundation; either version 3, or (at your option)
868d75db FXC	9	any later version.
868d75db FXC	10
868d75db FXC	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
748086b7 JJ	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/>. */
868d75db	24
36ae8a61	25	#include "libgfortran.h"
868d75db	26
868d75db FXC	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
868d75db FXC	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
868d75db FXC	49	#include <ctype.h>
868d75db FXC	50
868d75db	51
1cc0507d FXC	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))
868d75db	61
1cc0507d FXC	62
1cc0507d FXC	63	#if GLIBC_BACKTRACE && CAN_PIPE
868d75db	64	static char *
c861db66	65	local_strcasestr (const char s1, const char s2)
868d75db	66	{
c861db66 AN	67	#ifdef HAVE_STRCASESTR
	68	return strcasestr (s1, s2);
	69	#else
	70
868d75db FXC	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	}
868d75db	86	#endif
c861db66	87	}
1cc0507d	88	#endif
868d75db FXC	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++)
f9bfed22	150	addr[i] = gfc_xtoa ((GFC_UINTEGER_LARGEST) (intptr_t) trace[i], addr_buf[i],
868d75db FXC	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
2b840e50 FXC	212	\|\| strcmp (func, "main") == 0 \|\| strcmp (func, "_start") == 0
2b840e50 FXC	213	\|\| strcmp (func, "_gfortrani_handler") == 0)
868d75db FXC	214	continue;
868d75db FXC	215
c861db66 AN	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)
868d75db FXC	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";
bec38225	293	#ifdef HAVE_SNPRINTF
868d75db	294	snprintf (buf, sizeof(buf), "%d", (int) getppid ());
bec38225 RO	295	#else
	296	sprintf (buf, "%d", (int) getppid ());
	297	#endif
868d75db FXC	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	}