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.

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)

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)
+(define (debug-context-from-image bv)
-  "Find and return the debugging context corresponding to the ELF image
+  "Build a debugging context corresponding to a given ELF image."
-containing the address @var{addr}.  @var{addr} is an integer."
+  (let* ((elf (parse-elf bv))
-  (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-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

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