| author |
Steve Losh <steve@stevelosh.com> |
| date |
Thu, 17 Nov 2016 21:04:40 +0000 |
| parents |
a316b453595a |
| children |
5e7aa5bae23f |
(in-package :chip8.debugger)
(named-readtables:in-readtable :qtools)
(defun disassemble-instruction (instruction)
(let ((_x__ (ldb (byte 4 8) instruction))
(__x_ (ldb (byte 4 4) instruction))
(___x (ldb (byte 4 0) instruction))
(__xx (ldb (byte 8 0) instruction))
(_xxx (ldb (byte 12 0) instruction)))
(case (logand #xF000 instruction)
(#x0000 (case instruction
(#x00E0 '(cls))
(#x00EE '(ret))))
(#x1000 `(jp ,_xxx))
(#x2000 `(call ,_xxx))
(#x3000 `(se (v ,_x__) ,__xx))
(#x4000 `(sne (v ,_x__) ,__xx))
(#x5000 (case (logand #x000F instruction)
(#x0 `(se (v ,_x__) (v ,__x_)))))
(#x6000 `(ld (v ,_x__) ,__xx))
(#x7000 `(add (v ,_x__) ,__xx))
(#x8000 (case (logand #x000F instruction)
(#x0 `(ld (v ,_x__) (v ,__x_)))
(#x1 `(or (v ,_x__) (v ,__x_)))
(#x2 `(and (v ,_x__) (v ,__x_)))
(#x3 `(xor (v ,_x__) (v ,__x_)))
(#x4 `(add (v ,_x__) (v ,__x_)))
(#x5 `(sub (v ,_x__) (v ,__x_)))
(#x6 `(shr (v ,_x__) (v ,__x_)))
(#x7 `(subn (v ,_x__) (v ,__x_)))
(#xE `(shl (v ,_x__) (v ,__x_)))))
(#x9000 (case (logand #x000F instruction)
(#x0 `(sne (v ,_x__) (v ,__x_)))))
(#xA000 `(ld i ,_xxx))
(#xB000 `(jp (v 0) ,_xxx))
(#xC000 `(rnd (v ,_x__) ,__xx))
(#xD000 `(drw (v ,_x__) (v ,__x_) ,___x))
(#xE000 (case (logand #x00FF instruction)
(#x9E `(skp (v ,_x__)))
(#xA1 `(sknp (v ,_x__)))))
(#xF000 (case (logand #x00FF instruction)
(#x07 `(ld (v ,_x__) dt))
(#x0A `(ld (v ,_x__) k))
(#x15 `(ld dt (v ,_x__)))
(#x18 `(ld st (v ,_x__)))
(#x1E `(add i (v ,_x__)))
(#x29 `(ld f (v ,_x__)))
(#x33 `(ld b (v ,_x__)))
(#x55 `(ld (mem i) ,_x__))
(#x65 `(ld ,_x__ (mem i))))))))
(defun bit-diagram (integer)
(iterate (for high-bit :from 15 :downto 8)
(for low-bit :from 7 :downto 0)
(for hi = (logbitp high-bit integer))
(for lo = (logbitp low-bit integer))
(collect (cond
((and hi lo) #\full_block)
(hi #\upper_half_block)
(lo #\lower_half_block)
(t #\space))
:result-type 'string)))
(defun disassemble-instructions (array start)
(iterate
(with len = (length array))
(for i :from start :below len :by 2)
(for instruction = (chip8::cat-bytes (aref array i)
;; ugly hack to handle odd-sized roms
(if (< (1+ i) len)
(aref array (1+ i))
0)))
(collect (list i
instruction
(disassemble-instruction instruction)
(bit-diagram instruction)))))
(defun dump (array start &optional (offset 0))
(iterate (for (address instruction disassembly bits)
:in (disassemble-instructions array start))
(sleep 0.005)
(format t "~3,'0X: ~4,'0X ~24A ~8A~%"
(+ address offset)
instruction
(or disassembly "")
bits)))