# HG changeset patch # User Steve Losh # Date 1479430565 0 # Node ID e6a45e9d98691e1267f95945a9dc87036057af1d # Parent 5e7aa5bae23f56a07878c7646792f81d78aa589f WELL DO IT LIVE diff -r 5e7aa5bae23f -r e6a45e9d9869 src/debugger.lisp --- 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)) diff -r 5e7aa5bae23f -r e6a45e9d9869 src/emulator.lisp --- 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)