diff options
author | Andy Wingo <wingo@pobox.com> | 2013-05-17 22:10:16 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2013-06-09 23:59:19 +0200 |
commit | c4c098e355bd2edcd3bc66eb7041c5f9cdeefef0 (patch) | |
tree | c1a55d1fc2dbe44b4201e3eaa076561e20d6fa05 /module/system/vm/debug.scm | |
parent | bf8328ec16cbe76b7af9703bb41e964865034561 (diff) | |
download | guile-c4c098e355bd2edcd3bc66eb7041c5f9cdeefef0.tar.gz |
procedure-properties for RTL functions
* module/system/vm/assembler.scm (link-procprops, link-objects): Arrange
to write procedure property links out to a separate section.
* libguile/procprop.c (scm_procedure_properties):
* libguile/programs.h:
* libguile/programs.c (scm_i_rtl_program_properties):
* module/system/vm/debug.scm (find-program-properties): Wire up
procedure-properties for RTL procedures. Yeah! Fistpumps! :)
* module/system/vm/debug.scm (find-program-debug-info): Return #f if the
string is "", as it is if we don't have a name. Perhaps
elf-symbol-name should return #f in that case...
* test-suite/tests/rtl.test: Add some tests.
Diffstat (limited to 'module/system/vm/debug.scm')
-rw-r--r-- | module/system/vm/debug.scm | 45 |
1 files changed, 44 insertions, 1 deletions
diff --git a/module/system/vm/debug.scm b/module/system/vm/debug.scm index cee0892c7..c70f7c5b1 100644 --- a/module/system/vm/debug.scm +++ b/module/system/vm/debug.scm @@ -58,7 +58,9 @@ find-program-arities program-minimum-arity - find-program-docstring)) + find-program-docstring + + find-program-properties)) ;;; A compiled procedure comes from a specific loaded ELF image. A ;;; debug context identifies that image. @@ -364,3 +366,44 @@ section of the ELF image. Returns an ELF symbol, or @code{#f}." (elf-section-link sec))) (idx (bytevector-u32-native-ref bv (+ pos 4)))) (string-table-ref bv (+ (elf-section-offset strtab) idx)))))))))) + +(define* (find-program-properties addr #:optional + (context (find-debug-context addr))) + (define (add-name-and-docstring props) + (define (maybe-acons k v tail) + (if v (acons k v tail) tail)) + (let ((name (and=> (find-program-debug-info addr context) + program-debug-info-name)) + (docstring (find-program-docstring addr context))) + (maybe-acons 'name name + (maybe-acons 'documentation docstring props)))) + (add-name-and-docstring + (cond + ((elf-section-by-name (debug-context-elf context) ".guile.procprops") + => (lambda (sec) + ;; struct procprop { + ;; uint32_t pc; + ;; uint32_t offset; + ;; } + (define procprop-len 8) + (let* ((start (elf-section-offset sec)) + (end (+ start (elf-section-size sec))) + (bv (elf-bytes (debug-context-elf context))) + (text-offset (- addr + (debug-context-text-base context) + (debug-context-base context)))) + (define (unpack-scm addr) + (pointer->scm (make-pointer addr))) + (define (load-non-immediate offset) + (unpack-scm (+ (debug-context-base context) offset))) + ;; FIXME: This is linear search. Change to binary search. + (let lp ((pos start)) + (cond + ((>= pos end) '()) + ((< text-offset (bytevector-u32-native-ref bv pos)) + (lp (+ pos procprop-len))) + ((> text-offset (bytevector-u32-native-ref bv pos)) + '()) + (else + (load-non-immediate + (bytevector-u32-native-ref bv (+ pos 4)))))))))))) |