--- a/src/debugger.lisp Thu Nov 17 21:04:40 2016 +0000
+++ b/src/debugger.lisp Thu Nov 17 23:54:14 2016 +0000
@@ -1,7 +1,7 @@
(in-package :chip8.debugger)
(named-readtables:in-readtable :qtools)
-
+;;;; Disassembler -------------------------------------------------------------
(defun disassemble-instruction (instruction)
(let ((_x__ (ldb (byte 4 8) instruction))
(__x_ (ldb (byte 4 4) instruction))
@@ -71,17 +71,101 @@
(if (< (1+ i) len)
(aref array (1+ i))
0)))
- (collect (list i
- instruction
- (disassemble-instruction instruction)
- (bit-diagram instruction)))))
+ (collect (vector i
+ instruction
+ (disassemble-instruction instruction)
+ (bit-diagram instruction))
+ :result-type vector)))
(defun dump (array start &optional (offset 0))
(iterate (for (address instruction disassembly bits)
- :in (disassemble-instructions array start))
+ :in-array (disassemble-instructions array start))
(sleep 0.005)
(format t "~3,'0X: ~4,'0X ~24A ~8A~%"
(+ address offset)
instruction
(or disassembly "")
bits)))
+
+(defparameter *test*
+ (disassemble-instructions (read-file-into-byte-vector "roms/tictac.rom")
+ 0))
+
+(defparameter *font* (q+:make-qfont "Menlo" 12))
+
+
+;;;; Model --------------------------------------------------------------------
+(define-widget disassembly-model (QAbstractTableModel)
+ ((data :accessor model-data :initarg :data :initform *test*)))
+
+(define-override (disassembly-model column-count) (index)
+ (declare (ignore index))
+ 4)
+
+(define-override (disassembly-model row-count) (index)
+ (declare (ignore index))
+ (-<> disassembly-model
+ model-data
+ length))
+
+(define-override (disassembly-model data) (index role)
+ (let ((row (q+:row index))
+ (col (q+:column index)))
+ (qtenumcase role
+ ((q+:qt.display-role)
+ (let ((data (-<> disassembly-model
+ model-data
+ (aref <> row)
+ (aref <> col))))
+ (case (q+:column index)
+ (0 (format nil "~3,'0X" data))
+ (1 (format nil "~4,'0X" data))
+ (2 (if data
+ (let ((*print-base* 16))
+ (format nil "~A ~{~S~^, ~}" (first data) (rest data)))
+ ""))
+ (3 data))))
+ ((q+:qt.font-role) *font*)
+ ((q+:qt.text-alignment-role) (case col
+ (0 #x0082)
+ (1 #x0084)
+ (2 #x0080)
+ (3 #x0084)))
+ (t (q+:make-qvariant)))))
+
+(define-override (disassembly-model header-data) (section orientation role)
+ (case role
+ (0 (qtenumcase orientation
+ ((q+:qt.vertical) (q+:make-qvariant))
+ ((q+:qt.horizontal) (case section
+ (0 "Addr")
+ (1 "Inst")
+ (2 "Disassembly")
+ (3 "Bits")))))
+ (t (q+:make-qvariant))))
+
+
+(define-widget debugger (QWidget)
+ ((model :accessor debugger-model
+ :initform (make-instance 'disassembly-model))))
+
+
+(define-subwidget (debugger table) (q+:make-qtableview debugger)
+ (q+:set-model table model)
+ (q+:set-show-grid table nil)
+ (q+:set-column-width table 0 40)
+ (q+:set-column-width table 1 60)
+ (q+:set-column-width table 2 200)
+ (q+:set-column-width table 3 90)
+ (let ((vheader (q+:vertical-header table)))
+ (q+:set-resize-mode vheader (q+:qheaderview.fixed))
+ (q+:set-default-section-size vheader 15)
+ )
+ )
+
+(define-subwidget (debugger layout) (q+:make-qvboxlayout debugger)
+ (q+:add-widget layout table))
+
+
+(defun run ()
+ (with-main-window (window 'debugger)))