Add real-ass debugging and fix the stupid controls
| author |
Steve Losh <steve@stevelosh.com> |
| date |
Fri, 18 Nov 2016 23:29:41 +0000 |
| parents |
15e3dd889f0b
|
| children |
8ca52e1d0bb0
|
| branches/tags |
(none) |
| files |
src/debugger.lisp src/emulator.lisp src/gui.lisp |
Changes
--- a/src/debugger.lisp Fri Nov 18 15:52:47 2016 +0000
+++ b/src/debugger.lisp Fri Nov 18 23:29:41 2016 +0000
@@ -4,19 +4,27 @@
(defparameter *font* (q+:make-qfont "Menlo" 12))
+(defparameter *current-instruction-brush*
+ (q+:make-qbrush (q+:make-qcolor 216 162 223)))
;;;; Main GUI -----------------------------------------------------------------
(define-widget debugger (QWidget)
((model-disassembly :initarg :model-disassembly)
(model-registers :initarg :model-registers)
- (model-stack :initarg :model-stack)))
+ (model-stack :initarg :model-stack)
+ (chip-debugger :initarg :chip-debugger)))
(define-initializer (debugger setup)
(setf (q+:window-title debugger) "Debugger")
(q+:resize debugger 580 800))
+;;;; Utils --------------------------------------------------------------------
+(defun model-index (model row col)
+ (q+:index model row col (q+:make-qmodelindex)))
+
+
;;;; Disassembler -------------------------------------------------------------
;;;; Code
(defun disassemble-address (chip address)
@@ -27,7 +35,20 @@
;;;; Model
(define-widget disassembly-model (QAbstractTableModel)
- ((chip :accessor model-chip :initarg :chip)))
+ ((chip :initarg :chip)
+ (current-address :initform 0)))
+
+(defun disassembly-model-update-current-address (model new-address)
+ (let* ((old-address (slot-value model 'current-address))
+ (old-row (floor old-address 2))
+ (new-row (floor new-address 2)))
+ (setf (slot-value model 'current-address) new-address)
+ (signal! model (data-changed "QModelIndex" "QModelIndex")
+ (model-index model old-row 0)
+ (model-index model old-row 3))
+ (signal! model (data-changed "QModelIndex" "QModelIndex")
+ (model-index model new-row 0)
+ (model-index model new-row 3))))
(define-override (disassembly-model column-count) (index)
(declare (ignore index))
@@ -44,7 +65,7 @@
(defun get-disassembly-contents (model row col)
(let ((data (-<> model
- model-chip
+ (slot-value <> 'chip)
(disassemble-address <> (* 2 row))
(nth col <>))))
(ecase col
@@ -62,13 +83,22 @@
(if (not (disassembly-index-valid-p index))
(q+:make-qvariant)
(qtenumcase role
- ((q+:qt.display-role) (get-disassembly-contents disassembly-model row col))
+ ((q+:qt.display-role)
+ (get-disassembly-contents disassembly-model row col))
+
((q+:qt.font-role) *font*)
+
+ ((q+:qt.background-role)
+ (if (= row (floor current-address 2))
+ *current-instruction-brush*
+ (q+:make-qvariant)))
+
((q+:qt.text-alignment-role) (case col
(0 #x0082)
(1 #x0084)
(2 #x0080)
(3 #x0080)))
+
(t (q+:make-qvariant))))))
(define-override (disassembly-model header-data) (section orientation role)
@@ -84,7 +114,23 @@
;;;; Layout
+(defun disassembly-update-address (model view address)
+ (disassembly-model-update-current-address model address)
+ (-<> address
+ ;; raw address -> row number
+ (floor <> 2)
+ ;; Give ourselves a bit of breathing room at the top of the table
+ (- <> 4)
+ (max <> 0)
+ ;; get a QModelIndex, because passing a pair of ints would be too easy
+ (model-index model <> 0)
+ ;; make the debugger show the current line
+ (q+:scroll-to view <> (q+:qabstractitemview.position-at-top))))
+
(define-subwidget (debugger disassembly-table) (q+:make-qtableview debugger)
+ (chip8::debugger-add-callback-arrived
+ chip-debugger ; bit of a fustercluck here...
+ (curry #'disassembly-update-address model-disassembly disassembly-table))
(q+:set-model disassembly-table model-disassembly)
(q+:set-show-grid disassembly-table nil)
(q+:set-column-width disassembly-table 0 40)
@@ -151,13 +197,22 @@
;;;; Layout
+(defun registers-refresh (model view address)
+ (declare (ignore view address))
+ (signal! model (data-changed "QModelIndex" "QModelIndex")
+ (model-index model 0 1)
+ (model-index model 18 1)))
+
(define-subwidget (debugger registers-table) (q+:make-qtableview debugger)
+ (chip8::debugger-add-callback-arrived
+ chip-debugger
+ (curry #'registers-refresh model-registers registers-table))
(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+:hide vheader)
(q+:set-resize-mode vheader (q+:qheaderview.fixed))
(q+:set-default-section-size vheader 14))
(let ((hheader (q+:horizontal-header registers-table)))
@@ -206,18 +261,20 @@
;;;; Layout
+(defun stack-refresh (model view address)
+ (declare (ignore view address))
+ ;; fuck it just refresh everything
+ (signal! model (layout-changed)))
+
(define-subwidget (debugger stack-list) (q+:make-qlistview debugger)
+ (chip8::debugger-add-callback-arrived
+ chip-debugger
+ (curry #'stack-refresh model-stack stack-list))
(q+:set-model stack-list model-stack))
(define-subwidget (debugger stack-label)
(q+:make-qlabel "Stack" debugger))
-(define-subwidget (debugger stack-refresh)
- (q+:make-qpushbutton "Refresh" debugger))
-
-(define-slot (debugger stack-refresh-pressed) ()
- (declare (connected stack-refresh (pressed)))
- (signal! model-stack (layout-changed)))
;;;; Main GUI -----------------------------------------------------------------
@@ -230,11 +287,9 @@
(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)))
@@ -245,7 +300,8 @@
(make-instance 'debugger
:model-disassembly model-disassembly
:model-registers model-registers
- :model-stack model-stack)))
+ :model-stack model-stack
+ :chip-debugger (chip8::chip-debugger chip))))
(defun run (chip)
(with-main-window (window (make-debugger chip))))
--- a/src/emulator.lisp Fri Nov 18 15:52:47 2016 +0000
+++ b/src/emulator.lisp Fri Nov 18 23:29:41 2016 +0000
@@ -77,7 +77,9 @@
(defstruct debugger
(paused nil :type boolean)
(take-step nil :type boolean)
- (print-needed nil :type boolean))
+ (print-needed nil :type boolean)
+ (callbacks-arrived nil :type list))
+
(defstruct chip
(memory (make-simple-array 'int8 4096)
@@ -123,7 +125,8 @@
debugger)
(define-with-macro debugger
- paused take-step print-needed)
+ paused take-step print-needed
+ callbacks-arrived)
(declaim (inline chip-flag (setf chip-flag)))
@@ -256,14 +259,17 @@
(defun debugger-print (debugger chip)
(with-debugger (debugger)
(when (and paused print-needed)
- (setf print-needed nil)
- (destructuring-bind (address instruction disassembly bits)
- (instruction-information (chip-memory chip) (chip-program-counter chip))
- (format t "~3,'0X: ~4,'0X ~24A ~8A~%"
- address
- instruction
- (or disassembly "")
- bits)))))
+ (let ((pc (chip-program-counter chip)))
+ (setf print-needed nil)
+ (destructuring-bind (address instruction disassembly bits)
+ (instruction-information (chip-memory chip) pc)
+ (format t "~3,'0X: ~4,'0X ~24A ~8A~%"
+ address
+ instruction
+ (or disassembly "")
+ bits))
+ (mapc (rcurry #'funcall pc) callbacks-arrived))))
+ (values))
(defun debugger-should-wait-p (debugger)
(with-debugger (debugger)
@@ -275,6 +281,10 @@
nil)
t)))) ; otherwise we're fully paused -- wait
+(defun debugger-add-callback-arrived (debugger function)
+ (push function (debugger-callbacks-arrived debugger))
+ t)
+
;;;; Graphics -----------------------------------------------------------------
(declaim (inline font-location vref (setf vref))
@@ -580,7 +590,7 @@
(with-chip (chip)
(debugger-print debugger chip)
(cond
- ((debugger-should-wait-p debugger) (sleep 100/1000))
+ ((debugger-should-wait-p debugger) (sleep 10/1000))
(awaiting-key (sleep 10/1000))
(t (let ((instruction (cat-bytes (aref memory program-counter)
(aref memory (1+ program-counter)))))
@@ -605,3 +615,6 @@
;;;; Scratch ------------------------------------------------------------------
+
+; (-<> *c* chip-debugger debugger-callbacks-arrived
+; (push (lambda (pc) (pr 'hello pc)) <>))
--- a/src/gui.lisp Fri Nov 18 15:52:47 2016 +0000
+++ b/src/gui.lisp Fri Nov 18 23:29:41 2016 +0000
@@ -132,26 +132,38 @@
(defun pad-key-for (code)
+ ;; Original Chip-8 Pad → Modern Numpad
+ ;; ┌─┬─┬─┬─┐ ┌─┬─┬─┬─┐
+ ;; │1│2│3│C│ │←│/│*│-│
+ ;; ├─┼─┼─┼─┤ ├─┼─┼─┼─┤
+ ;; │4│5│6│D│ │7│8│9│+│
+ ;; ├─┼─┼─┼─┤ ├─┼─┼─┤ │
+ ;; │7│8│9│E│ │4│5│6│ │
+ ;; ├─┼─┼─┼─┤ ├─┼─┼─┼─┤
+ ;; │A│0│B│F│ │1│2│3│↲│
+ ;; └─┴─┴─┴─┘ ├─┴─┼─┤ │
+ ;; │0 │.│ │
+ ;; └───┴─┴─┘
(cond
- ((= code (q+:qt.key_6)) #x1)
- ((= code (q+:qt.key_7)) #x2)
- ((= code (q+:qt.key_8)) #x3)
- ((= code (q+:qt.key_9)) #xC)
+ ((= code (q+:qt.key_clear)) #x1)
+ ((= code (q+:qt.key_slash)) #x2)
+ ((= code (q+:qt.key_asterisk)) #x3)
+ ((= code (q+:qt.key_minus)) #xC)
- ((= code (q+:qt.key_y)) #x4)
- ((= code (q+:qt.key_u)) #x5)
- ((= code (q+:qt.key_i)) #x6)
- ((= code (q+:qt.key_o)) #xD)
+ ((= code (q+:qt.key_7)) #x4)
+ ((= code (q+:qt.key_8)) #x5)
+ ((= code (q+:qt.key_9)) #x6)
+ ((= code (q+:qt.key_plus)) #xD)
- ((= code (q+:qt.key_h)) #x7)
- ((= code (q+:qt.key_j)) #x8)
- ((= code (q+:qt.key_k)) #x9)
- ((= code (q+:qt.key_l)) #xE)
+ ((= code (q+:qt.key_4)) #x7)
+ ((= code (q+:qt.key_5)) #x8)
+ ((= code (q+:qt.key_6)) #x9)
+ ((= code (q+:qt.key_enter)) #xE)
- ((= code (q+:qt.key_n)) #xA)
- ((= code (q+:qt.key_m)) #x0)
- ((= code (q+:qt.key_comma)) #xB)
- ((= code (q+:qt.key_period)) #xF)))
+ ((= code (q+:qt.key_1)) #xA)
+ ((= code (q+:qt.key_2)) #x0)
+ ((= code (q+:qt.key_3)) #xB)
+ ((= code (q+:qt.key_0)) #xF)))
(define-override (screen key-press-event) (ev)
@@ -175,7 +187,9 @@
(-> chip chip8::chip-debugger chip8::debugger-toggle-pause))
((q+:qt.key_f7)
- (-> chip chip8::chip-debugger chip8::debugger-step)))))
+ (-> chip chip8::chip-debugger chip8::debugger-step))
+
+ (t (pr "Unknown key pressed" (format nil "~X" key))))))
(stop-overriding))