# HG changeset patch # User Steve Losh # Date 1483369808 0 # Node ID e8402b50111c26ca9a70f41fb61be68d3e6e77df # Parent 571d38c4dec3f248b805066c92bbccbc73e484cb Clean up the debugger a bit diff -r 571d38c4dec3 -r e8402b50111c src/debugger.lisp --- a/src/debugger.lisp Mon Dec 26 22:28:59 2016 -0500 +++ b/src/debugger.lisp Mon Jan 02 15:10:08 2017 +0000 @@ -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) @@ -112,11 +112,11 @@ ;;;; 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) @@ -124,34 +124,39 @@ (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)))) diff -r 571d38c4dec3 -r e8402b50111c src/emulator.lisp --- a/src/emulator.lisp Mon Dec 26 22:28:59 2016 -0500 +++ b/src/emulator.lisp Mon Jan 02 15:10:08 2017 +0000 @@ -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))))) diff -r 571d38c4dec3 -r e8402b50111c src/gui/screen.lisp --- a/src/gui/screen.lisp Mon Dec 26 22:28:59 2016 -0500 +++ b/src/gui/screen.lisp Mon Jan 02 15:10:08 2017 +0000 @@ -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))