# HG changeset patch
# User Steve Losh <steve@stevelosh.com>
# Date 1479416447 0
# Node ID a316b453595a46821103fc3c5006b219416c367d
# Parent  8e58d7eb4d032134b7ccfd0107e76f51e23b7b25
Start working on a basic debugger

diff -r 8e58d7eb4d03 -r a316b453595a cl-chip8.asd
--- a/cl-chip8.asd	Thu Nov 17 15:50:38 2016 +0000
+++ b/cl-chip8.asd	Thu Nov 17 21:00:47 2016 +0000
@@ -24,4 +24,5 @@
                (:file "package")
                (:module "src" :serial t
                 :components ((:file "emulator")
+                             (:file "debugger")
                              (:file "gui")))))
diff -r 8e58d7eb4d03 -r a316b453595a package.lisp
--- a/package.lisp	Thu Nov 17 15:50:38 2016 +0000
+++ b/package.lisp	Thu Nov 17 21:00:47 2016 +0000
@@ -11,3 +11,7 @@
 (defpackage :chip8.gui
   (:use :cl+qt :iterate :losh
     :chip8.quickutils))
+
+(defpackage :chip8.debugger
+  (:use :cl+qt :iterate :losh :cl-arrows
+    :chip8.quickutils))
diff -r 8e58d7eb4d03 -r a316b453595a src/debugger.lisp
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/debugger.lisp	Thu Nov 17 21:00:47 2016 +0000
@@ -0,0 +1,79 @@
+(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 dump (array start &optional (offset 0))
+  (iterate
+    (with len = (length array))
+    (for i :from start :below len :by 2)
+    (for instruction = (chip8::cat-bytes (aref array i)
+                                         (if (< (1+ i) len)
+                                           (aref array (1+ i))
+                                           0)))
+    (for disassembly = (disassemble-instruction instruction))
+    (sleep 0.005)
+    (format t "~3,'0X: ~4,'0X ~24A ~8A~%"
+            (+ offset i)
+            instruction
+            (or disassembly "")
+            (bit-diagram instruction))))