;;;; files for more information.
(in-package "SB!DEBUG")
-
-(file-comment
- "$Header$")
\f
;;;; variables and constants
"*PRINT-LENGTH* for the debugger")
(defvar *debug-readtable*
- ;; KLUDGE: This can't be initialized in a cold toplevel form, because the
- ;; *STANDARD-READTABLE* isn't initialized until after cold toplevel forms
- ;; have run. So instead we initialize it immediately after
- ;; *STANDARD-READTABLE*. -- WHN 20000205
+ ;; KLUDGE: This can't be initialized in a cold toplevel form,
+ ;; because the *STANDARD-READTABLE* isn't initialized until after
+ ;; cold toplevel forms have run. So instead we initialize it
+ ;; immediately after *STANDARD-READTABLE*. -- WHN 20000205
nil
#!+sb-doc
"*READTABLE* for the debugger")
"The prompt is right square brackets, the number indicating how many
recursive command loops you are in.
Any command may be uniquely abbreviated.
-The debugger rebinds various special variables for controlling i/o,
- sometimes to defaults (a la WITH-STANDARD-IO-SYNTAX) and sometimes to
- its own values, e.g. SB-DEBUG:*DEBUG-PRINT-LEVEL*.
+The debugger rebinds various special variables for controlling i/o, sometimes
+ to defaults (much like WITH-STANDARD-IO-SYNTAX does) and sometimes to
+ its own special values, e.g. SB-DEBUG:*DEBUG-PRINT-LEVEL*.
Debug commands do not affect * and friends, but evaluation in the debug loop
- do affect these variables.
+ does affect these variables.
SB-DEBUG:*FLUSH-DEBUG-ERRORS* controls whether errors at the debug prompt
drop you into deeper into the debugger.
Getting in and out of the debugger:
- Q throws to top level.
- GO calls CONTINUE which tries to proceed with the restart 'CONTINUE.
RESTART invokes restart numbered as shown (prompt if not given).
ERROR prints the error condition and restart cases.
-
The name of any restart, or its number, is a valid command, and is the same
as using RESTART to invoke that restart.
Changing frames:
- U up frame D down frame
- T top frame B bottom frame
- F n frame n
+ U up frame D down frame
+ B bottom frame F n frame n (n=0 for top frame)
Inspecting frames:
BACKTRACE [n] shows n frames going down the stack.
SOURCE [n] displays frame's source form with n levels of enclosing forms.
Breakpoints and steps:
- LIST-LOCATIONS [{function | :c}] List the locations for breakpoints.
- Specify :c for the current frame.
+ LIST-LOCATIONS [{function | :C}] List the locations for breakpoints.
+ Specify :C for the current frame.
Abbreviation: LL
LIST-BREAKPOINTS List the active breakpoints.
Abbreviations: LB, LBP
(defvar *debug-restarts*)
(defvar *debug-condition*)
+;;; Print *DEBUG-CONDITION*, taking care to avoid recursive invocation
+;;; of the debugger in case of a problem (e.g. a bug in the PRINT-OBJECT
+;;; method for *DEBUG-CONDITION*).
+(defun princ-debug-condition-carefully (stream)
+ (handler-case (princ *debug-condition* stream)
+ (error (condition)
+ (format stream
+ " (caught ~S when trying to print ~S)"
+ (type-of condition)
+ '*debug-condition*)))
+ *debug-condition*)
+
(defun invoke-debugger (condition)
#!+sb-doc
"Enter the debugger."
(let ((*debugger-hook* nil))
(funcall hook condition hook))))
(sb!unix:unix-sigsetmask 0)
- (let ((original-package *package*)) ; protect it from WITH-STANDARD-IO-SYNTAX
+
+ ;; Elsewhere in the system, we use the SANE-PACKAGE function for
+ ;; this, but here causing an exception just as we're trying to handle
+ ;; an exception would be confusing, so instead we use a special hack.
+ (unless (and (packagep *package*)
+ (package-name *package*))
+ (setf *package* (find-package :cl-user))
+ (format *error-output*
+ "The value of ~S was not an undeleted PACKAGE. It has been
+reset to ~S."
+ '*package* *package*))
+ (let (;; Save *PACKAGE* to protect it from WITH-STANDARD-IO-SYNTAX.
+ (original-package *package*))
(with-standard-io-syntax
(let* ((*debug-condition* condition)
(*debug-restarts* (compute-restarts condition))
;; FIXME: The next two bindings seem flaky, violating the
- ;; principle of least surprise. But in order to fix them, we'd
- ;; need to go through all the i/o statements in the debugger,
- ;; since a lot of them do their thing on *STANDARD-INPUT* and
- ;; *STANDARD-OUTPUT* instead of *DEBUG-IO*.
+ ;; principle of least surprise. But in order to fix them,
+ ;; we'd need to go through all the i/o statements in the
+ ;; debugger, since a lot of them do their thing on
+ ;; *STANDARD-INPUT* and *STANDARD-OUTPUT* instead of
+ ;; *DEBUG-IO*.
(*standard-input* *debug-io*) ; in case of setq
(*standard-output* *debug-io*) ; '' '' '' ''
- ;; We also want to set the i/o subsystem into a known, useful
- ;; state, regardless of where in the debugger was invoked in the
- ;; program. WITH-STANDARD-IO-SYNTAX does some of that, but
- ;; 1. It doesn't affect our internal special variables like
- ;; *CURRENT-LEVEL*.
+ ;; We want the i/o subsystem to be in a known, useful
+ ;; state, regardless of where the debugger was invoked in
+ ;; the program. WITH-STANDARD-IO-SYNTAX does some of that,
+ ;; but
+ ;; 1. It doesn't affect our internal special variables
+ ;; like *CURRENT-LEVEL*.
;; 2. It isn't customizable.
- ;; 3. It doesn't set *PRINT-READABLY* or *PRINT-PRETTY* to the
- ;; same value as the toplevel default.
+ ;; 3. It doesn't set *PRINT-READABLY* or *PRINT-PRETTY*
+ ;; to the same value as the toplevel default.
;; 4. It sets *PACKAGE* to COMMON-LISP-USER, which is not
;; helpful behavior for a debugger.
- ;; We try to remedy all these problems with explicit rebindings
- ;; here.
+ ;; We try to remedy all these problems with explicit
+ ;; rebindings here.
(sb!kernel:*current-level* 0)
(*print-length* *debug-print-length*)
(*print-level* *debug-print-level*)
(*print-readably* nil)
(*print-pretty* t)
(*package* original-package))
+ #!+sb-show (sb!conditions::show-condition *debug-condition*
+ *error-output*)
(format *error-output*
- "~2&debugger invoked on ~S of type ~S:~% ~A~%"
+ "~2&debugger invoked on ~S of type ~S:~% "
'*debug-condition*
- (type-of *debug-condition*)
- *debug-condition*)
+ (type-of *debug-condition*))
+ (princ-debug-condition-carefully *error-output*)
+ (terpri *error-output*)
(let (;; FIXME: like the bindings of *STANDARD-INPUT* and
;; *STANDARD-OUTPUT* above..
(*error-output* *debug-io*))
;; WITH-SIMPLE-RESTART.
(let ((level *debug-command-level*)
(restart-commands (make-restart-commands)))
- (with-simple-restart (abort "Return to debug level ~D." level)
+ (with-simple-restart (abort
+ "Reduce debugger level (to debug level ~D)."
+ level)
(funcall *debug-prompt*)
(let ((input (sb!int:get-stream-command *debug-io*)))
(cond (input
(def-debug-command-alias "D" "DOWN")
-(def-debug-command "TOP" ()
- (do ((prev *current-frame* lead)
- (lead (sb!di:frame-up *current-frame*) (sb!di:frame-up lead)))
- ((null lead)
- (setf *current-frame* prev)
- (print-frame-call prev))))
+;;; CMU CL had this command, but SBCL doesn't, since
+;;; it's redundant with "FRAME 0", and it interferes with abbreviations
+;;; for the TOPLEVEL restart.
+;;;(def-debug-command "TOP" ()
+;;; (do ((prev *current-frame* lead)
+;;; (lead (sb!di:frame-up *current-frame*) (sb!di:frame-up lead)))
+;;; ((null lead)
+;;; (setf *current-frame* prev)
+;;; (print-frame-call prev))))
(def-debug-command "BOTTOM" ()
(do ((prev *current-frame* lead)
\f
;;;; commands for entering and leaving the debugger
-(def-debug-command "QUIT" ()
- (throw 'sb!impl::top-level-catcher nil))
+;;; CMU CL supported this QUIT debug command, but SBCL provides this
+;;; functionality with a restart instead. (The QUIT debug command was
+;;; removed because it's confusing to have "quit" mean two different
+;;; things in the system, "restart the top level REPL" in the debugger
+;;; and "terminate the Lisp system" as the SB-EXT:QUIT function.)
+;;;
+;;;(def-debug-command "QUIT" ()
+;;; (throw 'sb!impl::top-level-catcher nil))
-(def-debug-command "GO" ()
- (continue *debug-condition*)
- (error "There is no restart named CONTINUE."))
+;;; CMU CL supported this GO debug command, but SBCL doesn't -- just
+;;; type the CONTINUE restart name.
+;;;(def-debug-command "GO" ()
+;;; (continue *debug-condition*)
+;;; (error "There is no restart named CONTINUE."))
(def-debug-command "RESTART" ()
(let ((num (read-if-available :prompt)))
;;; We also cache the last top-level form that we printed a source for so that
;;; we don't have to do repeated reads and calls to FORM-NUMBER-TRANSLATIONS.
(defvar *cached-top-level-form-offset* nil)
-(declaim (type (or sb!kernel:index null) *cached-top-level-form-offset*))
+(declaim (type (or index null) *cached-top-level-form-offset*))
(defvar *cached-top-level-form*)
(defvar *cached-form-number-translations*)
(continue *debug-condition*)
(error "couldn't continue"))
-;;; List possible breakpoint locations, which ones are active, and where GO
-;;; will continue. Set *POSSIBLE-BREAKPOINTS* to the code-locations which can
-;;; then be used by sbreakpoint.
+;;; List possible breakpoint locations, which ones are active, and
+;;; where the CONTINUE restart will transfer control. Set
+;;; *POSSIBLE-BREAKPOINTS* to the code-locations which can then be
+;;; used by sbreakpoint.
(def-debug-command "LIST-LOCATIONS" ()
(let ((df (read-if-available *default-breakpoint-debug-function*)))
(cond ((consp df)