Skip to content

Commit

Permalink
Clean up the debugger a bit
Browse files Browse the repository at this point in the history
  • Loading branch information
sjl committed Jan 2, 2017
1 parent 7545152 commit 29f69e2
Show file tree
Hide file tree
Showing 3 changed files with 27 additions and 29 deletions.
33 changes: 19 additions & 14 deletions src/debugger.lisp
Expand Up @@ -4,12 +4,12 @@
(defstruct debugger
(paused nil :type boolean)
(take-step nil :type boolean)
(print-needed nil :type boolean)
(awaiting-arrival nil :type boolean)
(callbacks-arrived nil :type list)
(breakpoints nil :type list))

(define-with-macro debugger
paused take-step print-needed
paused take-step awaiting-arrival
callbacks-arrived)


Expand Down Expand Up @@ -112,46 +112,51 @@
;;;; Debugger API -------------------------------------------------------------
(defun debugger-pause (debugger)
(with-debugger (debugger)
(setf paused t print-needed t)))
(setf paused t awaiting-arrival t)))

(defun debugger-unpause (debugger)
(with-debugger (debugger)
(setf paused nil print-needed nil)))
(setf paused nil awaiting-arrival nil)))

(defun debugger-toggle-pause (debugger)
(if (debugger-paused debugger)
(debugger-unpause debugger)
(debugger-pause debugger)))

(defun debugger-step (debugger)
(setf (debugger-take-step debugger) t))

(defun debugger-arrive (debugger chip)
(with-debugger (debugger)
(setf take-step t)))
(when awaiting-arrival
(setf awaiting-arrival nil)
(debugger-print debugger chip)
(mapc (rcurry #'funcall (chip-program-counter chip))
callbacks-arrived))))

(defun debugger-print (debugger chip)
(with-debugger (debugger)
(when (and paused print-needed)
(setf print-needed nil)
(let ((pc (chip-program-counter chip)))
(print-disassembled-instruction (chip-memory chip) pc)
(mapc (rcurry #'funcall pc) callbacks-arrived))))
(values))
(declare (ignore debugger))
(print-disassembled-instruction (chip-memory chip)
(chip-program-counter chip)))

(defun debugger-paused-p (debugger)
(debugger-paused debugger))

(defun debugger-check-breakpoints (debugger address)
"Return `t` if the debugger is at a breakpoint, `nil` otherwise."
(if (member address (debugger-breakpoints debugger))
(progn (debugger-pause debugger)
t)
nil))

(defun debugger-should-wait-p (debugger address)
(defun debugger-check-wait (debugger address)
"Return `t` if the debugger wants execution to wait, `nil` otherwise."
(with-debugger (debugger)
(cond
;; If we're not paused, we just need to check for breakpoints.
((not paused) (debugger-check-breakpoints debugger address))
;; If we're paused, but are ready to step, go.
(take-step (setf take-step nil print-needed t) nil)
(take-step (setf take-step nil awaiting-arrival t) nil)
;; Otherwise we're fully paused -- wait
(t t))))

Expand Down
4 changes: 2 additions & 2 deletions src/emulator.lisp
Expand Up @@ -519,8 +519,8 @@

(defun emulate-cycle (chip)
(with-chip (chip)
(debugger-print debugger chip)
(if (debugger-should-wait-p debugger program-counter)
(debugger-arrive debugger chip)
(if (debugger-check-wait debugger program-counter)
(sleep 10/1000)
(let ((instruction (cat-bytes (aref memory program-counter)
(aref memory (1+ program-counter)))))
Expand Down
19 changes: 6 additions & 13 deletions src/gui/screen.lisp
Expand Up @@ -212,22 +212,15 @@

(define-override (screen key-release-event) (ev)
(let* ((key (q+:key ev))
(pad-key (pad-key-for key)))
(pad-key (pad-key-for key))
(debugger (chip8::chip-debugger chip)))
(if pad-key
(chip8::keyup chip pad-key)
(qtenumcase key
((q+:qt.key_escape)
(die))

((q+:qt.key_space)
(-> chip chip8::chip-debugger chip8::debugger-toggle-pause))

((q+:qt.key_f1)
(-> chip chip8::reset))

((q+:qt.key_f7)
(-> chip chip8::chip-debugger chip8::debugger-step))

((q+:qt.key_escape) (die))
((q+:qt.key_space) (chip8::debugger-toggle-pause debugger))
((q+:qt.key_f1) (chip8::reset chip))
((q+:qt.key_f7) (chip8::debugger-step debugger))
(t (pr :unknown-key (format nil "~X" key))))))
(stop-overriding))

Expand Down

0 comments on commit 29f69e2

Please sign in to comment.