[Bug fortran/46686] Improve backtracing (unwinding) on MinGW

["fxcoudert at gcc dot gnu.org" <gcc-bugzilla at gcc dot gnu dot org>]

http://gcc.gnu.org/bugzilla/show_bug.cgi?id=46686

Francois-Xavier Coudert <fxcoudert at gcc dot gnu.org> changed:

           What    |Removed                     |Added
----------------------------------------------------------------------------
                 CC|                            |fxcoudert at gcc dot
                   |                            |gnu.org

--- Comment #1 from Francois-Xavier Coudert <fxcoudert at gcc dot gnu.org> 2011-05-06 21:25:24 UTC ---
The generic code below relies on libgcc routines, it should work anywhere,
doesn't it?
(Well, on mingw you won't be able to resolve function names using dladdr(), so
you're stuck with the address only, but that's already useful information).
Anyway, I don't have time to propose a patch, but the code below works nicely
on Mac OS (where gfortran doesn't currently support backtraces).

------------------------------------------

#include <stdlib.h>
#include <unistd.h>
#include <dlfcn.h>
#include <stdio.h>

typedef enum
{
  _URC_NO_REASON = 0,
  _URC_FOREIGN_EXCEPTION_CAUGHT = 1,
  _URC_FATAL_PHASE2_ERROR = 2,
  _URC_FATAL_PHASE1_ERROR = 3,
  _URC_NORMAL_STOP = 4,
  _URC_END_OF_STACK = 5,
  _URC_HANDLER_FOUND = 6,
  _URC_INSTALL_CONTEXT = 7,
  _URC_CONTINUE_UNWIND = 8
} _Unwind_Reason_Code;

struct _Unwind_Context;

typedef _Unwind_Reason_Code (*_Unwind_Trace_Fn)
  (struct _Unwind_Context *, void *);

extern _Unwind_Reason_Code _Unwind_Backtrace (_Unwind_Trace_Fn, void *);

#if defined(__ia64__) && defined(__hpux__)
typedef unsigned _Unwind_Ptr __attribute__((__mode__(__word__)));
#else
typedef unsigned _Unwind_Ptr __attribute__((__mode__(__pointer__)));
#endif

extern _Unwind_Ptr _Unwind_GetIP (struct _Unwind_Context *);

static _Unwind_Reason_Code
trace_function (struct _Unwind_Context *context, void *unused)
{
  void * ip = (void *)(uintptr_t) _Unwind_GetIP (context);

  Dl_info dlinfo;
  dladdr (ip, &dlinfo);
  if (dlinfo.dli_sname != NULL)
    printf ("%p (%s)\n", ip, dlinfo.dli_sname);
  else
    printf ("%p\n", ip);

  return _URC_NO_REASON;
}

void show_backtrace (void)
{
  _Unwind_Backtrace (trace_function, NULL);
}