0.6.8.12:

[sbcl.git] / src / code / debug.lisp

diff --git a/src/code/debug.lisp b/src/code/debug.lisp
index 79f9504..80ae5ca 100644 (file)
--- a/src/code/debug.lisp
+++ b/src/code/debug.lisp
@@ -22,10 +22,10 @@
   "*PRINT-LENGTH* for the debugger")
 
 (defvar *debug-readtable*
   "*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")
   nil
   #!+sb-doc
   "*READTABLE* for the debugger")

@@ -64,27 +64,23 @@
 "The prompt is right square brackets, the number indicating how many
   recursive command loops you are in. 
 Any command may be uniquely abbreviated.
 "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
 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:
 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.
   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:
   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.
 
 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:
   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
     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*)
 
 (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."
 (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 ((*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
     (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*) ; ''  ''  ''  ''
            (*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.
            ;;   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.
            ;;   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*)
            (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))
            (*print-readably* nil)
            (*print-pretty* t)
            (*package* original-package))

+       #!+sb-show (sb!conditions::show-condition *debug-condition*
+                                                *error-output*)

        (format *error-output*
        (format *error-output*

-              "~2&debugger invoked on ~S of type ~S:~%  ~A~%"
+              "~2&debugger invoked on ~S of type ~S:~%  "

               '*debug-condition*
               '*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*))
        (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.
            (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
                (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-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)
 
 (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
 
 \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)))
 
 (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"))
 
   (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)
 (def-debug-command "LIST-LOCATIONS" ()
   (let ((df (read-if-available *default-breakpoint-debug-function*)))
     (cond ((consp df)