0.6.8.12:
[sbcl.git] / src / code / debug.lisp
index 79f9504..80ae5ca 100644 (file)
   "*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.
@@ -93,8 +89,8 @@ Inspecting frames:
   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
@@ -579,6 +575,18 @@ Function and macro commands:
 (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."
@@ -587,29 +595,43 @@ Function and macro commands:
       (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*)
@@ -617,11 +639,14 @@ Function and macro commands:
            (*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*))
@@ -705,7 +730,9 @@ Function and macro commands:
            ;; 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
@@ -1034,12 +1061,15 @@ Function and macro commands:
 
 (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)
@@ -1074,12 +1104,20 @@ Function and macro commands:
 \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)))
@@ -1295,9 +1333,10 @@ Function and macro commands:
   (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)