simplify disassembly annotations a bit
authorAndy Wingo <wingo@pobox.com>
Sat, 11 Oct 2008 16:55:44 +0000 (18:55 +0200)
committerAndy Wingo <wingo@pobox.com>
Sat, 11 Oct 2008 16:55:44 +0000 (18:55 +0200)
* module/system/vm/disasm.scm (original-value): Simplify a bit to
  normally dispatch on the instruction, only trying code->object at the
  end.

module/system/vm/disasm.scm

index 2792606..7dea0a9 100644 (file)
             (newline))))
 
 (define (original-value addr code objs)
-  (define (branch-code? code)
-    (string-match "^br" (symbol->string (car code))))
-  (define (list-or-vector? code)
-    (case (car code)
-      ((list vector) #t)
-      (else #f)))
-
-  (let ((code (code-unpack code)))
-    (cond ((list-or-vector? code)
-          (let ((len (+ (* (cadr code) 256) (caddr code))))
-            (format #f "~a element~a" len (if (> len 1) "s" ""))))
-         ((code->object code) => object->string)
-         ((branch-code? code)
-          (let ((offset (+ (* (cadr code) 256) (caddr code))))
-            (format #f "-> ~A" (+ addr offset 3))))
-         (else
-          (let ((inst (car code)) (args (cdr code)))
-            (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)))))))
+  (let* ((code (code-unpack code))
+         (inst (car code))
+         (args (cdr code)))
+    (case inst
+      ((list vector) 
+       (let ((len (+ (* (cadr code) 256) (caddr code))))
+         (format #f "~a element~a" len (if (> len 1) "s" ""))))
+      ((br br-if br-if-eq br-if-not br-if-not-eq br-if-not-null br-if-null)
+       (let ((offset (+ (* (car args) 256) (cadr args))))
+         (format #f "-> ~A" (+ addr offset 3))))
+      ((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
+       (and=> (code->object code) object->string)))))
 
 (define (list->info list)
   (object->string list))