summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--module/scripts/disassemble.scm10
-rw-r--r--module/system/vm/debug.scm29
-rw-r--r--module/system/vm/disassembler.scm25
3 files changed, 55 insertions, 9 deletions
diff --git a/module/scripts/disassemble.scm b/module/scripts/disassemble.scm
index 094d65654..3825bc118 100644
--- a/module/scripts/disassemble.scm
+++ b/module/scripts/disassemble.scm
@@ -1,6 +1,6 @@
;;; Disassemble --- Disassemble .go files into something human-readable
-;; Copyright 2005, 2008, 2009, 2011, 2012 Free Software Foundation, Inc.
+;; Copyright 2005, 2008, 2009, 2011, 2012, 2013 Free Software Foundation, Inc.
;;
;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU Lesser General Public License
@@ -22,12 +22,14 @@
;;; Commentary:
-;; Usage: disassemble [ARGS]
+;; Usage: disassemble FILE...
;;; Code:
(define-module (scripts disassemble)
#:use-module (system vm objcode)
+ #:use-module (system vm program)
+ #:use-module (system vm disassembler)
#:use-module ((language assembly disassemble)
#:renamer (symbol-prefix-proc 'asm:))
#:export (disassemble))
@@ -36,7 +38,9 @@
(define (disassemble . files)
(for-each (lambda (file)
- (asm:disassemble (load-thunk-from-file file)))
+ (let* ((thunk (load-thunk-from-file file))
+ (elf (find-mapped-elf-image (rtl-program-code thunk))))
+ (disassemble-image elf)))
files))
(define main disassemble)
diff --git a/module/system/vm/debug.scm b/module/system/vm/debug.scm
index 0e97df566..2289ec3bc 100644
--- a/module/system/vm/debug.scm
+++ b/module/system/vm/debug.scm
@@ -33,6 +33,7 @@
#:use-module (srfi srfi-9)
#:export (debug-context-image
debug-context-base
+ debug-context-text-base
program-debug-info-name
program-debug-info-context
@@ -52,6 +53,8 @@
arity-has-keyword-args?
arity-is-case-lambda?
+ debug-context-from-image
+ for-each-elf-symbol
find-debug-context
find-program-debug-info
arity-arguments-alist
@@ -79,6 +82,19 @@
@var{context}."
(elf-bytes (debug-context-elf context)))
+(define (for-each-elf-symbol context proc)
+ "Call @var{proc} on each symbol in the symbol table of @var{context}."
+ (let ((elf (debug-context-elf context)))
+ (cond
+ ((elf-section-by-name elf ".symtab")
+ => (lambda (symtab)
+ (let ((len (elf-symbol-table-len symtab))
+ (strtab (elf-section elf (elf-section-link symtab))))
+ (let lp ((n 0))
+ (when (< n len)
+ (proc (elf-symbol-table-ref elf symtab n strtab))
+ (lp (1+ n))))))))))
+
;;; A program debug info (PDI) is a handle on debugging meta-data for a
;;; particular program.
;;;
@@ -117,17 +133,20 @@ offset from the beginning of the ELF image in 32-bit units."
(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))
+(define (debug-context-from-image bv)
+ "Build a debugging context corresponding to a given ELF image."
+ (let* ((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-debug-context addr)
+ "Find and return the debugging context corresponding to the ELF image
+containing the address @var{addr}. @var{addr} is an integer."
+ (debug-context-from-image (find-mapped-elf-image addr)))
+
(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
diff --git a/module/system/vm/disassembler.scm b/module/system/vm/disassembler.scm
index 138f267d9..482d68f36 100644
--- a/module/system/vm/disassembler.scm
+++ b/module/system/vm/disassembler.scm
@@ -31,7 +31,8 @@
#:use-module (ice-9 vlist)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-4)
- #:export (disassemble-program))
+ #:export (disassemble-program
+ disassemble-image))
(define-syntax-rule (u32-ref buf n)
(bytevector-u32-native-ref buf (* n 4)))
@@ -334,3 +335,25 @@ address of that offset."
(else
(format port "Debugging information unavailable.~%")))
(values))
+
+(define* (disassemble-image bv #:optional (port (current-output-port)))
+ (let* ((ctx (debug-context-from-image bv))
+ (base (debug-context-text-base ctx)))
+ (for-each-elf-symbol
+ ctx
+ (lambda (sym)
+ (let ((name (elf-symbol-name sym))
+ (value (elf-symbol-value sym))
+ (size (elf-symbol-size sym)))
+ (format port "Disassembly of ~A at #x~X:\n\n"
+ (if (and (string? name) (not (string-null? name)))
+ name
+ "<unnamed function>")
+ (+ base value))
+ (disassemble-buffer port
+ bv
+ (/ (+ base value) 4)
+ (/ (+ base value size) 4)
+ ctx)
+ (display "\n\n" port)))))
+ (values))