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))