Add disassembly parity control
author |
Steve Losh <steve@stevelosh.com> |
date |
Thu, 24 Nov 2016 17:18:34 +0000 |
parents |
165f6873f5dd
|
children |
09f977d7168e
|
branches/tags |
(none) |
files |
.lispwords src/debugger.lisp src/emulator.lisp |
Changes
--- 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)
--- 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)
--- 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 ()