+(defun pop-cmd (&optional (n 1))
+ (cond
+ (*inspect-break*
+ (throw 'repl-catcher (values :inspect n)))
+ ((plusp *break-level*)
+ (throw 'repl-catcher (values :pop n))))
+ (values))
+
+(defun bt-cmd (&optional (n most-positive-fixnum))
+ (sb-debug::backtrace n))
+
+(defun current-cmd ()
+ (sb-debug::describe-debug-command))
+
+(defun top-cmd ()
+ (sb-debug::frame-debug-command 0))
+
+(defun bottom-cmd ()
+ (sb-debug::bottom-debug-command))
+
+(defun up-cmd (&optional (n 1))
+ (dotimes (i n)
+ (if (and sb-debug::*current-frame*
+ (sb-di:frame-up sb-debug::*current-frame*))
+ (sb-debug::up-debug-command)
+ (progn
+ (format *output* "Top of the stack")
+ (return-from up-cmd)))))
+
+(defun dn-cmd (&optional (n 1))
+ (dotimes (i n)
+ (if (and sb-debug::*current-frame*
+ (sb-di:frame-down sb-debug::*current-frame*))
+ (sb-debug::down-debug-command)
+ (progn
+ (format *output* "Bottom of the stack")
+ (return-from dn-cmd)))))
+
+(defun continue-cmd (&optional (num 0))
+ ;; don't look at first restart
+ (let ((restarts (compute-restarts)))
+ (if restarts
+ (let ((restart
+ (typecase num
+ (unsigned-byte
+ (if (< -1 num (length restarts))
+ (nth num restarts)
+ (progn
+ (format *output* "There is no such restart")
+ (return-from continue-cmd))))
+ (symbol
+ (find num (the list restarts)
+ :key #'restart-name
+ :test (lambda (sym1 sym2)
+ (string= (symbol-name sym1)
+ (symbol-name sym2)))))
+ (t
+ (format *output* "~S is invalid as a restart name" num)
+ (return-from continue-cmd nil)))))
+ (when restart
+ (invoke-restart-interactively restart)))
+ (format *output* "~&There are no restarts"))))
+
+(defun error-cmd ()
+ (when (plusp *break-level*)
+ (if *inspect-break*
+ (sb-debug::show-restarts (compute-restarts) *output*)
+ (let ((sb-debug::*debug-restarts* (compute-restarts)))
+ (sb-debug::error-debug-command)))))
+
+(defun frame-cmd ()
+ (sb-debug::print-frame-call sb-debug::*current-frame*))
+
+(defun zoom-cmd ()
+ )
+
+(defun local-cmd (&optional var)
+ (declare (ignore var))
+ (sb-debug::list-locals-debug-command))
+
+(defun processes-cmd ()
+ #+sb-thread
+ (let ((pids (thread-pids))
+ (current-pid (sb-thread:current-thread-id)))
+ (dolist (pid pids)
+ (format *output* "~&~D" pid)
+ (when (= pid current-pid)
+ (format *output* " [current listener]"))))
+ #-sb-thread
+ (format *output* "~&Threads are not supported in this version of sbcl")
+ (values))
+
+(defun kill-cmd (&rest selected-pids)
+ #+sb-thread
+ (let ((pids (thread-pids)))
+ (dolist (selected-pid selected-pids)
+ (if (find selected-pid pids :test #'eql)
+ (progn
+ (sb-thread:destroy-thread selected-pid)
+ (format *output* "~&Thread ~A destroyed" selected-pid))
+ (format *output* "~&No thread ~A exists" selected-pid))))
+ #-sb-thread
+ (declare (ignore selected-pids))
+ #-sb-thread
+ (format *output* "~&Threads are not supported in this version of sbcl")
+ (values))
+
+(defun signal-cmd (signal &rest selected-pids)
+ #+sb-thread
+ (let ((pids (thread-pids)))
+ (dolist (selected-pid selected-pids)
+ (if (find selected-pid pids :test #'eql)
+ (progn
+ (sb-unix:unix-kill selected-pid signal)
+ (format *output* "~&Signal ~A sent to thread ~A"
+ signal selected-pid))
+ (format *output* "~&No thread ~A exists" selected-pid))))
+ #-sb-thread
+ (declare (ignore signal selected-pids))
+ #-sb-thread
+ (format *output* "~&Threads are not supported in this version of sbcl")
+ (values))
+
+(defun focus-cmd (&optional process)
+ #-sb-thread
+ (declare (ignore process))
+ #+sb-thread
+ (when process
+ (format *output* "~&Focusing on next thread waiting waiting for the debugger~%"))
+ #+sb-thread
+ (progn
+ (sb-thread:release-foreground)
+ (sleep 1))
+ #-sb-thread
+ (format *output* "~&Threads are not supported in this version of sbcl")
+ (values))
+
+(defun reset-cmd ()
+ ;; The last restart goes to the toplevel
+ (invoke-restart-interactively (car (last (compute-restarts)))))
+