SOURCE [n] displays frame's source form with n levels of enclosing forms.
Stepping:
- STEP Selects the CONTINUE restart if one exists and starts
+ START Selects the CONTINUE restart if one exists and starts
single-stepping. Single stepping affects only code compiled with
under high DEBUG optimization quality. See User Manual for details.
+ STEP Steps into the current form.
+ NEXT Steps over the current form.
+ OUT Stops stepping temporarily, but resumes it when the topmost frame that
+ was stepped into returns.
+ STOP Stops single-stepping.
Function and macro commands:
(SB-DEBUG:ARG n)
) ; EVAL-WHEN
-;;; This is used in constructing arg lists for debugger printing when
-;;; the arg list is unavailable, some arg is unavailable or unused, etc.
-(defstruct (unprintable-object
- (:constructor make-unprintable-object (string))
- (:print-object (lambda (x s)
- (print-unreadable-object (x s)
- (write-string (unprintable-object-string x)
- s))))
- (:copier nil))
- string)
-
;;; Extract the function argument values for a debug frame.
(defun frame-args-as-list (frame)
(let ((debug-fun (sb!di:frame-debug-fun frame))
(nreverse (mapcar #'cdr *debug-print-variable-alist*))
(apply fun rest)))))))
-;;; the ordinary ANSI case of INVOKE-DEBUGGER, when not suppressed by
-;;; command-line --disable-debugger option
(defun invoke-debugger (condition)
#!+sb-doc
"Enter the debugger."
- (let ((old-hook *debugger-hook*))
- (when old-hook
- (let ((*debugger-hook* nil))
- (funcall old-hook condition old-hook))))
+ ;; call *INVOKE-DEBUGGER-HOOK* first, so that *DEBUGGER-HOOK* is not
+ ;; called when the debugger is disabled
(let ((old-hook *invoke-debugger-hook*))
(when old-hook
(let ((*invoke-debugger-hook* nil))
(funcall old-hook condition old-hook))))
-
- ;; Note: CMU CL had (SB-UNIX:UNIX-SIGSETMASK 0) here, to reset the
- ;; signal state in the case that we wind up in the debugger as a
- ;; result of something done by a signal handler. It's not
- ;; altogether obvious that this is necessary, and indeed SBCL has
- ;; not been doing it since 0.7.8.5. But nobody seems altogether
- ;; convinced yet
- ;; -- dan 2003.11.11, based on earlier comment of WHN 2002-09-28
+ (let ((old-hook *debugger-hook*))
+ (when old-hook
+ (let ((*debugger-hook* nil))
+ (funcall old-hook condition old-hook))))
;; We definitely want *PACKAGE* to be of valid type.
;;
(funcall-with-debug-io-syntax #'%invoke-debugger condition))
-(defun %invoke-debugger (condition)
+(defun %print-debugger-invocation-reason (condition stream)
+ (format stream "~2&")
+ ;; Note: Ordinarily it's only a matter of taste whether to use
+ ;; FORMAT "~<...~:>" or to use PPRINT-LOGICAL-BLOCK directly, but
+ ;; until bug 403 is fixed, PPRINT-LOGICAL-BLOCK (STREAM NIL) is
+ ;; definitely preferred, because the FORMAT alternative was acting odd.
+ (pprint-logical-block (stream nil)
+ (format stream
+ "debugger invoked on a ~S~@[ in thread ~A~]: ~2I~_~A"
+ (type-of condition)
+ #!+sb-thread sb!thread:*current-thread*
+ #!-sb-thread nil
+ condition))
+ (terpri stream))
+(defun %invoke-debugger (condition)
(let ((*debug-condition* condition)
(*debug-restarts* (compute-restarts condition))
(*nested-debug-condition* nil))
;; when people redirect *ERROR-OUTPUT*, they could reasonably
;; expect to see error messages logged there, regardless of what
;; the debugger does afterwards.)
- (format *error-output*
- "~2&~@<debugger invoked on a ~S~@[ in thread ~A~]: ~
- ~2I~_~A~:>~%"
- (type-of *debug-condition*)
- #!+sb-thread sb!thread:*current-thread*
- #!-sb-thread nil
- *debug-condition*)
+ (unless (typep condition 'step-condition)
+ (%print-debugger-invocation-reason condition *error-output*))
(error (condition)
(setf *nested-debug-condition* condition)
(let ((ndc-type (type-of *nested-debug-condition*)))
'*debug-condition*
ndc-type
'*nested-debug-condition*))
- (when (typep condition 'cell-error)
+ (when (typep *nested-debug-condition* 'cell-error)
;; what we really want to know when it's e.g. an UNBOUND-VARIABLE:
(format *error-output*
"~&(CELL-ERROR-NAME ~S) = ~S~%"
- '*debug-condition*
- (cell-error-name *debug-condition*)))))
+ '*nested-debug-condition*
+ (cell-error-name *nested-debug-condition*)))))
(let ((background-p (sb!thread::debugger-wait-until-foreground-thread
*debug-io*)))
"Argh! error within --disable-debugger error handling"))
(failure-quit :recklessly-p t)))))
+(defvar *old-debugger-hook* nil)
+
;;; halt-on-failures and prompt-on-failures modes, suitable for
;;; noninteractive and interactive use respectively
(defun disable-debugger ()
- (when (eql *invoke-debugger-hook* nil)
- (setf *debug-io* *error-output*
- *invoke-debugger-hook* 'debugger-disabled-hook)))
+ ;; *DEBUG-IO* used to be set here to *ERROR-OUTPUT* which is sort
+ ;; of unexpected but mostly harmless, but then ENABLE-DEBUGGER had
+ ;; to set it to a suitable value again and be very careful,
+ ;; especially if the user has also set it. -- MG 2005-07-15
+ (unless (eq *invoke-debugger-hook* 'debugger-disabled-hook)
+ (setf *old-debugger-hook* *invoke-debugger-hook*
+ *invoke-debugger-hook* 'debugger-disabled-hook))
+ ;; This is not inside the UNLESS to ensure that LDB is disabled
+ ;; regardless of what the old value of *INVOKE-DEBUGGER-HOOK* was.
+ ;; This might matter for example when restoring a core.
+ (sb!alien:alien-funcall (sb!alien:extern-alien "disable_lossage_handler"
+ (function sb!alien:void))))
(defun enable-debugger ()
(when (eql *invoke-debugger-hook* 'debugger-disabled-hook)
- (setf *debug-io* *query-io*
- *invoke-debugger-hook* nil)))
-
-(setf *debug-io* *query-io*)
+ (setf *invoke-debugger-hook* *old-debugger-hook*
+ *old-debugger-hook* nil))
+ (sb!alien:alien-funcall (sb!alien:extern-alien "enable_lossage_handler"
+ (function sb!alien:void))))
(defun show-restarts (restarts s)
(cond ((null restarts)
(defvar *debug-loop-fun* #'debug-loop-fun
"a function taking no parameters that starts the low-level debug loop")
+;;; When the debugger is invoked due to a stepper condition, we don't
+;;; want to print the current frame before the first prompt for aesthetic
+;;; reasons.
+(defvar *suppress-frame-print* nil)
+
;;; This calls DEBUG-LOOP, performing some simple initializations
;;; before doing so. INVOKE-DEBUGGER calls this to actually get into
;;; the debugger. SB!KERNEL::ERROR-ERROR calls this in emergencies
(*read-suppress* nil))
(unless (typep *debug-condition* 'step-condition)
(clear-input *debug-io*))
- (funcall *debug-loop-fun*)))
+ (let ((*suppress-frame-print* (typep *debug-condition* 'step-condition)))
+ (funcall *debug-loop-fun*))))
\f
;;;; DEBUG-LOOP
"When set, avoid calling INVOKE-DEBUGGER recursively when errors occur while
executing in the debugger.")
+(defun debug-read (stream)
+ (declare (type stream stream))
+ (let* ((eof-marker (cons nil nil))
+ (form (read stream nil eof-marker)))
+ (if (eq form eof-marker)
+ (abort)
+ form)))
+
(defun debug-loop-fun ()
(let* ((*debug-command-level* (1+ *debug-command-level*))
(*real-stack-top* (sb!di:top-frame))
(princ condition *debug-io*)
(/show0 "handling d-c by THROWing DEBUG-LOOP-CATCHER")
(throw 'debug-loop-catcher nil))))
- (terpri *debug-io*)
- (print-frame-call *current-frame* *debug-io* :verbosity 2)
+ (cond (*suppress-frame-print*
+ (setf *suppress-frame-print* nil))
+ (t
+ (terpri *debug-io*)
+ (print-frame-call *current-frame* *debug-io* :verbosity 2)))
(loop
- (catch 'debug-loop-catcher
- (handler-bind ((error (lambda (condition)
- (when *flush-debug-errors*
- (clear-input *debug-io*)
- (princ condition *debug-io*)
- (format *debug-io*
- "~&error flushed (because ~
+ (catch 'debug-loop-catcher
+ (handler-bind ((error (lambda (condition)
+ (when *flush-debug-errors*
+ (clear-input *debug-io*)
+ (princ condition *debug-io*)
+ (format *debug-io*
+ "~&error flushed (because ~
~S is set)"
- '*flush-debug-errors*)
- (/show0 "throwing DEBUG-LOOP-CATCHER")
- (throw 'debug-loop-catcher nil)))))
- ;; We have to bind LEVEL for the restart function created by
- ;; WITH-SIMPLE-RESTART.
- (let ((level *debug-command-level*)
- (restart-commands (make-restart-commands)))
- (with-simple-restart (abort
- "~@<Reduce debugger level (to debug level ~W).~@:>"
- level)
- (debug-prompt *debug-io*)
- (force-output *debug-io*)
- (let* ((exp (read *debug-io*))
- (cmd-fun (debug-command-p exp restart-commands)))
- (cond ((not cmd-fun)
- (debug-eval-print exp))
- ((consp cmd-fun)
- (format *debug-io*
- "~&Your command, ~S, is ambiguous:~%"
- exp)
- (dolist (ele cmd-fun)
- (format *debug-io* " ~A~%" ele)))
- (t
- (funcall cmd-fun))))))))))))
+ '*flush-debug-errors*)
+ (/show0 "throwing DEBUG-LOOP-CATCHER")
+ (throw 'debug-loop-catcher nil)))))
+ ;; We have to bind LEVEL for the restart function created by
+ ;; WITH-SIMPLE-RESTART.
+ (let ((level *debug-command-level*)
+ (restart-commands (make-restart-commands)))
+ (flush-standard-output-streams)
+ (debug-prompt *debug-io*)
+ (force-output *debug-io*)
+ (let* ((exp (debug-read *debug-io*))
+ (cmd-fun (debug-command-p exp restart-commands)))
+ (with-simple-restart (abort
+ "~@<Reduce debugger level (to debug level ~W).~@:>"
+ level)
+ (cond ((not cmd-fun)
+ (debug-eval-print exp))
+ ((consp cmd-fun)
+ (format *debug-io*
+ "~&Your command, ~S, is ambiguous:~%"
+ exp)
+ (dolist (ele cmd-fun)
+ (format *debug-io* " ~A~%" ele)))
+ (t
+ (funcall cmd-fun))))))))))))
(defun debug-eval-print (expr)
(/noshow "entering DEBUG-EVAL-PRINT" expr)
(let ((num (read-if-available :prompt)))
(when (eq num :prompt)
(show-restarts *debug-restarts* *debug-io*)
- (write-string "restart: ")
- (force-output)
+ (write-string "restart: " *debug-io*)
+ (force-output *debug-io*)
(setf num (read *debug-io*)))
(let ((restart (typecase num
(unsigned-byte
(svref translations form-num)
context))))
\f
-;;; step to the next steppable form
-(!def-debug-command "STEP" ()
- (let ((restart (find-restart 'continue *debug-condition*)))
- (cond (restart
- (setf *stepping* t
- *step* t)
+
+;;; start single-stepping
+(!def-debug-command "START" ()
+ (if (typep *debug-condition* 'step-condition)
+ (format *debug-io* "~&Already single-stepping.~%")
+ (let ((restart (find-restart 'continue *debug-condition*)))
+ (cond (restart
+ (sb!impl::enable-stepping)
+ (invoke-restart restart))
+ (t
+ (format *debug-io* "~&Non-continuable error, cannot start stepping.~%"))))))
+
+(defmacro def-step-command (command-name restart-name)
+ `(!def-debug-command ,command-name ()
+ (if (typep *debug-condition* 'step-condition)
+ (let ((restart (find-restart ',restart-name *debug-condition*)))
+ (aver restart)
(invoke-restart restart))
- (t
- (format *debug-io* "~&Non-continuable error, cannot step.~%")))))
+ (format *debug-io* "~&Not currently single-stepping. (Use START to activate the single-stepper)~%"))))
+
+(def-step-command "STEP" step-into)
+(def-step-command "NEXT" step-next)
+(def-step-command "STOP" step-continue)
+
+(!def-debug-command-alias "S" "STEP")
+(!def-debug-command-alias "N" "NEXT")
+
+(!def-debug-command "OUT" ()
+ (if (typep *debug-condition* 'step-condition)
+ (if sb!impl::*step-out*
+ (let ((restart (find-restart 'step-out *debug-condition*)))
+ (aver restart)
+ (invoke-restart restart))
+ (format *debug-io* "~&OUT can only be used step out of frames that were originally stepped into with STEP.~%"))
+ (format *debug-io* "~&Not currently single-stepping. (Use START to activate the single-stepper)~%")))
;;; miscellaneous commands
projects / sbcl.git / blobdiff