--- a/src/debugger.lisp Thu Nov 17 23:54:14 2016 +0000
+++ b/src/debugger.lisp Fri Nov 18 00:56:05 2016 +0000
@@ -1,5 +1,7 @@
(in-package :chip8.debugger)
(named-readtables:in-readtable :qtools)
+(declaim (optimize (debug 3)))
+
;;;; Disassembler -------------------------------------------------------------
(defun disassemble-instruction (instruction)
@@ -62,24 +64,29 @@
(t #\space))
: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)))
+
+(defun instruction-information (array index)
+ (let ((instruction (retrieve-instruction array index)))
+ (list index
+ instruction
+ (disassemble-instruction instruction)
+ (bit-diagram instruction))))
+
+
(defun disassemble-instructions (array start)
(iterate
- (with len = (length array))
- (for i :from start :below len :by 2)
- (for instruction = (chip8::cat-bytes (aref array i)
- ;; ugly hack to handle odd-sized roms
- (if (< (1+ i) len)
- (aref array (1+ i))
- 0)))
- (collect (vector i
- instruction
- (disassemble-instruction instruction)
- (bit-diagram instruction))
- :result-type vector)))
+ (for i :from start :below (length array) :by 2)
+ (collect (instruction-information array i) :result-type vector)))
(defun dump (array start &optional (offset 0))
(iterate (for (address instruction disassembly bits)
- :in-array (disassemble-instructions array start))
+ :in-vector (disassemble-instructions array start))
(sleep 0.005)
(format t "~3,'0X: ~4,'0X ~24A ~8A~%"
(+ address offset)
@@ -87,16 +94,21 @@
(or disassembly "")
bits)))
+
+(defparameter *rom*
+ (read-file-into-byte-vector "roms/merlin.rom"))
+
(defparameter *test*
- (disassemble-instructions (read-file-into-byte-vector "roms/tictac.rom")
- 0))
-
-(defparameter *font* (q+:make-qfont "Menlo" 12))
+ (disassemble-instructions *rom* 0))
;;;; Model --------------------------------------------------------------------
+(defparameter *font* (q+:make-qfont "Menlo" 12))
+(defparameter *font2* (q+:make-qfont "Menlo" 12))
+
(define-widget disassembly-model (QAbstractTableModel)
- ((data :accessor model-data :initarg :data :initform *test*)))
+ ((data :accessor model-data :initarg :data :initform *test*)
+ (chip :accessor model-chip :initarg :chip)))
(define-override (disassembly-model column-count) (index)
(declare (ignore index))
@@ -104,34 +116,44 @@
(define-override (disassembly-model row-count) (index)
(declare (ignore index))
- (-<> disassembly-model
- model-data
- length))
+ (ceiling 4096 2))
+
+
+(defun index-valid-p (index)
+ (and (q+:is-valid index)
+ (< (q+:row index) (ceiling 4096 2))))
+
+(defun get-contents (model row col)
+ (let ((data (-<> model
+ model-chip
+ chip8::chip-memory
+ (instruction-information <> (* 2 row))
+ (nth col <>))))
+ (ecase col
+ (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))))
(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)))))
+ (if (not (index-valid-p index))
+ (q+:make-qvariant)
+ (qtenumcase role
+ ((q+:qt.display-role) (get-contents disassembly-model row col))
+ ((q+:qt.font-role) (case col
+ (3 *font2*)
+ (t *font*)))
+ ((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)
(case role
@@ -146,8 +168,7 @@
(define-widget debugger (QWidget)
- ((model :accessor debugger-model
- :initform (make-instance 'disassembly-model))))
+ ((model :accessor debugger-model :initarg :model)))
(define-subwidget (debugger table) (q+:make-qtableview debugger)
@@ -159,7 +180,7 @@
(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)
+ (q+:set-default-section-size vheader 14)
)
)
@@ -167,5 +188,8 @@
(q+:add-widget layout table))
-(defun run ()
- (with-main-window (window 'debugger)))
+(defun run (chip)
+ (let ((model (make-instance 'disassembly-model :chip chip)))
+ (with-main-window (window (make-instance 'debugger :model model)))))
+
+(defparameter *c* (chip8::make-chip))
--- a/src/emulator.lisp Thu Nov 17 23:54:14 2016 +0000
+++ b/src/emulator.lisp Fri Nov 18 00:56:05 2016 +0000
@@ -74,7 +74,7 @@
;;;; Data ---------------------------------------------------------------------
-(defstruct (chip (:constructor make-chip%))
+(defstruct chip
(memory (make-simple-array 'int8 4096)
:type (basic-array int8 4096)
:read-only t)
@@ -105,11 +105,6 @@
:element-type 'int12)
:type (stack 16)))
-(defun make-chip ()
- (let ((chip (make-chip%)))
- (load-font chip)
- chip))
-
(define-with-macro chip
memory registers
flag
@@ -370,8 +365,11 @@
(defun load-rom (chip filename)
+ (fill (chip-memory chip) 0)
+ (load-font chip)
(replace (chip-memory chip) (read-file-into-byte-vector filename)
- :start1 #x200))
+ :start1 #x200)
+ (values))
(defun update-timers (chip)
(with-chip (chip)