summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2014-04-16 12:58:35 +0200
committerAndy Wingo <wingo@pobox.com>2014-04-16 12:58:35 +0200
commitbc5bcf66375690a2a744a8f14dab37194519101c (patch)
tree34a3905ce1c01b54204169661954d380f0c8a89e
parent20d7d68284613d8040cdaa5c8d93d80e6fa1e068 (diff)
downloadguile-bc5bcf66375690a2a744a8f14dab37194519101c.tar.gz
Add arity-code
* module/system/vm/debug.scm (arity-code): New interface.
-rw-r--r--module/system/vm/debug.scm12
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))