Add symbolizer (for mcode).

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

1 files changed, 41 insertions, 2 deletions

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");