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

simplify disassembly annotations a bit

Browse source 
* module/system/vm/disasm.scm (original-value): Simplify a bit to
  normally dispatch on the instruction, only trying code->object at the
  end.
This commit is contained in:
Andy Wingo 2008-10-11 18:55:44 +02:00
parent 972c33e592
commit 95b6ad34c3
1 changed files with 17 additions and 25 deletions
Download patch file Download diff file Expand all files Collapse all files

42
module/system/vm/disasm.scm
View file

@ -157,31 +157,23 @@
(newline)))) (newline))))
(define (original-value addr code objs) (define (original-value addr code objs)
(define (branch-code? code) (let* ((code (code-unpack code))
(string-match "^br" (symbol->string (car code)))) (inst (car code))
(define (list-or-vector? code) (args (cdr code)))
(case (car code) (case inst
((list vector) #t) ((list vector)
(else #f))) (let ((len (+ (* (cadr code) 256) (caddr code))))
(format #f "~a element~a" len (if (> len 1) "s" ""))))
(let ((code (code-unpack code))) ((br br-if br-if-eq br-if-not br-if-not-eq br-if-not-null br-if-null)
(cond ((list-or-vector? code) (let ((offset (+ (* (car args) 256) (cadr args))))
(let ((len (+ (* (cadr code) 256) (caddr code)))) (format #f "-> ~A" (+ addr offset 3))))
(format #f "~a element~a" len (if (> len 1) "s" "")))) ((object-ref)
((code->object code) => object->string) (if objs (object->string (vector-ref objs (car args))) #f))
((branch-code? code) ((mv-call)
(let ((offset (+ (* (cadr code) 256) (caddr code)))) (let ((offset (+ (* (caddr code) 256) (cadddr code))))
(format #f "-> ~A" (+ addr offset 3)))) (format #f "MV -> ~A" (+ addr offset 4))))
(else (else
(let ((inst (car code)) (args (cdr code))) (and=> (code->object code) object->string)))))
(case inst
((make-false) "#f")
((object-ref)
(if objs (object->string (vector-ref objs (car args))) #f))
((mv-call)
(let ((offset (+ (* (caddr code) 256) (cadddr code))))
(format #f "MV -> ~A" (+ addr offset 4))))
(else #f)))))))
(define (list->info list) (define (list->info list)
(object->string list)) (object->string list))