diff options
author | Andy Wingo <wingo@pobox.com> | 2014-04-16 12:58:35 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2014-04-16 12:58:35 +0200 |
commit | bc5bcf66375690a2a744a8f14dab37194519101c (patch) | |
tree | 34a3905ce1c01b54204169661954d380f0c8a89e | |
parent | 20d7d68284613d8040cdaa5c8d93d80e6fa1e068 (diff) | |
download | guile-bc5bcf66375690a2a744a8f14dab37194519101c.tar.gz |
Add arity-code
* module/system/vm/debug.scm (arity-code): New interface.
-rw-r--r-- | module/system/vm/debug.scm | 12 |
1 files changed, 12 insertions, 0 deletions
diff --git a/module/system/vm/debug.scm b/module/system/vm/debug.scm index ccd0a8d7a..97c3d99fb 100644 --- a/module/system/vm/debug.scm +++ b/module/system/vm/debug.scm @@ -59,6 +59,7 @@ arity-keyword-args arity-is-case-lambda? arity-definitions + arity-code debug-context-from-image fold-all-debug-contexts @@ -400,6 +401,17 @@ section of the ELF image. Returns an ELF symbol, or @code{#f}." (error "invalid request for definitions of case-lambda wrapper arity")) (load-symbols link))) +(define (arity-code arity) + (let* ((ctx (arity-context arity)) + (bv (elf-bytes (debug-context-elf ctx))) + (header (arity-header-offset arity)) + (base-addr (+ (debug-context-base ctx) (debug-context-text-base ctx))) + (low-pc (+ base-addr (arity-low-pc* bv header))) + (high-pc (+ base-addr (arity-high-pc* bv header)))) + ;; FIXME: We should be able to use a sub-bytevector operation here; + ;; it would be safer. + (pointer->bytevector (make-pointer low-pc) (- high-pc low-pc)))) + (define* (arity-locals arity #:optional nlocals) (let* ((bv (elf-bytes (debug-context-elf (arity-context arity)))) (load-symbol (arity-load-symbol arity)) |