diff options
author | Andy Wingo <wingo@pobox.com> | 2013-10-04 15:28:40 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2013-10-04 15:28:40 +0200 |
commit | e9588e7032ced422014fb29bfaa6dbb7c2582b12 (patch) | |
tree | 2235bc0fbc3487243e667d0c239aab0331ff3c02 /module/system/vm/disassembler.scm | |
parent | e0230913e9bb1e54576ef7b9347c786ede99f733 (diff) | |
download | guile-e9588e7032ced422014fb29bfaa6dbb7c2582b12.tar.gz |
Disassembling RTL prints source information.
* module/system/vm/disassembler.scm (disassemble-buffer): Print source
information.
Diffstat (limited to 'module/system/vm/disassembler.scm')
-rw-r--r-- | module/system/vm/disassembler.scm | 22 |
1 files changed, 20 insertions, 2 deletions
diff --git a/module/system/vm/disassembler.scm b/module/system/vm/disassembler.scm index ad7bb2b76..4917743db 100644 --- a/module/system/vm/disassembler.scm +++ b/module/system/vm/disassembler.scm @@ -311,15 +311,33 @@ address of that offset." addr info extra src)) (define (disassemble-buffer port bv start end context) - (let ((labels (compute-labels bv start end))) + (let ((labels (compute-labels bv start end)) + (sources (find-program-sources (u32-offset->addr start context) + context))) + (define (lookup-source addr) + (let lp ((sources sources)) + (match sources + (() #f) + ((source . sources) + (let ((pc (source-pre-pc source))) + (cond + ((< pc addr) (lp sources)) + ((= pc addr) + (format #f "~a:~a:~a" + (source-file source) + (source-line-for-user source) + (source-column source))) + (else #f))))))) (let lp ((offset start)) (when (< offset end) (call-with-values (lambda () (disassemble-one bv offset)) (lambda (len elt) (let ((pos (- offset start)) + (addr (u32-offset->addr offset context)) (annotation (code-annotation elt len offset start labels context))) - (print-info port pos (vector-ref labels pos) elt annotation #f) + (print-info port pos (vector-ref labels pos) elt annotation + (lookup-source addr)) (lp (+ offset len))))))))) (define* (disassemble-program program #:optional (port (current-output-port))) |