diff options
author | Andy Wingo <wingo@pobox.com> | 2013-05-01 22:17:51 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2013-06-09 19:50:30 +0200 |
commit | cb86cbd71db17273f6dfdfdecae450515cbdfc12 (patch) | |
tree | bd93c0c3c464b2f51e0b2d118c674e132a191fcb | |
parent | e78991aa36922575d26842eb670d1b09a44bd534 (diff) | |
download | guile-cb86cbd71db17273f6dfdfdecae450515cbdfc12.tar.gz |
Add runtime support for reading debug information from ELF
* module/Makefile.am:
* module/system/vm/debug.scm: New module.
* module/system/vm/elf.scm (elf-section-by-name): New helper.
(elf-symbol-table-len): New helper.
* test-suite/tests/rtl.test: Add test for finding debug info.
-rw-r--r-- | module/Makefile.am | 1 | ||||
-rw-r--r-- | module/system/vm/debug.scm | 160 | ||||
-rw-r--r-- | module/system/vm/elf.scm | 22 | ||||
-rw-r--r-- | test-suite/tests/rtl.test | 23 |
4 files changed, 203 insertions, 3 deletions
diff --git a/module/Makefile.am b/module/Makefile.am index d6450be99..74a962138 100644 --- a/module/Makefile.am +++ b/module/Makefile.am @@ -357,6 +357,7 @@ SYSTEM_SOURCES = \ system/vm/traps.scm \ system/vm/trap-state.scm \ system/vm/assembler.scm \ + system/vm/debug.scm \ system/vm/vm.scm \ system/foreign.scm \ system/xref.scm \ diff --git a/module/system/vm/debug.scm b/module/system/vm/debug.scm new file mode 100644 index 000000000..100207e26 --- /dev/null +++ b/module/system/vm/debug.scm @@ -0,0 +1,160 @@ +;;; Guile runtime debug information + +;;; Copyright (C) 2013 Free Software Foundation, Inc. +;;; +;;; This library is free software; you can redistribute it and/or +;;; modify it under the terms of the GNU Lesser General Public +;;; License as published by the Free Software Foundation; either +;;; version 3 of the License, or (at your option) any later version. +;;; +;;; This library 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 +;;; Lesser General Public License for more details. +;;; +;;; You should have received a copy of the GNU Lesser General Public +;;; License along with this library; if not, write to the Free Software +;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + +;;; Commentary: +;;; +;;; Guile's RTL compiler and linker serialize debugging information into +;;; separate sections of the ELF image. This module reads those +;;; sections. +;;; +;;; Code: + +(define-module (system vm debug) + #:use-module (system vm elf) + #:use-module (system vm objcode) + #:use-module (system foreign) + #:use-module (rnrs bytevectors) + #:use-module (ice-9 match) + #:use-module (srfi srfi-9) + #:export (debug-context-image + + program-debug-info-name + program-debug-info-context + program-debug-info-image + program-debug-info-offset + program-debug-info-addr + program-debug-info-u32-offset + program-debug-info-u32-offset-end + + find-debug-context + find-program-debug-info)) + +;;; A compiled procedure comes from a specific loaded ELF image. A +;;; debug context identifies that image. +;;; +(define-record-type <debug-context> + (make-debug-context elf base text-base) + debug-context? + (elf debug-context-elf) + ;; Address at which this image is loaded in memory, in bytes. + (base debug-context-base) + ;; Offset of the text section relative to the image start, in bytes. + (text-base debug-context-text-base)) + +(define (debug-context-image context) + "Return the bytevector aliasing the mapped ELF image corresponding to +@var{context}." + (elf-bytes (debug-context-elf context))) + +;;; A program debug info (PDI) is a handle on debugging meta-data for a +;;; particular program. +;;; +(define-record-type <program-debug-info> + (make-program-debug-info context name offset size) + program-debug-info? + (context program-debug-info-context) + (name program-debug-info-name) + ;; Offset of the procedure in the text section, in bytes. + (offset program-debug-info-offset) + (size program-debug-info-size)) + +(define (program-debug-info-addr pdi) + "Return the address in memory of the entry of the program represented +by the debugging info @var{pdi}." + (+ (program-debug-info-offset pdi) + (debug-context-text-base (program-debug-info-context pdi)) + (debug-context-base (program-debug-info-context pdi)))) + +(define (program-debug-info-image pdi) + "Return the ELF image containing @var{pdi}, as a bytevector." + (debug-context-image (program-debug-info-context pdi))) + +(define (program-debug-info-u32-offset pdi) + "Return the start address of the program represented by @var{pdi}, as +an offset from the beginning of the ELF image in 32-bit units." + (/ (+ (program-debug-info-offset pdi) + (debug-context-text-base (program-debug-info-context pdi))) + 4)) + +(define (program-debug-info-u32-offset-end pdi) + "Return the end address of the program represented by @var{pdi}, as an +offset from the beginning of the ELF image in 32-bit units." + (/ (+ (program-debug-info-size pdi) + (program-debug-info-offset pdi) + (debug-context-text-base (program-debug-info-context pdi))) + 4)) + +(define (find-debug-context addr) + "Find and return the debugging context corresponding to the ELF image +containing the address @var{addr}. @var{addr} is an integer." + (let* ((bv (find-mapped-elf-image addr)) + (elf (parse-elf bv)) + (base (pointer-address (bytevector->pointer (elf-bytes elf)))) + (text-base (elf-section-offset + (or (elf-section-by-name elf ".rtl-text") + (error "ELF object has no text section"))))) + (make-debug-context elf base text-base))) + +(define (find-elf-symbol elf text-offset) + "Search the symbol table of @var{elf} for the ELF symbol containing +@var{text-offset}. @var{text-offset} is a byte offset in the text +section of the ELF image. Returns an ELF symbol, or @code{#f}." + (and=> + (elf-section-by-name elf ".symtab") + (lambda (symtab) + (let ((len (elf-symbol-table-len symtab)) + (strtab (elf-section elf (elf-section-link symtab)))) + ;; The symbols should be sorted, but maybe somehow that fails + ;; (for example if multiple objects are relinked together). So, + ;; a modicum of tolerance. + (define (bisect) + ;; FIXME: Implement. + #f) + (define (linear-search) + (let lp ((n 0)) + (and (< n len) + (let ((sym (elf-symbol-table-ref elf symtab n strtab))) + (if (and (<= (elf-symbol-value sym) text-offset) + (< text-offset (+ (elf-symbol-value sym) + (elf-symbol-size sym)))) + sym + (lp (1+ n))))))) + (or (bisect) (linear-search)))))) + +(define* (find-program-debug-info addr #:optional + (context (find-debug-context addr))) + "Find and return the @code{<program-debug-info>} containing +@var{addr}, or @code{#f}." + (cond + ((find-elf-symbol (debug-context-elf context) + (- addr + (debug-context-base context) + (debug-context-text-base context))) + => (lambda (sym) + (make-program-debug-info context + (and=> (elf-symbol-name sym) + ;; The name might be #f if + ;; the string table was + ;; stripped somehow. + (lambda (x) + (and (string? x) + (not (string-null? x)) + (string->symbol x)))) + (elf-symbol-value sym) + (elf-symbol-size sym)))) + (else #f))) diff --git a/module/system/vm/elf.scm b/module/system/vm/elf.scm index 2f4dee66c..516745913 100644 --- a/module/system/vm/elf.scm +++ b/module/system/vm/elf.scm @@ -123,8 +123,8 @@ parse-elf elf-segment elf-segments - elf-section elf-sections elf-sections-by-name - elf-symbol-table-ref + elf-section elf-sections elf-section-by-name elf-sections-by-name + elf-symbol-table-len elf-symbol-table-ref parse-elf-note elf-note-name elf-note-desc elf-note-type)) @@ -796,6 +796,17 @@ (utf8->string out)) (lp (1+ end))))) +(define (elf-section-by-name elf name) + (let ((off (elf-section-offset (elf-section elf (elf-shstrndx elf))))) + (let lp ((n (elf-shnum elf))) + (and (> n 0) + (let ((section (elf-section elf (1- n)))) + (if (equal? (string-table-ref (elf-bytes elf) + (+ off (elf-section-name section))) + name) + section + (lp (1- n)))))))) + (define (elf-sections-by-name elf) (let* ((sections (elf-sections elf)) (off (elf-section-offset (list-ref sections (elf-shstrndx elf))))) @@ -895,6 +906,13 @@ (else (error "invalid word size" word-size))) bv offset byte-order sym)) +(define (elf-symbol-table-len section) + (let ((len (elf-section-size section)) + (entsize (elf-section-entsize section))) + (unless (and (not (zero? entsize)) (zero? (modulo len entsize))) + (error "bad symbol table" section)) + (/ len entsize))) + (define* (elf-symbol-table-ref elf section n #:optional strtab) (let ((bv (elf-bytes elf)) (byte-order (elf-byte-order elf)) diff --git a/test-suite/tests/rtl.test b/test-suite/tests/rtl.test index 74a7ff334..d3923b450 100644 --- a/test-suite/tests/rtl.test +++ b/test-suite/tests/rtl.test @@ -18,7 +18,9 @@ (define-module (tests rtl) #:use-module (test-suite lib) - #:use-module (system vm assembler)) + #:use-module (system vm assembler) + #:use-module (system vm program) + #:use-module (system vm debug)) (define-syntax-rule (assert-equal val expr) (let ((x val)) @@ -247,3 +249,22 @@ (end-program))))) ((make-top-incrementor)) *top-val*)))) + +(with-test-prefix "debug contexts" + (let ((return-3 (assemble-program + '((begin-program return-3) + (assert-nargs-ee/locals 0 1) + (load-constant 0 3) + (return 0) + (end-program))))) + (pass-if "program name" + (and=> (find-program-debug-info (rtl-program-code return-3)) + (lambda (pdi) + (equal? (program-debug-info-name pdi) + 'return-3)))) + + (pass-if "program address" + (and=> (find-program-debug-info (rtl-program-code return-3)) + (lambda (pdi) + (equal? (program-debug-info-addr pdi) + (rtl-program-code return-3))))))) |