# HG changeset patch # User Steve Losh # Date 1479511781 0 # Node ID 15dc85d07ef8396ea013278e3e45edcf56d5849f # Parent 15e3dd889f0b3576488c2c4b5b495a26c40a9732 Add real-ass debugging and fix the stupid controls diff -r 15e3dd889f0b -r 15dc85d07ef8 src/debugger.lisp --- 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)))) diff -r 15e3dd889f0b -r 15dc85d07ef8 src/emulator.lisp --- 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)) <>)) diff -r 15e3dd889f0b -r 15dc85d07ef8 src/gui.lisp --- 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))