diff mbox

[Ada] Default implementation of GNAT.Traceback.Symbolic

Message ID 20111006193843.GA17709@adacore.com
State New
Headers show

Commit Message

Arnaud Charlet Oct. 6, 2011, 7:38 p.m. UTC 
For the platforms where the full capability of GNAT.Traceback.Symbolic,
there is now a default implementation where the tracebacks are given as
a list of addresses expressed as "0x..." separated by line feed.

Tested on x86_64-pc-linux-gnu, committed on trunk

2011-10-06  Vincent Celier  <celier@adacore.com>

	* g-trasym.adb: Replace old implementation with the default
	implementation that returns list of addresses as "0x...".
	* g-trasym.ads: Update the list of platforms with the full
	capability.  Indicate that there is a default implementation
	for other platforms.
	* g-trasym-unimplemented.ads, g-trasym-unimplemented.adb: Remove.
	* gcc-interface/Makefile.in: Remove g-trasym-unimplemented, as there
	is now a default implementation for all platforms without the full
	capability.
diff mbox

Patch

Index: g-trasym-unimplemented.adb
===================================================================
--- g-trasym-unimplemented.adb	(revision 179628)
+++ g-trasym-unimplemented.adb	(working copy)
@@ -1,70 +0,0 @@ 
-------------------------------------------------------------------------------
---                                                                          --
---                         GNAT RUN-TIME COMPONENTS                         --
---                                                                          --
---             G N A T . T R A C E B A C K . S Y M B O L I C                --
---                                                                          --
---                                 B o d y                                  --
---                                                                          --
---                     Copyright (C) 1999-2010, AdaCore                     --
---                                                                          --
--- GNAT is free software;  you can  redistribute it  and/or modify it under --
--- terms of the  GNU General Public License as published  by the Free Soft- --
--- ware  Foundation;  either version 3,  or (at your option) any later ver- --
--- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
--- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
--- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
---                                                                          --
--- As a special exception 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/>.                                          --
---                                                                          --
--- GNAT was originally developed  by the GNAT team at  New York University. --
--- Extensive contributions were provided by Ada Core Technologies Inc.      --
---                                                                          --
-------------------------------------------------------------------------------
-
---  Version used on unimplemented targets
-
---  Run-time symbolic traceback is currently supported on the following
---  targets:
-
---     HP-UX
---     IRIX
---     GNU/Linux x86
---     AIX
---     Solaris sparc
---     Tru64
---     OpenVMS/Alpha
---     Windows NT/XP/Vista
-
---  This version is used on all other targets, it generates a warning at
---  compile time if it is with'ed, and the bodies generate messages saying
---  that the functions are not implemented.
-
-package body GNAT.Traceback.Symbolic is
-
-   ------------------------
-   -- Symbolic_Traceback --
-   ------------------------
-
-   function Symbolic_Traceback (Traceback : Tracebacks_Array) return String
-   is
-      pragma Unreferenced (Traceback);
-   begin
-      return "Symbolic_Traceback not implemented on this target";
-   end Symbolic_Traceback;
-
-   function Symbolic_Traceback (E : Exception_Occurrence) return String
-   is
-      pragma Unreferenced (E);
-   begin
-      return "Symbolic_Traceback not implemented on this target";
-   end Symbolic_Traceback;
-
-end GNAT.Traceback.Symbolic;
Index: g-trasym-unimplemented.ads
===================================================================
--- g-trasym-unimplemented.ads	(revision 179628)
+++ g-trasym-unimplemented.ads	(working copy)
@@ -1,64 +0,0 @@ 
-------------------------------------------------------------------------------
---                                                                          --
---                         GNAT RUN-TIME COMPONENTS                         --
---                                                                          --
---             G N A T . T R A C E B A C K . S Y M B O L I C                --
---                                                                          --
---                                 S p e c                                  --
---                                                                          --
---                     Copyright (C) 1999-2010, AdaCore                     --
---                                                                          --
--- GNAT is free software;  you can  redistribute it  and/or modify it under --
--- terms of the  GNU General Public License as published  by the Free Soft- --
--- ware  Foundation;  either version 3,  or (at your option) any later ver- --
--- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
--- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
--- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
---                                                                          --
--- As a special exception 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/>.                                          --
---                                                                          --
--- GNAT was originally developed  by the GNAT team at  New York University. --
--- Extensive contributions were provided by Ada Core Technologies Inc.      --
---                                                                          --
-------------------------------------------------------------------------------
-
---  Version used on unimplemented targets
-
---  Run-time symbolic traceback is currently supported on the following
---  targets:
-
---     HP-UX hppa and ia64
---     IRIX
---     GNU/Linux x86, x86_64, ia64
---     AIX
---     Solaris sparc and x86
---     Tru64
---     OpenVMS/Alpha
---     Windows NT/XP/Vista
-
---  This version is used on all other targets, it generates a warning at
---  compile time if it is with'ed, and the bodies generate messages saying
---  that the functions are not implemented.
-
-with Ada.Exceptions; use Ada.Exceptions;
-
-package GNAT.Traceback.Symbolic is
-   pragma Elaborate_Body;
-
---     pragma Compile_Time_Warning
---       (True, "symbolic traceback not implemented on this target");
-
-   function Symbolic_Traceback (Traceback : Tracebacks_Array) return String;
-   --  Build a string containing a symbolic traceback of the given call chain
-
-   function Symbolic_Traceback (E : Exception_Occurrence) return String;
-   --  Build string containing symbolic traceback of given exception occurrence
-
-end GNAT.Traceback.Symbolic;
Index: g-trasym.adb
===================================================================
--- g-trasym.adb	(revision 179628)
+++ g-trasym.adb	(working copy)
@@ -6,7 +6,7 @@ 
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---                     Copyright (C) 1999-2010, AdaCore                     --
+--                     Copyright (C) 1999-2011, AdaCore                     --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -29,122 +29,47 @@ 
 --                                                                          --
 ------------------------------------------------------------------------------
 
---  Run-time symbolic traceback support
+--  This is the default implementation for platforms where the full capability
+--  is not supported. It returns tracebacks as lists of "0x..." strings
+--  corresponding to the addresses.
 
-with System.Soft_Links;
 with Ada.Exceptions.Traceback; use Ada.Exceptions.Traceback;
+with System.Address_Image;
 
 package body GNAT.Traceback.Symbolic is
 
-   pragma Linker_Options ("-laddr2line");
-   pragma Linker_Options ("-lbfd");
-   pragma Linker_Options ("-liberty");
-
-   package TSL renames System.Soft_Links;
-
-   --  To perform the raw addresses to symbolic form translation we rely on a
-   --  libaddr2line symbolizer which examines debug info from a provided
-   --  executable file name, and an absolute path is needed to ensure the file
-   --  is always found. This is "__gnat_locate_exec_on_path (gnat_argv [0])"
-   --  for our executable file, a fairly heavy operation so we cache the
-   --  result.
-
-   Exename : System.Address;
-   --  Pointer to the name of the executable file to be used on all
-   --  invocations of the libaddr2line symbolization service.
-
-   Exename_Resolved : Boolean := False;
-   --  Flag to indicate whether we have performed the executable file name
-   --  resolution already. Relying on a not null Exename for this purpose
-   --  would be potentially inefficient as this is what we will get if the
-   --  resolution attempt fails.
-
    ------------------------
    -- Symbolic_Traceback --
    ------------------------
 
-   function Symbolic_Traceback (Traceback : Tracebacks_Array) return String is
-
-      procedure convert_addresses
-        (filename : System.Address;
-         addrs    : System.Address;
-         n_addrs  : Integer;
-         buf      : System.Address;
-         len      : System.Address);
-      pragma Import (C, convert_addresses, "convert_addresses");
-      --  This is the procedure version of the Ada-aware addr2line. It places
-      --  in BUF a string representing the symbolic translation of the N_ADDRS
-      --  raw addresses provided in ADDRS, looked up in debug information from
-      --  FILENAME. LEN points to an integer which contains the size of the
-      --  BUF buffer at input and the result length at output.
-      --
-      --  This procedure is provided by libaddr2line on targets that support
-      --  it. A dummy version is in adaint.c for other targets so that build
-      --  of shared libraries doesn't generate unresolved symbols.
-      --
-      --  Note that this procedure is *not* thread-safe.
-
-      type Argv_Array is array (0 .. 0) of System.Address;
-      gnat_argv : access Argv_Array;
-      pragma Import (C, gnat_argv, "gnat_argv");
-
-      function locate_exec_on_path
-        (c_exename : System.Address) return System.Address;
-      pragma Import (C, locate_exec_on_path, "__gnat_locate_exec_on_path");
-
-      Res : String (1 .. 256 * Traceback'Length);
-      Len : Integer;
-
-      use type System.Address;
-
+   function Symbolic_Traceback (Traceback : Tracebacks_Array) return String
+   is
    begin
-      --  The symbolic translation of an empty set of addresses is an empty
-      --  string.
-
       if Traceback'Length = 0 then
          return "";
-      end if;
 
-      --  If our input set of raw addresses is not empty, resort to the
-      --  libaddr2line service to symbolize it all.
-
-      --  Compute, cache and provide the absolute path to our executable file
-      --  name as the binary file where the relevant debug information is to be
-      --  found. If the executable file name resolution fails, we have no
-      --  sensible basis to invoke the symbolizer at all.
-
-      --  Protect all this against concurrent accesses explicitly, as the
-      --  underlying services are potentially thread unsafe.
-
-      TSL.Lock_Task.all;
-
-      if not Exename_Resolved then
-         Exename := locate_exec_on_path (gnat_argv (0));
-         Exename_Resolved := True;
-      end if;
-
-      if Exename /= System.Null_Address then
-         Len := Res'Length;
-         convert_addresses
-           (Exename, Traceback'Address, Traceback'Length,
-            Res (1)'Address, Len'Address);
-      end if;
-
-      TSL.Unlock_Task.all;
-
-      --  Return what the addr2line symbolizer has produced if we have called
-      --  it (the executable name resolution succeeded), or an empty string
-      --  otherwise.
-
-      if Exename /= System.Null_Address then
-         return Res (1 .. Len);
       else
-         return "";
-      end if;
+         declare
+            Img : String := System.Address_Image (Traceback (Traceback'First));
+            Result : String (1 .. (Img'Length + 3) * Traceback'Length);
+            Last   : Natural := 0;
+         begin
+            for J in Traceback'Range loop
+               Img := System.Address_Image (Traceback (J));
+               Result (Last + 1 .. Last + 2) := "0x";
+               Last := Last + 2;
+               Result (Last + 1 .. Last + Img'Length) := Img;
+               Last := Last + Img'Length + 1;
+               Result (Last) := ASCII.LF;
+            end loop;
 
+            return Result (1 .. Last);
+         end;
+      end if;
    end Symbolic_Traceback;
 
-   function Symbolic_Traceback (E : Exception_Occurrence) return String is
+   function Symbolic_Traceback (E : Exception_Occurrence) return String
+   is
    begin
       return Symbolic_Traceback (Tracebacks (E));
    end Symbolic_Traceback;
Index: g-trasym.ads
===================================================================
--- g-trasym.ads	(revision 179628)
+++ g-trasym.ads	(working copy)
@@ -6,7 +6,7 @@ 
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---                     Copyright (C) 1999-2010, AdaCore                     --
+--                     Copyright (C) 1999-2011, AdaCore                     --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -31,16 +31,16 @@ 
 
 --  Run-time symbolic traceback support
 
---  This capability is currently supported on the following targets:
+--  The full capability is currently supported on the following targets:
 
---     HP-UX hppa and ia64
+--     HP-UX ia64
 --     IRIX
 --     GNU/Linux x86, x86_64, ia64
---     AIX
+--     FreeBSD x86, x86_64
 --     Solaris sparc and x86
 --     Tru64
---     OpenVMS/Alpha
---     Windows NT/XP/Vista
+--     OpenVMS Alpha and ia64
+--     Windows
 
 --  The routines provided in this package assume that your application has
 --  been compiled with debugging information turned on, since this information
@@ -77,6 +77,10 @@ 
 --  libraries. However, the OS should be at least v7.3-1 and OS patch
 --  VMS731_TRACE-V0100 must be applied in order to use this package.
 
+--  On platforms where the full capability is not supported, function
+--  Symbolic_Traceback return a list of addresses expressed as "0x..."
+--  separated by line feed.
+
 with Ada.Exceptions; use Ada.Exceptions;
 
 package GNAT.Traceback.Symbolic is
Index: gcc-interface/Makefile.in
===================================================================
--- gcc-interface/Makefile.in	(revision 179628)
+++ gcc-interface/Makefile.in	(working copy)
@@ -469,8 +469,6 @@ 
   g-socthi.ads<g-socthi-vxworks.ads \
   g-socthi.adb<g-socthi-vxworks.adb \
   g-stsifd.adb<g-stsifd-sockets.adb \
-  g-trasym.ads<g-trasym-unimplemented.ads \
-  g-trasym.adb<g-trasym-unimplemented.adb \
   system.ads<system-vxworks-m68k.ads
 
   TOOLS_TARGET_PAIRS=mlib-tgt-specific.adb<mlib-tgt-specific-vxworks.adb
@@ -512,8 +510,6 @@ 
   g-socthi.ads<g-socthi-vxworks.ads \
   g-socthi.adb<g-socthi-vxworks.adb \
   g-stsifd.adb<g-stsifd-sockets.adb \
-  g-trasym.ads<g-trasym-unimplemented.ads \
-  g-trasym.adb<g-trasym-unimplemented.adb \
   $(ATOMICS_TARGET_PAIRS) \
   $(ATOMICS_BUILTINS_TARGET_PAIRS)
 
@@ -613,8 +609,6 @@ 
   s-vxwext.adb<s-vxwext-noints.adb \
   s-vxwext.ads<s-vxwext-vthreads.ads \
   s-vxwork.ads<s-vxwork-ppc.ads \
-  g-trasym.ads<g-trasym-unimplemented.ads \
-  g-trasym.adb<g-trasym-unimplemented.adb \
   system.ads<system-vxworks-ppc-vthread.ads \
   $(ATOMICS_TARGET_PAIRS) \
   $(ATOMICS_BUILTINS_TARGET_PAIRS)
@@ -676,8 +670,6 @@ 
   s-thread.adb<s-thread-ae653.adb \
   s-tpopsp.adb<s-tpopsp-vxworks.adb \
   s-vxwork.ads<s-vxwork-ppc.ads \
-  g-trasym.ads<g-trasym-unimplemented.ads \
-  g-trasym.adb<g-trasym-unimplemented.adb \
   system.ads<system-vxworks-ppc.ads \
   $(ATOMICS_TARGET_PAIRS) \
   $(ATOMICS_BUILTINS_TARGET_PAIRS) \
@@ -728,8 +720,6 @@ 
   s-vxwext.adb<s-vxwext-noints.adb \
   s-vxwext.ads<s-vxwext-vthreads.ads \
   s-vxwork.ads<s-vxwork-x86.ads \
-  g-trasym.ads<g-trasym-unimplemented.ads \
-  g-trasym.adb<g-trasym-unimplemented.adb \
   $(ATOMICS_TARGET_PAIRS) \
   $(X86_TARGET_PAIRS) \
   system.ads<system-vxworks-x86.ads
@@ -789,8 +779,6 @@ 
   g-socthi.ads<g-socthi-vxworks.ads \
   g-socthi.adb<g-socthi-vxworks.adb \
   g-stsifd.adb<g-stsifd-sockets.adb \
-  g-trasym.ads<g-trasym-unimplemented.ads \
-  g-trasym.adb<g-trasym-unimplemented.adb \
   system.ads<system-vxworks-sparcv9.ads   \
 
   TOOLS_TARGET_PAIRS=\
@@ -825,8 +813,6 @@ 
   g-socthi.ads<g-socthi-vxworks.ads \
   g-socthi.adb<g-socthi-vxworks.adb \
   g-stsifd.adb<g-stsifd-sockets.adb \
-  g-trasym.ads<g-trasym-unimplemented.ads \
-  g-trasym.adb<g-trasym-unimplemented.adb \
   $(ATOMICS_TARGET_PAIRS) \
   $(X86_TARGET_PAIRS)
 
@@ -922,8 +908,6 @@ 
   g-socthi.ads<g-socthi-vxworks.ads \
   g-socthi.adb<g-socthi-vxworks.adb \
   g-stsifd.adb<g-stsifd-sockets.adb \
-  g-trasym.ads<g-trasym-unimplemented.ads \
-  g-trasym.adb<g-trasym-unimplemented.adb \
   system.ads<system-vxworks-arm.ads
 
   TOOLS_TARGET_PAIRS=\
@@ -960,8 +944,6 @@ 
   g-socthi.ads<g-socthi-vxworks.ads \
   g-socthi.adb<g-socthi-vxworks.adb \
   g-stsifd.adb<g-stsifd-sockets.adb \
-  g-trasym.ads<g-trasym-unimplemented.ads \
-  g-trasym.adb<g-trasym-unimplemented.adb \
   system.ads<system-vxworks-mips.ads
 
   TOOLS_TARGET_PAIRS=\
@@ -1271,9 +1253,7 @@ 
   s-tasinf.ads<s-tasinf-linux.ads \
   s-tasinf.adb<s-tasinf-linux.adb \
   s-taspri.ads<s-taspri-posix-noaltstack.ads \
-  s-tpopsp.adb<s-tpopsp-posix-foreign.adb \
-  g-trasym.ads<g-trasym-unimplemented.ads \
-  g-trasym.adb<g-trasym-unimplemented.adb
+  s-tpopsp.adb<s-tpopsp-posix-foreign.adb
 
   LIBGNAT_TARGET_PAIRS_32 = \
   system.ads<system-linux-s390.ads
@@ -1447,9 +1427,7 @@ 
   s-taspri.ads<s-taspri-posix.ads \
   s-tpopsp.adb<s-tpopsp-rtems.adb \
   s-stchop.adb<s-stchop-rtems.adb \
-  s-interr.adb<s-interr-hwint.adb \
-  g-trasym.ads<g-trasym-unimplemented.ads \
-  g-trasym.adb<g-trasym-unimplemented.adb
+  s-interr.adb<s-interr-hwint.adb
 endif
 
 ifeq ($(strip $(filter-out alpha% dec osf%,$(targ))),)
@@ -1914,8 +1892,6 @@ 
   s-tpopsp.adb<s-tpopsp-tls.adb
 
   LIBGNAT_TARGET_PAIRS_32 = \
-  g-trasym.ads<g-trasym-unimplemented.ads \
-  g-trasym.adb<g-trasym-unimplemented.adb \
   system.ads<system-linux-sparc.ads
 
   LIBGNAT_TARGET_PAIRS_64 = \
@@ -1955,8 +1931,6 @@ 
   s-tasinf.adb<s-tasinf-linux.adb \
   s-taspri.ads<s-taspri-posix-noaltstack.ads \
   s-tpopsp.adb<s-tpopsp-posix-foreign.adb \
-  g-trasym.ads<g-trasym-unimplemented.ads \
-  g-trasym.adb<g-trasym-unimplemented.adb \
   system.ads<system-linux-hppa.ads
 
   TOOLS_TARGET_PAIRS =  \
@@ -2079,8 +2053,6 @@ 
   s-tasinf.adb<s-tasinf-linux.adb \
   s-tpopsp.adb<s-tpopsp-posix-foreign.adb \
   s-taspri.ads<s-taspri-posix-noaltstack.ads \
-  g-trasym.ads<g-trasym-unimplemented.ads \
-  g-trasym.adb<g-trasym-unimplemented.adb \
   system.ads<system-linux-alpha.ads \
   $(ATOMICS_TARGET_PAIRS) \
   $(ATOMICS_BUILTINS_TARGET_PAIRS)
@@ -2144,9 +2116,7 @@ 
     s-osinte.ads<s-osinte-darwin.ads \
     s-taprop.adb<s-taprop-posix.adb \
     s-taspri.ads<s-taspri-posix.ads \
-    s-tpopsp.adb<s-tpopsp-posix-foreign.adb \
-    g-trasym.ads<g-trasym-unimplemented.ads \
-    g-trasym.adb<g-trasym-unimplemented.adb
+    s-tpopsp.adb<s-tpopsp-posix-foreign.adb
   
   ifeq ($(strip $(filter-out %86,$(arch))),)
     LIBGNAT_TARGET_PAIRS += \