Add simple debugger breakpoints (still needs UI)

Author: sjl

src/emulator.lisp

@@ -88,7 +88,8 @@
   (paused nil :type boolean)
   (take-step nil :type boolean)
   (print-needed nil :type boolean)
-  (callbacks-arrived nil :type list))
+  (callbacks-arrived nil :type list)
+  (breakpoints nil :type list))
 
 (defstruct chip
   (running t :type boolean)
@@ -248,9 +249,6 @@
 
 
 ;;;; Debugger -----------------------------------------------------------------
-(declaim
-  (ftype (function (debugger) boolean) debugger-should-wait-p))
-
 (defun debugger-pause (debugger)
   (with-debugger (debugger)
     (setf paused t print-needed t)))
@@ -286,16 +284,31 @@
 (defun debugger-paused-p (debugger)
   (debugger-paused debugger))
 
-(defun debugger-should-wait-p (debugger)
+(defun debugger-check-breakpoints (debugger address)
+  (let ((result (member address (debugger-breakpoints debugger))))
+    (if result
+      (progn (debugger-pause debugger)
+             t)
+      nil)))
+
+(defun debugger-should-wait-p (debugger address)
   (with-debugger (debugger)
-    (if (not paused) ; if we're not paused, we never need to wait
-      nil
+    (if (not paused)
+      ;; If we're not paused, we just need to check for breakpoints
+      (debugger-check-breakpoints debugger address)
+      ;; Otherwise we're paused
       (if take-step
         (progn (setf take-step nil ; if we're paused, but are ready to step, go
                      print-needed t)
                nil)
         t)))) ; otherwise we're fully paused -- wait
 
+(defun debugger-add-breakpoint (debugger address)
+  (pushnew address (debugger-breakpoints debugger)))
+
+(defun debugger-remove-breakpoint (debugger address)
+  (removef (debugger-breakpoints debugger) address))
+
 (defun debugger-add-callback-arrived (debugger function)
   (push function (debugger-callbacks-arrived debugger))
   t)
@@ -694,7 +707,7 @@
 (defun emulate-cycle (chip)
   (with-chip (chip)
     (debugger-print debugger chip)
-    (if (debugger-should-wait-p debugger)
+    (if (debugger-should-wait-p debugger program-counter)
       (sleep 10/1000)
       (let ((instruction (cat-bytes (aref memory program-counter)
                                     (aref memory (1+ program-counter)))))

vendor/make-quickutils.lisp

@@ -12,6 +12,7 @@
                :once-only
                :rcurry
                :read-file-into-byte-vector
+               :removef
                :symb
                :with-gensyms
                :xor

vendor/quickutils.lisp

@@ -2,7 +2,7 @@
 ;;;; See http://quickutil.org for details.
 
 ;;;; To regenerate:
-;;;; (qtlc:save-utils-as "quickutils.lisp" :utilities '(:COMPOSE :CURRY :ENSURE-BOOLEAN :ENSURE-GETHASH :ENSURE-LIST :ONCE-ONLY :RCURRY :READ-FILE-INTO-BYTE-VECTOR :SYMB :WITH-GENSYMS :XOR) :ensure-package T :package "CHIP8.QUICKUTILS")
+;;;; (qtlc:save-utils-as "quickutils.lisp" :utilities '(:COMPOSE :CURRY :ENSURE-BOOLEAN :ENSURE-GETHASH :ENSURE-LIST :ONCE-ONLY :RCURRY :READ-FILE-INTO-BYTE-VECTOR :REMOVEF :SYMB :WITH-GENSYMS :XOR) :ensure-package T :package "CHIP8.QUICKUTILS")
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (unless (find-package "CHIP8.QUICKUTILS")
@@ -18,9 +18,9 @@
                                          :ENSURE-GETHASH :ENSURE-LIST
                                          :ONCE-ONLY :RCURRY :WITH-OPEN-FILE*
                                          :WITH-INPUT-FROM-FILE
-                                         :READ-FILE-INTO-BYTE-VECTOR :MKSTR
-                                         :SYMB :STRING-DESIGNATOR :WITH-GENSYMS
-                                         :XOR))))
+                                         :READ-FILE-INTO-BYTE-VECTOR :REMOVEF
+                                         :MKSTR :SYMB :STRING-DESIGNATOR
+                                         :WITH-GENSYMS :XOR))))
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (defun make-gensym-list (length &optional (x "G"))
     "Returns a list of `length` gensyms, each generated as if with a call to `make-gensym`,
@@ -211,6 +211,16 @@ which is only sent to `with-open-file` when it's not `nil`."
           result))))
 
 
+  (declaim (inline remove/swapped-arguments))
+  (defun remove/swapped-arguments (sequence item &rest keyword-arguments)
+    (apply #'remove item sequence keyword-arguments))
+
+  (define-modify-macro removef (item &rest remove-keywords)
+    remove/swapped-arguments
+    "Modify-macro for `remove`. Sets place designated by the first argument to
+the result of calling `remove` with `item`, place, and the `keyword-arguments`.")
+  
+
   (defun mkstr (&rest args)
     "Receives any number of objects (string, symbol, keyword, char, number), extracts all printed representations, and concatenates them all into one string.
 
@@ -293,7 +303,7 @@ value."
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (export '(compose curry ensure-boolean ensure-gethash ensure-list once-only
-            rcurry read-file-into-byte-vector symb with-gensyms
+            rcurry read-file-into-byte-vector removef symb with-gensyms
             with-unique-names xor)))
 
 ;;;; END OF quickutils.lisp ;;;;