Add symbolizer (for mcode).

Display a backtrace in case of failed check or assert failure.

9 files changed, 483 insertions, 33 deletions

diff --git a/src/grt/config/grt_itf.h b/src/grt/config/grt_itf.h
new file mode 100644
index 000000000..1b17c3a8b
--- /dev/null
+++ b/src/grt/config/grt_itf.h
@@ -0,0 +1,40 @@
+/*  Declarations to interface with Ada code.
+    Copyright (C) 2015 Tristan Gingold.
+
+    GHDL 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 2, or (at your option) any later
+    version.
+
+    GHDL 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.
+
+    You should have received a copy of the GNU General Public License
+    along with GCC; see the file COPYING.  If not, write to the Free
+    Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+    02111-1307, USA.
+
+    As a special exception, if other files instantiate generics from this
+    unit, or you link this unit with other files to produce an executable,
+    this unit does not by itself cause the resulting executable to be
+    covered by the GNU General Public License. This exception does not
+    however invalidate any other reasons why the executable file might be
+    covered by the GNU Public License.
+*/
+
+struct backtrace_addrs
+{
+  int size;
+  int skip;
+  void *addrs[32];
+};
+
+void grt_save_backtrace (struct backtrace_addrs *bt, int skip);
+
+extern void grt_overflow_error (struct backtrace_addrs *bt);
+extern void grt_null_access_error (struct backtrace_addrs *bt);
+
+void __ghdl_maybe_return_via_longjump (int val);
+int __ghdl_run_through_longjump (int (*func)(void));
diff --git a/src/grt/config/jumps.c b/src/grt/config/jumps.c
index a544f8372..00e17d37d 100644
--- a/src/grt/config/jumps.c
+++ b/src/grt/config/jumps.c
@@ -29,11 +29,17 @@
 #include <signal.h>
 #include <fcntl.h>
 
-#if defined (__linux__) && defined (__i386__)
-/* On i386/Linux, the context must be inspected.  */
+#if defined (__linux__) || defined (__APPLE__)
+#define HAVE_BACKTRACE 1
 #include <sys/ucontext.h>
 #endif
 
+#ifdef HAVE_BACKTRACE
+#include <execinfo.h>
+#endif
+
+#include "grt_itf.h"
+
 /* There is a simple setjmp/longjmp mechanism used to report failures.
    We have the choice between 3 mechanisms:
    * USE_BUITLIN_SJLJ: gcc builtin setjmp/longjmp, very fast but gcc specific.
@@ -70,49 +76,89 @@ typedef jmp_buf JMP_BUF;
 static int run_env_en;
 static JMP_BUF run_env;
 
-extern void grt_overflow_error (void);
-extern void grt_null_access_error (void);
-
 #ifdef __APPLE__
 #define NEED_SIGFPE_HANDLER
+#define NEED_SIGBUS_HANDLER
 #endif
 
 static struct sigaction prev_sigfpe_act;
 
+#ifdef NEED_SIGFPE_HANDLER
+static struct sigaction prev_sigsegv_act;
+#endif
+#ifdef NEED_SIGBUS_HANDLER
+static struct sigaction prev_sigbus_act;
+#endif
+
+static void
+get_bt_from_ucontext (void *uctxt, struct backtrace_addrs *bt)
+{
+  void *pc = NULL;
+  int i;
+
+#ifdef HAVE_BACKTRACE
+  bt->size = backtrace (bt->addrs, sizeof (bt->addrs) / sizeof (void *));
+  bt->skip = 0;
+#else
+  bt->size = 0;
+  return;
+#endif
+
+#if defined (__linux__) && defined (__x86_64__)
+  ucontext *u = (ucontext *)uctxt;
+  pc = (void *)u->uc_mcontext.gregs[REG_RIP];
+#endif
+#if defined (__APPLE__) && defined (__i386__)
+  ucontext_t *u = (ucontext_t *)uctxt;
+  pc = (void *)u->uc_mcontext->__ss.__eip;
+  bt->skip = 3;  /* This frame + sighandler + trampoline + marker - pc.  */
+  bt->addrs[3] = pc;
+#endif
+}
+
 /* Handler for SIGFPE signal.
    It is also raised in case of overflow (i386 linux).  */
-static void grt_overflow_handler (int signo, siginfo_t *info, void *ptr)
+static void
+grt_overflow_handler (int signo, siginfo_t *info, void *ptr)
 {
-  grt_overflow_error ();
-}
+  struct backtrace_addrs bt;
 
-static struct sigaction prev_sigsegv_act;
+  get_bt_from_ucontext (ptr, &bt);
+  grt_overflow_error (&bt);
+}
 
 /* Posix handler for overflow.  This is used only by mcode.  */
-static void grt_sigsegv_handler (int signo, siginfo_t *info, void *ptr)
+static void
+grt_sigsegv_handler (int signo, siginfo_t *info, void *ptr)
 {
-#if defined (__linux__) && defined (__i386__)
-  ucontext_t *uctxt = (ucontext_t *)ptr;
+  struct backtrace_addrs bt;
 
-  /* Linux generates a SIGSEGV (!) for an overflow exception.  */
-  if (uctxt->uc_mcontext.gregs[REG_TRAPNO] == 4)
+  get_bt_from_ucontext (ptr, &bt);
+
+#if defined (__linux__) && defined (__i386__)
+  if (signo == SIGSEGV)
     {
-      grt_overflow_error ();
+      ucontext_t *uctxt = (ucontext_t *)ptr;
+
+      /* Linux generates a SIGSEGV (!) for an overflow exception.  */
+      if (uctxt->uc_mcontext.gregs[REG_TRAPNO] == 4)
+	grt_overflow_error (&bt);
     }
 #endif
 
   /* We loose.  */
-  grt_null_access_error ();
+  grt_null_access_error (&bt);
 }
 
-static void grt_signal_setup (void)
+static void
+grt_signal_setup (void)
 {
   {
     struct sigaction sigsegv_act;
 
     sigsegv_act.sa_sigaction = &grt_sigsegv_handler;
     sigemptyset (&sigsegv_act.sa_mask);
-    sigsegv_act.sa_flags = SA_ONSTACK | SA_SIGINFO;
+    sigsegv_act.sa_flags = SA_SIGINFO;
 #ifdef SA_ONESHOT
     sigsegv_act.sa_flags |= SA_ONESHOT;
 #elif defined (SA_RESETHAND)
@@ -122,6 +168,10 @@ static void grt_signal_setup (void)
     /* We don't care about the return status.
        If the handler is not installed, then some feature are lost.  */
     sigaction (SIGSEGV, &sigsegv_act, &prev_sigsegv_act);
+
+#ifdef NEED_SIGBUS_HANDLER
+    sigaction (SIGBUS, &sigsegv_act, &prev_sigbus_act);
+#endif
   }
 
 #ifdef NEED_SIGFPE_HANDLER
@@ -137,10 +187,15 @@ static void grt_signal_setup (void)
 #endif
 }
 
-static void grt_signal_restore (void)
+static void
+grt_signal_restore (void)
 {
   sigaction (SIGSEGV, &prev_sigsegv_act, NULL);
 
+#ifdef NEED_SIGBUS_HANDLER
+  sigaction (SIGBUS, &prev_sigbus_act, NULL);
+#endif
+
 #ifdef NEED_SIGFPE_HANDLER
   sigaction (SIGFPE, &prev_sigfpe_act, NULL);
 #endif
@@ -167,3 +222,14 @@ __ghdl_run_through_longjump (int (*func)(void))
   run_env_en = 0;
   return res;
 }
+
+void
+grt_save_backtrace (struct backtrace_addrs *bt, int skip)
+{
+#ifdef HAVE_BACKTRACE
+  bt->size = backtrace (bt->addrs, sizeof (bt->addrs) / sizeof (void *));
+  bt->skip = skip + 1;
+#else
+  bt->size = 0;
+#endif
+}
diff --git a/src/grt/config/win32.c b/src/grt/config/win32.c
index 869c7ca61..63d11a23e 100644
--- a/src/grt/config/win32.c
+++ b/src/grt/config/win32.c
@@ -30,13 +30,11 @@
 #include <assert.h>
 #include <excpt.h>
 
+#include "grt_itf.h"
+
 static int run_env_en;
 static jmp_buf run_env;
 
-extern void grt_overflow_error (void);
-extern void grt_null_access_error (void);
-void __ghdl_maybe_return_via_longjump (int val);
-
 static EXCEPTION_DISPOSITION
 ghdl_SEH_handler (struct _EXCEPTION_RECORD* ExceptionRecord,
 		  void *EstablisherFrame,
@@ -60,7 +58,8 @@ ghdl_SEH_handler (struct _EXCEPTION_RECORD* ExceptionRecord,
   switch (ExceptionRecord->ExceptionCode)
     {
     case EXCEPTION_ACCESS_VIOLATION:
-      grt_null_access_error ();
+      /* Pc is ExceptionRecord->ExceptionAddress.  */
+      grt_null_access_error (NULL);
       break;
 
     case EXCEPTION_FLT_DENORMAL_OPERAND:
@@ -77,7 +76,7 @@ ghdl_SEH_handler (struct _EXCEPTION_RECORD* ExceptionRecord,
       break;
 
     case EXCEPTION_INT_OVERFLOW:
-      grt_overflow_error ();
+      grt_overflow_error (NULL);
       break;
 
     case EXCEPTION_STACK_OVERFLOW:
@@ -132,6 +131,12 @@ __ghdl_run_through_longjump (int (*func)(void))
   return res;
 }
 
+void
+grt_save_backtrace (struct backtrace_addrs *bt, int skip)
+{
+  bt->size = 0;
+}
+
 #include <math.h>
 
 double acosh (double x)
diff --git a/src/grt/grt-backtraces.adb b/src/grt/grt-backtraces.adb
new file mode 100644
index 000000000..8b779a7d8
--- /dev/null
+++ b/src/grt/grt-backtraces.adb
@@ -0,0 +1,232 @@
+--  GHDL Run Time (GRT) - Backtraces and symbolization.
+--  Copyright (C) 2015 Tristan Gingold
+--
+--  GHDL 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 2, or (at your option) any later
+--  version.
+--
+--  GHDL 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.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+--
+--  As a special exception, if other files instantiate generics from this
+--  unit, or you link this unit with other files to produce an executable,
+--  this unit does not by itself cause the resulting executable to be
+--  covered by the GNU General Public License. This exception does not
+--  however invalidate any other reasons why the executable file might be
+--  covered by the GNU Public License.
+
+with System;
+with Grt.Types; use Grt.Types;
+with Grt.Hooks; use Grt.Hooks;
+
+package body Grt.Backtraces is
+   --  If true, disp address in backtraces.
+   Flag_Address : Boolean := False;
+
+   subtype Address_Image_String is String (1 .. Integer_Address'Size / 4);
+
+   Hex : constant array (Natural range 0 .. 15) of Character :=
+     "0123456789abcdef";
+
+   function Address_Image (Addr : Integer_Address)
+                          return Address_Image_String
+   is
+      V : Integer_Address;
+      Res : Address_Image_String;
+   begin
+      V := Addr;
+      for I in reverse Res'Range loop
+         Res (I) := Hex (Natural (V mod 16));
+         V := V / 16;
+      end loop;
+      return Res;
+   end Address_Image;
+
+   function File_Basename (Name : Ghdl_C_String) return Ghdl_C_String
+   is
+      Sep : Natural;
+   begin
+      Sep := 0;
+      for I in Name'Range loop
+         case Name (I) is
+            when '\' | '/' =>
+               Sep := I + 1;
+            when NUL =>
+               exit;
+            when others =>
+               null;
+         end case;
+      end loop;
+      if Sep /= 0 and then Name (Sep) /= NUL then
+         return To_Ghdl_C_String (Name (Sep)'Address);
+      else
+         return Name;
+      end if;
+   end File_Basename;
+
+   function Is_Eq (Str : Ghdl_C_String; Ref : String) return Boolean is
+   begin
+      for I in Ref'Range loop
+         if Str (Str'First + I - Ref'First) /= Ref (I) then
+            return False;
+         end if;
+      end loop;
+      return Str (Str'First + Ref'Length) = NUL;
+   end Is_Eq;
+
+   procedure Demangle_Err (Name : Ghdl_C_String)
+   is
+      Last_Part : Natural;
+      Suffix : Ghdl_C_String;
+      Off : Natural;
+      C : Character;
+      Is_Arch : Boolean;
+   begin
+      if Name (1) = '_' then
+         if Is_Eq (Name, "__ghdl_ELABORATE") then
+            Put_Err ("Elaboration of design");
+            return;
+         end if;
+      end if;
+
+      --  Find last suffix (as it indicates processes and elaborator).
+      Last_Part := 0;
+      for I in Name'Range loop
+         exit when Name (I) = NUL;
+         if Name (I) = '_' and then Name (I + 1) = '_' then
+            Last_Part := I;
+         end if;
+      end loop;
+
+      if Last_Part /= 0 then
+         Suffix := To_Ghdl_C_String (Name (Last_Part)'Address);
+         if Is_Eq (Suffix, "__ELAB") then
+            Put_Err ("elaboration of ");
+         elsif Is_Eq (Suffix, "__PROC") then
+            Put_Err ("process ");
+         else
+            Last_Part := 0;
+         end if;
+      end if;
+      Off := 1;
+      Is_Arch := False;
+      loop
+         exit when Off = Last_Part;
+         C := Name (Off);
+         Off := Off + 1;
+         exit when C = NUL;
+         if C = '_' and then Name (Off) = '_' then
+            if Name (Off + 1) = 'A'
+              and then Name (Off + 2) = 'R'
+              and then Name (Off + 3) = 'C'
+              and then Name (Off + 4) = 'H'
+              and then Name (Off + 5) = '_'
+              and then Name (Off + 6) = '_'
+            then
+               Off := Off + 7;
+               Put_Err ('(');
+               Is_Arch := True;
+            else
+               if Is_Arch then
+                  Put_Err (')');
+                  Is_Arch := False;
+               end if;
+               Put_Err ('.');
+               Off := Off + 1;
+            end if;
+         else
+            Put_Err (C);
+         end if;
+      end loop;
+      if Is_Arch then
+         Put_Err (')');
+      end if;
+   end Demangle_Err;
+
+   procedure Put_Err_Backtrace (Bt : Backtrace_Addrs)
+   is
+      use System;
+
+      Filename : Address;
+      Lineno : Natural;
+      Subprg : Address;
+      Unknown : Boolean;
+   begin
+      if Bt.Size = 0
+        or else Bt.Skip >= Bt.Size
+        or else Symbolizer = null
+      then
+         --  No backtrace or no symbolizer.
+         return;
+      end if;
+
+      Unknown := False;
+      for I in Bt.Skip .. Bt.Size loop
+         Symbolizer.all (To_Address (Bt.Addrs (I)),
+                         Filename, Lineno, Subprg);
+         if Subprg = Null_Address
+           and (Filename = Null_Address or Lineno = 0)
+         then
+            Unknown := True;
+         else
+            if Unknown then
+               Put_Err ("  from: [unknown caller]");
+               Unknown := False;
+            end if;
+            Put_Err ("  from:");
+            if Flag_Address then
+               Put_Err (" 0x");
+               Put_Err (Address_Image (Bt.Addrs (I)));
+            end if;
+            if Subprg /= Null_Address then
+               Put_Err (' ');
+               Demangle_Err (To_Ghdl_C_String (Subprg));
+            end if;
+            if Filename /= Null_Address and Lineno /= 0 then
+               Put_Err (" at ");
+               Put_Err (File_Basename (To_Ghdl_C_String (Filename)));
+               Put_Err (":");
+               Put_Err (Lineno);
+            end if;
+            Newline_Err;
+         end if;
+      end loop;
+   end Put_Err_Backtrace;
+
+   --  Return TRUE if OPT is an option for backtrace.
+   function Backtrace_Option (Opt : String) return Boolean
+   is
+      F : constant Natural := Opt'First;
+   begin
+      if Opt'Length < 10 or else Opt (F .. F + 10) /= "--backtrace" then
+         return False;
+      end if;
+      if Opt'Length = 16 and then Opt (F + 11 .. F + 15) = "-addr" then
+         Flag_Address := True;
+         return True;
+      end if;
+      return False;
+   end Backtrace_Option;
+
+   Backtrace_Hooks : aliased constant Hooks_Type :=
+     (Desc => new String'("backtrace: print backtrace on errors"),
+      Option => Backtrace_Option'Access,
+      Help => null,
+      Init => null,
+      Start => null,
+      Finish => null);
+
+   procedure Register is
+   begin
+      Register_Hooks (Backtrace_Hooks'Access);
+   end Register;
+
+end Grt.Backtraces;
diff --git a/src/grt/grt-backtraces.ads b/src/grt/grt-backtraces.ads
new file mode 100644
index 000000000..697b9dd95
--- /dev/null
+++ b/src/grt/grt-backtraces.ads
@@ -0,0 +1,34 @@
+--  GHDL Run Time (GRT) - Backtraces and symbolization.
+--  Copyright (C) 2015 Tristan Gingold
+--
+--  GHDL 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 2, or (at your option) any later
+--  version.
+--
+--  GHDL 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.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+--
+--  As a special exception, if other files instantiate generics from this
+--  unit, or you link this unit with other files to produce an executable,
+--  this unit does not by itself cause the resulting executable to be
+--  covered by the GNU General Public License. This exception does not
+--  however invalidate any other reasons why the executable file might be
+--  covered by the GNU Public License.
+
+with Grt.Errors; use Grt.Errors;
+
+package Grt.Backtraces is
+   pragma Preelaborate (Grt.Backtraces);
+
+   procedure Put_Err_Backtrace (Bt : Backtrace_Addrs);
+
+   procedure Register;
+end Grt.Backtraces;
diff --git a/src/grt/grt-errors.adb b/src/grt/grt-errors.adb
index 62ee86e2e..56d1e6f81 100644
--- a/src/grt/grt-errors.adb
+++ b/src/grt/grt-errors.adb
@@ -26,6 +26,7 @@ with Grt.Stdio; use Grt.Stdio;
 with Grt.Astdio; use Grt.Astdio;
 with Grt.Options; use Grt.Options;
 with Grt.Hooks; use Grt.Hooks;
+with Grt.Backtraces;
 
 package body Grt.Errors is
    --  Called in case of premature exit.
@@ -76,6 +77,11 @@ package body Grt.Errors is
       Put (stderr, Str);
    end Put_Err;
 
+   procedure Put_Err (C : Character) is
+   begin
+      Put (stderr, C);
+   end Put_Err;
+
    procedure Put_Err (Str : Ghdl_C_String) is
    begin
       Put (stderr, Str);
@@ -254,13 +260,34 @@ package body Grt.Errors is
       Fatal_Error;
    end Internal_Error;
 
-   procedure Grt_Overflow_Error is
+   procedure Error_E_Call_Stack (Bt : Backtrace_Addrs) is
+   begin
+      Newline_Err;
+
+      Grt.Backtraces.Put_Err_Backtrace (Bt);
+
+      Cont := False;
+      Fatal_Error;
+   end Error_E_Call_Stack;
+
+   procedure Error_E_Call_Stack (Bt : Backtrace_Addrs_Acc) is
+   begin
+      if Bt /= null then
+         Error_E_Call_Stack (Bt.all);
+      else
+         Error_E;
+      end if;
+   end Error_E_Call_Stack;
+
+   procedure Grt_Overflow_Error (Bt : Backtrace_Addrs_Acc) is
    begin
-      Error ("overflow detected");
+      Error_C ("overflow detected");
+      Error_E_Call_Stack (Bt);
    end Grt_Overflow_Error;
 
-   procedure Grt_Null_Access_Error is
+   procedure Grt_Null_Access_Error (Bt : Backtrace_Addrs_Acc) is
    begin
-      Error ("NULL access dereferenced");
+      Error_C ("NULL access dereferenced");
+      Error_E_Call_Stack (Bt);
    end Grt_Null_Access_Error;
 end Grt.Errors;
diff --git a/src/grt/grt-errors.ads b/src/grt/grt-errors.ads
index bb7aab9a4..cd7c3dcf5 100644
--- a/src/grt/grt-errors.ads
+++ b/src/grt/grt-errors.ads
@@ -22,6 +22,7 @@
 --  covered by the GNU General Public License. This exception does not
 --  however invalidate any other reasons why the executable file might be
 --  covered by the GNU Public License.
+with System;
 with Grt.Types; use Grt.Types;
 with Grt.Hooks;
 
@@ -62,12 +63,44 @@ package Grt.Errors is
    --  Display a message which is not an error.
    procedure Info (Str : String);
 
+   --  Backtrace used to report call stack in case of error.
+   --  Note: for simplicity we assume that a PC is enough to display the
+   --  corresponding file name, line number and routine name.  Might not be
+   --  true on some platforms.
+   --  There is a C version of this record in grt_itf.h
+   type Integer_Address_Array is array (Natural range <>) of Integer_Address;
+   type Backtrace_Addrs is record
+      Size : Natural;
+      Skip : Natural;
+      Addrs : Integer_Address_Array (0 .. 31);
+   end record;
+   pragma Convention (C, Backtrace_Addrs);
+
+   type Backtrace_Addrs_Acc is access Backtrace_Addrs;
+
+   type Symbolizer_Acc is access procedure (Pc : System.Address;
+                                            Filename : out System.Address;
+                                            Lineno : out Natural;
+                                            Subprg : out System.Address);
+
+   Symbolizer : Symbolizer_Acc := null;
+
+   procedure Save_Backtrace (Bt : out Backtrace_Addrs; Skip : Natural);
+   pragma Import (C, Save_Backtrace, "grt_save_backtrace");
+
+   --  Finish error message with a call stack.
+   procedure Error_E_Call_Stack (Bt : Backtrace_Addrs);
+   pragma No_Return (Error_E_Call_Stack);
+
+   procedure Error_E_Call_Stack (Bt : Backtrace_Addrs_Acc);
+   pragma No_Return (Error_E_Call_Stack);
+
    --  Display an error message for an overflow.
-   procedure Grt_Overflow_Error;
+   procedure Grt_Overflow_Error (Bt : Backtrace_Addrs_Acc);
    pragma No_Return (Grt_Overflow_Error);
 
    --  Display an error message for a NULL access dereference.
-   procedure Grt_Null_Access_Error;
+   procedure Grt_Null_Access_Error (Bt : Backtrace_Addrs_Acc);
    pragma No_Return (Grt_Null_Access_Error);
 
    --  Called at end of error message.  Central point for failures.
@@ -97,6 +130,12 @@ package Grt.Errors is
    --  If true, an error is expected and the exit status is inverted.
    Expect_Failure : Boolean := False;
 
+   --  Internal subprograms, to be called only by the symbolizer.
+   procedure Put_Err (C : Character);
+   procedure Put_Err (Str : String);
+   procedure Put_Err (Str : Ghdl_C_String);
+   procedure Put_Err (N : Integer);
+   procedure Newline_Err;
 private
    pragma Export (C, Grt_Overflow_Error, "grt_overflow_error");
    pragma Export (C, Grt_Null_Access_Error, "grt_null_access_error");
diff --git a/src/grt/grt-lib.adb b/src/grt/grt-lib.adb
index d2b095c67..95a4a0948 100644
--- a/src/grt/grt-lib.adb
+++ b/src/grt/grt-lib.adb
@@ -46,6 +46,7 @@ package body Grt.Lib is
                         Loc : Ghdl_Location_Ptr)
    is
       Level : constant Integer := Severity mod 256;
+      Bt : Backtrace_Addrs;
    begin
       Report_H;
       Report_C (Loc.Filename);
@@ -77,8 +78,10 @@ package body Grt.Lib is
          Report_E (Default_Str);
       end if;
       if Level >= Grt.Options.Severity_Level then
+         Save_Backtrace (Bt, 2);
          Error_C (Msg);
-         Error_E (" failed");
+         Error_C (" failed");
+         Error_E_Call_Stack (Bt);
       end if;
    end Do_Report;
 
@@ -161,12 +164,14 @@ package body Grt.Lib is
    procedure Ghdl_Bound_Check_Failed_L1 (Filename : Ghdl_C_String;
                                          Line: Ghdl_I32)
    is
+      Bt : Backtrace_Addrs;
    begin
+      Save_Backtrace (Bt, 1);
       Error_C ("bound check failure at ");
       Error_C (Filename);
       Error_C (":");
       Error_C (Integer (Line));
-      Error_E ("");
+      Error_E_Call_Stack (Bt);
    end Ghdl_Bound_Check_Failed_L1;
 
    function Ghdl_Integer_Exp (V : Ghdl_I32; E : Ghdl_I32)
diff --git a/src/grt/grt-modules.adb b/src/grt/grt-modules.adb
index 3fc6c4ec2..0feb46cb1 100644
--- a/src/grt/grt-modules.adb
+++ b/src/grt/grt-modules.adb
@@ -32,6 +32,7 @@ with Grt.Waves;
 with Grt.Vital_Annotate;
 with Grt.Disp_Tree;
 with Grt.Disp_Rti;
+with Grt.Backtraces;
 
 package body Grt.Modules is
    procedure Register_Modules is
@@ -45,5 +46,6 @@ package body Grt.Modules is
       Grt.Vpi.Register;
       Grt.Vital_Annotate.Register;
       Grt.Disp_Rti.Register;
+      Grt.Backtraces.Register;
    end Register_Modules;
 end Grt.Modules;