--- /dev/null
+;;; 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)))
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))
(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)))))
(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))
HCoop / bpt / guile.git / commitdiff