# HG changeset patch # User Steve Losh # Date 1480007914 0 # Node ID c96b71d08dfd4bbb725b302fef2c399a969182f1 # Parent 165f6873f5dde0c3e250ee89ab8846602ef9a25b Add disassembly parity control diff -r 165f6873f5dd -r c96b71d08dfd .lispwords --- a/.lispwords Thu Nov 24 13:19:48 2016 +0000 +++ b/.lispwords Thu Nov 24 17:18:34 2016 +0000 @@ -1,2 +1,3 @@ (1 macro-map) (1 register-case) +(2 define-subwidget) diff -r 165f6873f5dd -r c96b71d08dfd src/debugger.lisp --- a/src/debugger.lisp Thu Nov 24 13:19:48 2016 +0000 +++ b/src/debugger.lisp Thu Nov 24 17:18:34 2016 +0000 @@ -24,6 +24,11 @@ (defun model-index (model row col) (q+:index model row col (q+:make-qmodelindex))) +(defun data-changed! (model index-from &optional (index-to index-from)) + (signal! model (data-changed "QModelIndex" "QModelIndex") + index-from + index-to)) + ;;;; Disassembler ------------------------------------------------------------- ;;;; Code @@ -36,19 +41,33 @@ ;;;; Model (define-widget disassembly-model (QAbstractTableModel) ((chip :initarg :chip) + (parity :initform 0) (current-address :initform 0))) + +(defun disassembly-model-address-to-row (model address) + (-<> address + (+ <> (slot-value model 'parity)) + (truncate <> 2) + (values <>))) + + (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))) + (old-row (disassembly-model-address-to-row model old-address)) + (new-row (disassembly-model-address-to-row model new-address))) (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)))) + (data-changed! model + (model-index model old-row 0) + (model-index model old-row 3)) + (data-changed! model + (model-index model new-row 0) + (model-index model new-row 3)))) + +(defun disassembly-model-toggle-parity (model) + (zapf (slot-value model 'parity) (if (zerop %) 1 0)) + (signal! model (layout-changed))) + (define-override (disassembly-model column-count) (index) (declare (ignore index)) @@ -56,7 +75,7 @@ (define-override (disassembly-model row-count) (index) (declare (ignore index)) - (ceiling 4096 2)) + (+ parity (ceiling 4096 2))) (defun disassembly-index-valid-p (index) @@ -66,7 +85,8 @@ (defun get-disassembly-contents (model row col) (let ((data (-<> model (slot-value <> 'chip) - (disassemble-address <> (* 2 row)) + (disassemble-address <> (- (* 2 row) + (slot-value model 'parity))) (nth col <>)))) (ecase col (0 (format nil "~3,'0X" data)) @@ -89,7 +109,8 @@ ((q+:qt.font-role) *font*) ((q+:qt.background-role) - (if (= row (floor current-address 2)) + (if (= row (disassembly-model-address-to-row disassembly-model + current-address)) *current-instruction-brush* (q+:make-qvariant))) @@ -118,7 +139,7 @@ (disassembly-model-update-current-address model address) (-<> address ;; raw address -> row number - (floor <> 2) + (disassembly-model-address-to-row model <>) ;; Give ourselves a bit of breathing room at the top of the table (- <> 4) (max <> 0) @@ -127,7 +148,8 @@ ;; 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) +(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)) @@ -142,6 +164,14 @@ (q+:set-resize-mode vheader (q+:qheaderview.fixed)) (q+:set-default-section-size vheader 14))) +(define-subwidget (debugger disassembly-parity-button) + (q+:make-qpushbutton "Flip Parity" debugger)) + +(define-slot (debugger disassembly-toggle-parity) () + (declare (connected disassembly-parity-button (pressed))) + (disassembly-model-toggle-parity model-disassembly)) + + ;;;; Register Viewer ---------------------------------------------------------- ;;;; Code @@ -250,8 +280,7 @@ (val (parse-hex value (registers-max-value row)))) (when val (setf (registers-value chip row) val) - (signal! registers-model (data-changed "QModelIndex" "QModelIndex") - index index)) + (data-changed! registers-model index)) t) nil)) @@ -341,6 +370,7 @@ (define-subwidget (debugger layout) (q+:make-qhboxlayout debugger) (let ((disassembly (q+:make-qvboxlayout))) (q+:add-widget disassembly disassembly-table) + (q+:add-widget disassembly disassembly-parity-button) (q+:add-layout layout disassembly)) (let ((values (q+:make-qvboxlayout))) (q+:set-fixed-width registers-table 90) diff -r 165f6873f5dd -r c96b71d08dfd src/emulator.lisp --- a/src/emulator.lisp Thu Nov 24 13:19:48 2016 +0000 +++ b/src/emulator.lisp Thu Nov 24 17:18:34 2016 +0000 @@ -210,11 +210,14 @@ :result-type 'string))) (defun retrieve-instruction (array index) - (chip8::cat-bytes (aref array index) - ;; ugly hack to handle odd-sized roms - (if (< (1+ index) (length array)) - (aref array (1+ index)) - 0))) + (chip8::cat-bytes + ;; ugly hacks to handle odd parity + (if (minusp index) + 0 + (aref array index)) + (if (< (1+ index) (length array)) + (aref array (1+ index)) + 0))) (defun instruction-information (array index) (let ((instruction (retrieve-instruction array index))) @@ -708,10 +711,12 @@ ;;;; Main --------------------------------------------------------------------- -(defun run (rom-filename) +(defun run (rom-filename &key start-paused) (let ((chip (make-chip))) (setf *c* chip) (load-rom chip rom-filename) + (when start-paused + (debugger-pause (chip-debugger chip))) (chip8.gui::run-gui chip (lambda ()