diff options
author | Andy Wingo <wingo@pobox.com> | 2013-08-29 20:43:03 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2013-08-29 20:44:55 +0200 |
commit | 610295ec9dbf3c21a59b4e579d0889ca90c499e6 (patch) | |
tree | 245b72298916e45f716ee8d76e28b0b5e3d70b32 | |
parent | c96933fd544aaf14776a1fc3a2986afc6fecb00c (diff) | |
download | guile-610295ec9dbf3c21a59b4e579d0889ca90c499e6.tar.gz |
add ability to disassemble ELF images
* module/scripts/disassemble.scm (disassemble): Update to work with
RTl (and only RTL, as that's the future).
* module/system/vm/debug.scm (for-each-elf-symbol): New public
interface.
(debug-context-from-image): New helper.
(find-debug-context): Use the helper.
* module/system/vm/disassembler.scm (disassemble-image): New public
interface.
-rw-r--r-- | module/scripts/disassemble.scm | 10 | ||||
-rw-r--r-- | module/system/vm/debug.scm | 29 | ||||
-rw-r--r-- | module/system/vm/disassembler.scm | 25 |
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)) |