--- a/src/debugger.lisp Fri Nov 18 15:06:50 2016 +0000
+++ b/src/debugger.lisp Fri Nov 18 15:52:47 2016 +0000
@@ -9,11 +9,12 @@
;;;; Main GUI -----------------------------------------------------------------
(define-widget debugger (QWidget)
((model-disassembly :initarg :model-disassembly)
+ (model-registers :initarg :model-registers)
(model-stack :initarg :model-stack)))
(define-initializer (debugger setup)
(setf (q+:window-title debugger) "Debugger")
- (q+:resize debugger 560 400))
+ (q+:resize debugger 580 800))
;;;; Disassembler -------------------------------------------------------------
@@ -37,7 +38,7 @@
(ceiling 4096 2))
-(defun index-valid-p (index)
+(defun disassembly-index-valid-p (index)
(and (q+:is-valid index)
(< (q+:row index) (ceiling 4096 2))))
@@ -51,14 +52,14 @@
(1 (format nil "~4,'0X" data))
(2 (if data
(let ((*print-base* 16))
- (format nil "~A ~{~S~^, ~}" (first data) (rest data)))
+ (format nil "~A ~{~A~^, ~}" (first data) (rest data)))
""))
(3 data))))
(define-override (disassembly-model data) (index role)
(let ((row (q+:row index))
(col (q+:column index)))
- (if (not (index-valid-p index))
+ (if (not (disassembly-index-valid-p index))
(q+:make-qvariant)
(qtenumcase role
((q+:qt.display-role) (get-disassembly-contents disassembly-model row col))
@@ -91,10 +92,78 @@
(q+:set-column-width disassembly-table 2 200)
(q+:set-column-width disassembly-table 3 90)
(let ((vheader (q+:vertical-header disassembly-table)))
+ (q+:hide vheader)
(q+:set-resize-mode vheader (q+:qheaderview.fixed))
(q+:set-default-section-size vheader 14)))
+;;;; Register Viewer ----------------------------------------------------------
+;;;; Code
+(defun registers-label (row)
+ (cond
+ ((<= row 15) (format nil "V~X" row))
+ ((= row 16) "I")
+ ((= row 17) "PC")))
+
+(defun registers-value (chip row)
+ (cond
+ ((<= row 15) (format nil "~2,'0X"
+ (aref (chip8::chip-registers chip) row)))
+ ((= row 16) (format nil "~4,'0X" (chip8::chip-index chip)))
+ ((= row 17) (format nil "~3,'0X" (chip8::chip-program-counter chip)))))
+
+
+;;;; Model
+(define-widget registers-model (QAbstractTableModel)
+ ((chip :initarg :chip)))
+
+
+(define-override (registers-model column-count) (index)
+ (declare (ignore index))
+ 2)
+
+(define-override (registers-model row-count) (index)
+ (declare (ignore index))
+ 18)
+
+
+(defun registers-index-valid-p (index)
+ (and (q+:is-valid index)
+ (< (q+:row index) 18)))
+
+(define-override (registers-model data) (index role)
+ (let ((row (q+:row index))
+ (col (q+:column index)))
+ (if (not (registers-index-valid-p index))
+ (q+:make-qvariant)
+ (qtenumcase role
+ ((q+:qt.display-role)
+ (ecase col
+ (0 (registers-label row))
+ (1 (registers-value chip row))))
+ ((q+:qt.text-alignment-role) #x0082)
+ ((q+:qt.font-role) *font*)
+ (t (q+:make-qvariant))))))
+
+(define-override (registers-model header-data) (section orientation role)
+ (declare (ignore section orientation role))
+ (q+:make-qvariant))
+
+
+;;;; Layout
+(define-subwidget (debugger registers-table) (q+:make-qtableview debugger)
+ (q+:set-model registers-table model-registers)
+ (q+:set-show-grid registers-table nil)
+ (q+:set-column-width registers-table 0 30)
+ (q+:set-column-width registers-table 1 40)
+ (let ((vheader (q+:vertical-header registers-table)))
+ (q+:hide vheader)
+ (q+:set-resize-mode vheader (q+:qheaderview.fixed))
+ (q+:set-default-section-size vheader 14))
+ (let ((hheader (q+:horizontal-header registers-table)))
+ (q+:hide hheader)))
+
+
;;;; Stack Viewer -------------------------------------------------------------
;;;; Code
(defun stack-value (chip index)
@@ -123,7 +192,7 @@
(define-override (stack-model data) (index role)
(let ((row (q+:row index)))
- (if (not (index-valid-p index))
+ (if (not (stack-index-valid-p index chip))
(q+:make-qvariant)
(qtenumcase role
((q+:qt.display-role) (get-stack-contents chip row))
@@ -156,21 +225,26 @@
(let ((disassembly (q+:make-qvboxlayout)))
(q+:add-widget disassembly disassembly-table)
(q+:add-layout layout disassembly))
- (let ((stack (q+:make-qvboxlayout)))
- (q+:set-fixed-width stack-label 70)
- (q+:set-fixed-width stack-list 70)
- (q+:set-fixed-width stack-refresh 80)
- (q+:add-widget stack stack-label)
- (q+:add-widget stack stack-list)
- (q+:add-widget stack stack-refresh)
- (q+:add-layout layout stack)))
+ (let ((values (q+:make-qvboxlayout)))
+ (q+:set-fixed-width registers-table 90)
+ (q+:set-fixed-width stack-label 90)
+ (q+:set-fixed-width stack-list 90)
+ (q+:set-maximum-height stack-list 260)
+ (q+:set-fixed-width stack-refresh 100)
+ (q+:add-widget values registers-table)
+ (q+:add-widget values stack-label)
+ (q+:add-widget values stack-list)
+ (q+:add-widget values stack-refresh)
+ (q+:add-layout layout values)))
(defun make-debugger (chip)
(let ((model-disassembly (make-instance 'disassembly-model :chip chip))
+ (model-registers (make-instance 'registers-model :chip chip))
(model-stack (make-instance 'stack-model :chip chip)))
(make-instance 'debugger
:model-disassembly model-disassembly
+ :model-registers model-registers
:model-stack model-stack)))
(defun run (chip)
--- a/src/emulator.lisp Fri Nov 18 15:06:50 2016 +0000
+++ b/src/emulator.lisp Fri Nov 18 15:52:47 2016 +0000
@@ -136,52 +136,53 @@
;;;; Disassembler -------------------------------------------------------------
(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))))))))
+ (flet ((v (n) (symb 'v (format nil "~X" n))))
+ (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)