[Ada] Removing external addr2line depedency
Lutz Donnerhacke
lutz@iks-jena.de
Thu Oct 18 13:21:00 GMT 2001
* Lutz Donnerhacke wrote:
>I'll send the diff when the cvs server reduced the load.
So back at home:
Two parts: First the patch and than a new file.
Index: gcc/ada/g-trasym.ads
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/g-trasym.ads,v
retrieving revision 1.2
diff -u -r1.2 g-trasym.ads
--- g-trasym.ads 2001/10/04 17:50:42 1.2
+++ g-trasym.ads 2001/10/18 18:51:08
@@ -42,9 +42,10 @@
-- is used to build a symbolic traceback.
with Ada.Exceptions; use Ada.Exceptions;
+with Ada.Command_Line;
package GNAT.Traceback.Symbolic is
-pragma Elaborate_Body (Traceback.Symbolic);
+ pragma Elaborate_Body (Traceback.Symbolic);
------------------------
-- Symbolic_Traceback --
@@ -57,4 +58,23 @@
-- Build a string containing a symbolic traceback of the given exception
-- occurrence.
+ -----------------------
+ -- Symbol_at_Address --
+ -----------------------
+ function Symbol_at_Address (
+ addr : System.Address;
+ file : String := Ada.Command_Line.Command_Name;
+ source_sep : String := (1 => ASCII.HT);
+ line_sep : String := ":";
+ incomplete : String := "<unknown>";
+ function_first : Boolean := False
+ ) return String;
+ -- Build a string containing the symbolic name (function, sourcefile,
+ -- and line number) of the code the addr points to in the given file.
+ -- Layout depends on function_first and is either:
+ -- function_name & source_sep & source_file & line_sep & line_number
+ -- or
+ -- source_file & line_sep & line_number & source_sep & function_name
+ -- Incomplete information is substituted by incomplete string. If no
+ -- debug information is available at all, Image(addr) is returned.
end GNAT.Traceback.Symbolic;
Index: gcc/ada/g-trasym.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/g-trasym.adb,v
retrieving revision 1.1
diff -u -r1.1 g-trasym.adb
--- g-trasym.adb 2001/10/02 14:15:35 1.1
+++ g-trasym.adb 2001/10/18 18:51:08
@@ -34,46 +34,31 @@
-- Run-time symbolic traceback support
-with System.Soft_Links;
+with System.Soft_Links, Ada.Finalization;
+with System.Storage_Elements, Ada.Unchecked_Deallocation;
+with Interfaces.C.Strings;
with Ada.Exceptions.Traceback; use Ada.Exceptions.Traceback;
+use System.Storage_Elements, System;
package body GNAT.Traceback.Symbolic is
- pragma Linker_Options ("-laddr2line");
pragma Linker_Options ("-lbfd");
pragma Linker_Options ("-liberty");
package TSL renames System.Soft_Links;
+ package C renames Interfaces.C;
+ package CS renames Interfaces.C.Strings;
------------------------
-- Symbolic_Traceback --
------------------------
function Symbolic_Traceback (Traceback : Tracebacks_Array) return String is
- procedure convert_addresses
- (addrs : System.Address;
- n_addr : Integer;
- buf : System.Address;
- len : System.Address);
- pragma Import (C, convert_addresses, "convert_addresses");
- -- This is the procedure version of the Ada aware addr2line that will
- -- use argv[0] as the executable containing the debug information.
- -- This procedure is provided by libaddr2line on targets that support
- -- it. A dummy version is in a-adaint.c for other targets so that build
- -- of shared libraries doesn't generate unresolved symbols.
- --
- -- Note that this procedure is *not* thread-safe.
-
- Res : String (1 .. 256 * Traceback'Length);
- Len : Integer;
-
begin
if Traceback'Length > 0 then
- TSL.Lock_Task.all;
- convert_addresses
- (Traceback'Address, Traceback'Length, Res (1)'Address, Len'Address);
- TSL.Unlock_Task.all;
- return Res (1 .. Len);
+ return Symbol_at_Address (Traceback (Traceback'First)) & ASCII.LF &
+ Symbolic_Traceback
+ (Traceback (Traceback'First + 1 .. Traceback'Last));
else
return "";
end if;
@@ -84,4 +69,223 @@
return Symbolic_Traceback (Tracebacks (E));
end Symbolic_Traceback;
+ -----------------------------------------------------------------------
+ -- Reimplementation of the former addr2line function by calling libbfd
+ -- directly. Unfortunly several values are located in bfd.h only, not
+ -- importable from libbfd. Especially the redirect macro BFD_SEND can
+ -- not catched by Ada. Futhermore needed enums are common subjects of
+ -- change, so hardcoding the values causes more problems. OTOH coding
+ -- everything in C may cause memory leaks if not all finalizations are
+ -- exported to C, too. That's why dynamic memory should be handled by
+ -- Ada only. In consequence only a small C-helper object was written.
+ -----------------------------------------------------------------------
+ type Bfd_Pointer is new System.Address;
+ No_Bfd : constant Bfd_Pointer := Bfd_Pointer (Null_Address);
+
+ type Storage_Pointer is access Storage_Array;
+
+ type Bfd_Data (file_len : Positive) is
+ new Ada.Finalization.Limited_Controlled with record
+ bfd : Bfd_Pointer := No_Bfd;
+ syms : Storage_Pointer := null;
+ file : String (Positive'First .. file_len);
+ end record;
+ procedure Initialize (bfd : in out Bfd_Data);
+ procedure Finalize (bfd : in out Bfd_Data);
+
+ type Bfd_Access is access Bfd_Data;
+
+ procedure Finalize (bfd : in out Bfd_Data) is
+ -- Frees a bfd structure. Closes the open filedescriptor, too.
+ -- Returns true if everything was fine. (Ignored in this case.)
+ function bfd_close (bfd : Bfd_Pointer) return Boolean;
+ pragma Import (C, bfd_close, "bfd_close");
+
+ procedure free is
+ new Ada.Unchecked_Deallocation (Storage_Array, Storage_Pointer);
+ dummy : Boolean;
+ begin
+ if bfd.syms /= null then
+ free (bfd.syms);
+ bfd.syms := null;
+ end if;
+ if bfd.bfd /= No_Bfd then
+ dummy := bfd_close (bfd.bfd);
+ bfd.bfd := No_Bfd;
+ end if;
+ end Finalize;
+
+ -- A global variable enshured that libbfd is only initialized once.
+ bfd_initialized : Boolean := False;
+
+ procedure Initialize (bfd : in out Bfd_Data) is
+ -- initialize libbfd. Must be called first.
+ procedure bfd_init;
+ pragma Import (C, bfd_init, "bfd_init");
+
+ -- Open filename for reading debug information.
+ -- knowntargetname can be Null_Address, if target is unknown.
+ -- Returns a freshly malloced bfd structure.
+ function bfd_openr
+ (filename : C.char_array; knowntargetname : CS.chars_ptr)
+ return Bfd_Pointer;
+ pragma Import (C, bfd_openr, "bfd_openr");
+
+ -- Binaries are considered as archives. Imported from the helper file.
+ bfd_archive : Integer;
+ pragma Import (C, bfd_archive, "__gnat_bfd_archive");
+
+ -- Fill the bfd structure according to the chosen target.
+ -- Returns true if the format could be unabigiously determined.
+ function bfd_check_format
+ (bfd : Bfd_Pointer; format : Integer := bfd_archive)
+ return Boolean;
+ pragma Import (C, bfd_check_format, "bfd_check_format");
+
+ -- returns the estimated size of the symol table. FIXME: negative?
+ function bfd_get_symtab_upper_bound (bfd : Bfd_Pointer)
+ return Storage_Offset;
+ pragma Import (C, bfd_get_symtab_upper_bound,
+ "bfd_get_symtab_upper_bound");
+
+ -- Reads the symbols in the provided table and returns the symbol count.
+ -- Providing syms as a Storage_Array instead of Storage_Pointer enshures
+ -- correct calling convention to C.
+ function bfd_canonicalize_symtab
+ (bfd : Bfd_Pointer; syms : Storage_Array) return Integer;
+ pragma Import (C, bfd_canonicalize_symtab, "bfd_canonicalize_symtab");
+ begin
+ if not bfd_initialized then
+ bfd_init;
+ bfd_initialized := True;
+ end if;
+
+ bfd.bfd := bfd_openr (C.To_C (bfd.file), CS.Null_Ptr);
+ if bfd.bfd /= No_Bfd or else not bfd_check_format (bfd.bfd) then
+ Finalize (bfd);
+ end if;
+
+ if bfd.bfd /= No_Bfd then
+ bfd.syms :=
+ new Storage_Array (1 .. bfd_get_symtab_upper_bound (bfd.bfd));
+ if bfd.syms'Length = 0
+ or else bfd_canonicalize_symtab (bfd.bfd, bfd.syms.all) <= 0 then
+ Finalize (bfd);
+ end if;
+ end if;
+ end Initialize;
+
+ -----------------------------------------------------------------------
+ -- Locking requires unlock after exit. In functions returning limited
+ -- or unconstraint data it is hard to determine the data first and re-
+ -- turn it after unlocking. Futhermore exception handling requires an
+ -- intelligent programming in order to catch all possible cases. This
+ -- controlled type solves this problem in a real Ada manner.
+ -----------------------------------------------------------------------
+ type Lock_Task_Automatically is
+ new Ada.Finalization.Limited_Controlled with null record;
+ procedure Initialize (l : in out Lock_Task_Automatically);
+ procedure Finalize (l : in out Lock_Task_Automatically);
+
+ procedure Initialize (l : in out Lock_Task_Automatically) is
+ begin
+ TSL.Lock_Task.all;
+ end Initialize;
+
+ procedure Finalize (l : in out Lock_Task_Automatically) is
+ begin
+ TSL.Unlock_Task.all;
+ end Finalize;
+
+ -----------------------------------------------------------------------
+ -- Returns a string describing the source code information at addr. If
+ -- debug information is not available, addr is returned literally. The
+ -- routine requires the global variable current_bfd, in order to limit
+ -- the bfd instantiation to only necessary cases.
+ -----------------------------------------------------------------------
+ current_bfd : Bfd_Access := null;
+
+ function Symbol_at_Address (
+ addr : System.Address;
+ file : String := Ada.Command_Line.Command_Name;
+ source_sep : String := (1 => ASCII.HT);
+ line_sep : String := ":";
+ incomplete : String := "<unknown>";
+ function_first : Boolean := False
+ ) return String is
+ -- Passive iterator from libbfd. data is a pointer to extern status
+ -- data passed to the action function on each invocation.
+ procedure bfd_map_over_sections (bdf : Bfd_Pointer;
+ action : System.Address; data : System.Address);
+ pragma Import (C, bfd_map_over_sections, "bfd_map_over_sections");
+
+ function_name, source_file, line_number : CS.chars_ptr := CS.Null_Ptr;
+ use type CS.chars_ptr;
+
+ function get (p : CS.chars_ptr) return String;
+ function bfd_get_section_vma
+ (section : System.Address) return System.Address;
+ pragma Import (C, bfd_get_section_vma,
+ "__gnat_bfd_get_section_vma");
+ function bfd_section_size
+ (bfd : Bfd_Pointer; section : System.Address) return Storage_Offset;
+ pragma Import (C, bfd_section_size, "__gnat_bfd_section_size");
+
+ function bfd_find_nearest_line (bfd : Bfd_Pointer;
+ section : System.Address; syms : Storage_Array; offs : Storage_Offset;
+ func_name, file_name, line_num : System.Address) return Boolean;
+ pragma Import (C, bfd_find_nearest_line, "bfd_find_nearest_line");
+
+ procedure For_Each_Section (bfd : Bfd_Pointer;
+ section : System.Address; data : System.Address);
+
+ function get (p : CS.chars_ptr) return String is
+ begin
+ if p = CS.Null_Ptr then
+ return incomplete;
+ else
+ return CS.Value (p);
+ end if;
+ end get;
+
+ procedure For_Each_Section (bfd : Bfd_Pointer;
+ section : System.Address; data : System.Address) is
+ min : System.Address := bfd_get_section_vma (section);
+ len : Storage_Offset := bfd_section_size (bfd, section);
+ begin
+ if source_file = CS.Null_Ptr and then
+ function_name = CS.Null_Ptr and then
+ data >= min and then data <= min + len and then
+ not bfd_find_nearest_line (bfd, section, current_bfd.syms.all,
+ addr - min, function_name'Address,
+ source_file'Address, line_number'Address) then
+ function_name := CS.Null_Ptr;
+ source_file := CS.Null_Ptr;
+ line_number := CS.Null_Ptr;
+ end if;
+ end For_Each_Section;
+
+ lock : Lock_Task_Automatically;
+ pragma Warnings (Off, lock); -- suppress unreferenced warning
+ begin
+ if current_bfd = null then
+ current_bfd := new Bfd_Data (file'Length);
+ current_bfd.file := file;
+ end if;
+
+ if current_bfd.bfd /= No_Bfd then
+ bfd_map_over_sections (current_bfd.bfd,
+ For_Each_Section'Address, addr);
+ if source_file /= CS.Null_Ptr or function_name /= CS.Null_Ptr then
+ if function_first then
+ return get (function_name) & source_sep &
+ get (source_file) & line_sep & get (line_number);
+ else
+ return get (source_file) & line_sep & get (line_number) &
+ source_sep & get (function_name);
+ end if;
+ end if;
+ end if;
+ return Integer_Address'Image (To_Integer (addr));
+ end Symbol_at_Address;
end GNAT.Traceback.Symbolic;
Index: gcc/ada/Makefile.in
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/Makefile.in,v
retrieving revision 1.3
diff -u -r1.3 Makefile.in
--- Makefile.in 2001/10/08 23:46:22 1.3
+++ Makefile.in 2001/10/18 18:51:12
@@ -1077,7 +1077,7 @@
system.ads<5ssystem.ads
THREADSLIB=-lposix4 -lthread
- MISCLIB=-laddr2line -lbfd -lposix4 -lnsl -lsocket
+ MISCLIB=-lbfd -lposix4 -lnsl -lsocket
SO_OPTS=-Wl,-h,
GNATLIB_SHARED=gnatlib-shared-dual
GMEM_LIB=gmemlib
@@ -1170,7 +1170,7 @@
system.ads<5lsystem.ads
MLIB_TGT=5lml-tgt
- MISCLIB=-laddr2line -lbfd
+ MISCLIB=-lbfd
THREADSLIB=-lpthread
GNATLIB_SHARED=gnatlib-shared-dual
GMEM_LIB=gmemlib
@@ -1262,7 +1262,7 @@
endif
EXTRA_GNATRTL_TASKING_OBJS=s-tpgetc.o a-tcbinf.o
- MISCLIB=-lexc -laddr2line -lbfd
+ MISCLIB=-lexc -lbfd
SO_OPTS=-Wl,-all,-set_version,sgi1.0,-update_registry,../so_locations,-soname,
LIBRARY_VERSION := $(strip $(shell grep Library_Version $(fsrcpfx)gnatvsn.ads | sed -e 's/.*GNAT Lib v\(.*\)[ "].*/\1/'))
@@ -1447,7 +1447,7 @@
g-soccon.ads<3asoccon.ads \
system.ads<5asystem.ads
- MISCLIB=-laddr2line -lbfd
+ MISCLIB=-lbfd
THREADSLIB=-lpthread -lmach -lexc -lrt
LIBRARY_VERSION := $(strip $(shell grep Library_Version $(fsrcpfx)gnatvsn.ads | sed -e 's/.*GNAT Lib v\(.*\)[ "].*/\1/'))
endif
@@ -1488,7 +1488,7 @@
g-soliop.ads<3wsoliop.ads \
system.ads<5wsystem.ads
- MISCLIB = -laddr2line -lbfd -lwsock32
+ MISCLIB =-lbfd -lwsock32
GMEM_LIB=gmemlib
EXTRA_GNATTOOLS = ../gnatdll$(exeext)
EXTRA_GNATRTL_NONTASKING_OBJS = g-regist.o
@@ -1510,11 +1510,11 @@
LIBGNAT_SRCS = ada.h adaint.c adaint.h argv.c cio.c cstreams.c \
errno.c exit.c cal.c \
raise.h raise.c sysdep.c types.h io-aux.c init.c \
- final.c tracebak.c expect.c $(EXTRA_LIBGNAT_SRCS)
+ final.c tracebak.c tracesym.c expect.c $(EXTRA_LIBGNAT_SRCS)
LIBGNAT_OBJS = adaint.o argv.o cio.o cstreams.o errno.o exit.o \
raise.o sysdep.o io-aux.o init.o cal.o final.o \
- tracebak.o expect.o ../../prefix.o $(EXTRA_LIBGNAT_OBJS)
+ tracebak.o tracesym.o expect.o ../../prefix.o $(EXTRA_LIBGNAT_OBJS)
# NOTE ??? - when the -I option for compiling Ada code is made to work,
# the library installation will change and there will be a
@@ -1882,6 +1882,7 @@
s-wwdenu.o \
s-wwdwch.o \
system.o \
+ tracesym.o \
text_io.o $(EXTRA_GNATRTL_NONTASKING_OBJS)
GNATRTL_OBJS = $(GNATRTL_NONTASKING_OBJS) $(GNATRTL_TASKING_OBJS)
@@ -2539,18 +2540,19 @@
$(CC) -c $(ALL_CFLAGS) $(ADA_CFLAGS) \
$(ALL_CPPFLAGS) $(INCLUDES) -fno-omit-frame-pointer $<
-expect.o : expect.c
-io-aux.o : io-aux.c
-argv.o : argv.c
-cal.o : cal.c
-cio.o : cio.c
+tracesym.o : tracesym.c
+expect.o : expect.c
+io-aux.o : io-aux.c
+argv.o : argv.c
+cal.o : cal.c
+cio.o : cio.c
$(CC) -c $(ALL_CFLAGS) $(ADA_CFLAGS) $(RT_FLAGS) \
$(ALL_CPPFLAGS) $(INCLUDES) $<
deftarg.o : deftarg.c
-errno.o : errno.c
-exit.o : raise.h exit.c
-final.o : raise.h final.c
-gmem.o : gmem.c
+errno.o : errno.c
+exit.o : raise.h exit.c
+final.o : raise.h final.c
+gmem.o : gmem.c
raise.o : raise.c raise.h
$(CC) -c $(ALL_CFLAGS) $(ADA_CFLAGS) $(RT_FLAGS) \
Index: gcc/ada/tracesym.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/tracesym.c
add tracesym.c
+++ tracesym.c 2001/10/18 18:51:12
+/****************************************************************************
+ * *
+ * GNAT COMPILER COMPONENTS *
+ * *
+ * T R A C E B A C K . S Y M B O L I C *
+ * *
+ * C Implementation File *
+ * *
+ * $Revision: 1.0 $
+ * *
+ * Copyright (C) 2001 Lutz Donnerhacke *
+ * *
+ * 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 2, 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. See the GNU General Public License *
+ * for more details. You should have received a copy of the GNU General *
+ * Public License distributed with GNAT; see 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 you link this file with other files to *
+ * produce an executable, this file does not by itself cause the resulting *
+ * executable to be covered by the GNU General Public License. This except- *
+ * ion does not however invalidate any other reasons why the executable *
+ * file might be covered by the GNU Public License. *
+ * *
+ * GNAT was originally developed by the GNAT team at New York University. *
+ * It is now maintained by Ada Core Technologies Inc ( http://www.gnat.com ). *
+ * *
+ ****************************************************************************/
+
+/* This file contains low level support for cpp dependent libbfd bindings */
+
+#define CONST const
+#include <bfd.h>
+
+const int __gnat_bfd_archive = bfd_archive;
+
+bfd_vma __gnat_bfd_get_section_vma (bfd * abfd, sec_ptr asection) {
+ return bfd_get_section_vma (abfd, asection);
+}
+
+long __gnat_bfd_section_size (bfd * abfd, sec_ptr asection) {
+ return bfd_section_size (abfd, asection);
+}
More information about the Gcc-patches
mailing list