mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-31 17:30:24 +02:00
Code Activity

Per-instruction tracing doesn't try to disassemble stack VM code

Browse source 
* module/system/vm/trace.scm (trace-instructions-in-procedure): Don't
  try to disassemble the procedure, for now.
This commit is contained in:
Andy Wingo 2013-11-08 17:32:41 +01:00
parent e391f179e4
commit b77a5215c7
1 changed files with 3 additions and 9 deletions
Download patch file Download diff file Expand all files Collapse all files

12
module/system/vm/trace.scm
View file

@ -23,7 +23,6 @@
#:use-module (system vm vm) #:use-module (system vm vm)
#:use-module (system vm frame) #:use-module (system vm frame)
#:use-module (system vm program) #:use-module (system vm program)
#:use-module (system vm objcode)
#:use-module (system vm traps) #:use-module (system vm traps)
#:use-module (rnrs bytevectors) #:use-module (rnrs bytevectors)
#:use-module (system vm instruction) #:use-module (system vm instruction)
@ -33,9 +32,6 @@
trace-instructions-in-procedure trace-instructions-in-procedure
call-with-trace)) call-with-trace))
;; FIXME: this constant needs to go in system vm objcode
(define *objcode-header-len* 8)
(define (build-prefix prefix depth infix numeric-format max-indent) (define (build-prefix prefix depth infix numeric-format max-indent)
(let lp ((indent "") (n 0)) (let lp ((indent "") (n 0))
(cond (cond
@ -96,11 +92,9 @@
(define* (trace-instructions-in-procedure proc #:key (width 80) (vm (the-vm)) (define* (trace-instructions-in-procedure proc #:key (width 80) (vm (the-vm))
(max-indent (- width 40))) (max-indent (- width 40)))
(define (trace-next frame) (define (trace-next frame)
(let* ((ip (frame-instruction-pointer frame)) ;; FIXME: We could disassemble this instruction here.
(objcode (program-objcode (frame-procedure frame))) (let ((ip (frame-instruction-pointer frame)))
(opcode (bytevector-u8-ref (objcode->bytecode objcode) (format #t "0x~x\n" ip)))
(+ ip *objcode-header-len*))))
(format #t "~8d: ~a\n" ip (opcode->instruction opcode))))
(trap-instructions-in-dynamic-extent proc trace-next (trap-instructions-in-dynamic-extent proc trace-next
#:vm vm)) #:vm vm))