1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-16 00:30:21 +02:00

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.
This commit is contained in:
Andy Wingo 2013-08-29 20:43:03 +02:00
parent c96933fd54
commit 610295ec9d
3 changed files with 55 additions and 9 deletions

View file

@ -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))