1 files changed, 131 insertions, 0 deletions
diff --git a/src/grt/grt-backtraces-gcc.adb b/src/grt/grt-backtraces-gcc.adb
new file mode 100644
index 0000000..3ac412b
--- /dev/null
+++ b/src/grt/grt-backtraces-gcc.adb
@@ -0,0 +1,131 @@
+--  GHDL Run Time (GRT) - Symbolization using gcc libbacktrace.
+--  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; use System;
+
+package body Grt.Backtraces.Gcc is
+   --  From backtrace.h
+   type Backtrace_Error_Callback is access procedure
+     (Data : System.Address; Msg : Address; Errnum : Integer);
+   pragma Convention (C, Backtrace_Error_Callback);
+
+   type Backtrace_State is null record;
+   pragma Convention (C, Backtrace_State);
+
+   type Backtrace_State_Acc is access all Backtrace_State;
+   pragma Convention (C, Backtrace_State_Acc);
+
+   function Backtrace_Create_State (Filename : Address;
+                                    Threaded : Integer;
+                                    Error_Callback : Backtrace_Error_Callback;
+                                    Data : System.Address)
+                                   return Backtrace_State_Acc;
+   pragma Import (C, Backtrace_Create_State);
+
+   type Backtrace_Full_Callback is access function
+     (Data : System.Address;
+      Pc : Address;
+      Filename : System.Address;
+      Lineno : Integer;
+      Function_Name : System.Address)
+     return Integer;
+   pragma Convention (C, Backtrace_Full_Callback);
+
+
+   function Backtrace_Pcinfo (State : Backtrace_State_Acc;
+                              Pc : Address;
+                              Callback : Backtrace_Full_Callback;
+                              Error_Callback : Backtrace_Error_Callback;
+                              Data : System.Address)
+                             return Integer;
+   pragma Import (C, Backtrace_Pcinfo);
+
+   State : Backtrace_State_Acc;
+   Initialized : Boolean := False;
+
+   Res_Filename : System.Address;
+   Res_Lineno : Natural;
+   Res_Subprg : System.Address;
+
+   procedure Error_Cb
+     (Data : Address; Msg : Address; Errnum : Integer);
+   pragma Convention (C, Error_Cb);
+
+   procedure Error_Cb
+     (Data : Address; Msg : Address; Errnum : Integer) is
+   begin
+      null;
+   end Error_Cb;
+
+   function Cb (Data : System.Address;
+                Pc : Address;
+                Filename : System.Address;
+                Lineno : Integer;
+                Function_Name : System.Address)
+               return Integer;
+   pragma Convention (C, Cb);
+
+   function Cb (Data : System.Address;
+                Pc : Address;
+                Filename : System.Address;
+                Lineno : Integer;
+                Function_Name : System.Address)
+               return Integer is
+   begin
+      if Res_Filename = Null_Address then
+         Res_Filename := Filename;
+         Res_Lineno := Lineno;
+         Res_Subprg := Function_Name;
+      end if;
+      return 0;
+   end Cb;
+
+   procedure Symbolizer (Pc : System.Address;
+                         Filename : out System.Address;
+                         Lineno : out Natural;
+                         Subprg : out System.Address)
+   is
+      Res : Integer;
+   begin
+      if not Initialized then
+         Initialized := True;
+         State := Backtrace_Create_State
+           (Null_Address, 0, Error_Cb'Access, Null_Address);
+      end if;
+
+      Res_Filename := Null_Address;
+      Res_Lineno := 0;
+      Res_Subprg := Null_Address;
+
+      if State /= null then
+         Res := Backtrace_Pcinfo
+           (State, Pc, Cb'access, Error_Cb'Access, Null_Address);
+      end if;
+
+      Filename := Res_Filename;
+      Lineno := Res_Lineno;
+      Subprg := Res_Subprg;
+   end Symbolizer;
+end Grt.Backtraces.Gcc;