From 95b6ad34c3eefeaf85723841dca92c7da8f1322a Mon Sep 17 00:00:00 2001
From: Andy Wingo <wingo@pobox.com>
Date: Sat, 11 Oct 2008 18:55:44 +0200
Subject: [PATCH] simplify disassembly annotations a bit

* 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 | 42 +++++++++++++++----------------------
 1 file changed, 17 insertions(+), 25 deletions(-)

diff --git a/module/system/vm/disasm.scm b/module/system/vm/disasm.scm
index 279260640..7dea0a98b 100644
--- a/module/system/vm/disasm.scm
+++ b/module/system/vm/disasm.scm
@@ -157,31 +157,23 @@
             (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))
-- 
2.20.1