# HG changeset patch # User Steve Losh # Date 1479484367 0 # Node ID 15e3dd889f0b3576488c2c4b5b495a26c40a9732 # Parent d18676cbb4f27db47e47032f35e9319d253fec23 Add register viewer, clean up disassembly diff -r d18676cbb4f2 -r 15e3dd889f0b src/debugger.lisp --- 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) diff -r d18676cbb4f2 -r 15e3dd889f0b src/emulator.lisp --- 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)