0.6.9.12:

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

diff --git a/src/code/debug.lisp b/src/code/debug.lisp
index b4115b5..b7709e1 100644 (file)
--- a/src/code/debug.lisp
+++ b/src/code/debug.lisp
@@ -10,9 +10,6 @@
 ;;;; files for more information.
 
 (in-package "SB!DEBUG")
 ;;;; files for more information.
 
 (in-package "SB!DEBUG")

-
-(file-comment
-  "$Header$")

 \f
 ;;;; variables and constants
 
 \f
 ;;;; variables and constants
 

@@ -25,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")

@@ -37,9 +34,8 @@
   #!+sb-doc
   "This is T while in the debugger.")
 
   #!+sb-doc
   "This is T while in the debugger.")
 

-(defvar *debug-command-level* 0
-  #!+sb-doc
-  "Pushes and pops/exits inside the debugger change this.")
+;;; nestedness inside debugger command loops
+(defvar *debug-command-level* 0)

 
 (defvar *stack-top-hint* nil
   #!+sb-doc
 
 (defvar *stack-top-hint* nil
   #!+sb-doc

@@ -50,44 +46,43 @@
 
 (defvar *current-frame* nil)
 
 
 (defvar *current-frame* nil)
 

-;;; the default for *DEBUG-PROMPT*
-(defun debug-prompt ()
-  (let ((*standard-output* *debug-io*))
-    (terpri)
-    (prin1 (sb!di:frame-number *current-frame*))
-    (dotimes (i *debug-command-level*) (princ "]"))
-    (princ " ")
-    (force-output)))
-
-(defparameter *debug-prompt* #'debug-prompt
-  #!+sb-doc
-  "a function of no arguments that prints the debugger prompt on *DEBUG-IO*")
-
+(defun debug-prompt (stream)
+
+  ;; old behavior, will probably go away in sbcl-0.7.x
+  (format stream "~%~D" (sb!di:frame-number *current-frame*))
+  (dotimes (i *debug-command-level*)
+    (write-char #\] stream))
+  (write-char #\space stream)
+
+  ;; planned new behavior, delayed since it will break ILISP
+  #+nil 
+  (format stream
+         "~%~D~:[~;[~D~]] "
+         (sb!di:frame-number *current-frame*)
+         (> *debug-command-level* 1)
+         *debug-command-level*))
+  

 (defparameter *debug-help-string*
 "The prompt is right square brackets, the number indicating how many
   recursive command loops you are in. 
 Any command may be uniquely abbreviated.
 (defparameter *debug-help-string*
 "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.

@@ -96,8 +91,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

@@ -493,10 +488,10 @@ Function and macro commands:
                                             s)))))
   string)
 
                                             s)))))
   string)
 

-;;; Print frame with verbosity level 1. If we hit a rest-arg, then
+;;; Print FRAME with verbosity level 1. If we hit a &REST arg, then

 ;;; print as many of the values as possible, punting the loop over
 ;;; lambda-list variables since any other arguments will be in the
 ;;; print as many of the values as possible, punting the loop over
 ;;; lambda-list variables since any other arguments will be in the

-;;; rest-arg's list of values.
+;;; &REST arg's list of values.

 (defun print-frame-call-1 (frame)
   (let* ((d-fun (sb!di:frame-debug-function frame))
         (loc (sb!di:frame-code-location frame))
 (defun print-frame-call-1 (frame)
   (let* ((d-fun (sb!di:frame-debug-function frame))
         (loc (sb!di:frame-code-location frame))

@@ -517,12 +512,15 @@ Function and macro commands:
                                               (second ele) frame))
                                     results))
                       (return))
                                               (second ele) frame))
                                     results))
                       (return))

-                    (push (make-unprintable-object "unavailable &REST arg")
+                    (push (make-unprintable-object
+                           "unavailable &REST argument")

                           results)))))
       (sb!di:lambda-list-unavailable
        ()
        (push (make-unprintable-object "lambda list unavailable") results)))
                           results)))))
       (sb!di:lambda-list-unavailable
        ()
        (push (make-unprintable-object "lambda list unavailable") results)))

-    (prin1 (mapcar #'ensure-printable-object (nreverse results)))
+    (pprint-logical-block (*standard-output* nil)
+      (let ((x (nreverse (mapcar #'ensure-printable-object results))))
+       (format t "(~@<~S~{ ~_~S~}~:>)" (first x) (rest x))))

     (when (sb!di:debug-function-kind d-fun)
       (write-char #\[)
       (prin1 (sb!di:debug-function-kind d-fun))
     (when (sb!di:debug-function-kind d-fun)
       (write-char #\[)
       (prin1 (sb!di:debug-function-kind d-fun))

@@ -539,12 +537,12 @@ Function and macro commands:
 
 (defun frame-call-arg (var location frame)
   (lambda-var-dispatch var location
 
 (defun frame-call-arg (var location frame)
   (lambda-var-dispatch var location

-    (make-unprintable-object "unused arg")
+    (make-unprintable-object "unused argument")

     (sb!di:debug-var-value var frame)
     (sb!di:debug-var-value var frame)

-    (make-unprintable-object "unavailable arg")))
+    (make-unprintable-object "unavailable argument")))

 
 

-;;; Prints a representation of the function call causing frame to
-;;; exist. Verbosity indicates the level of information to output;
+;;; Prints a representation of the function call causing FRAME to
+;;; exist. VERBOSITY indicates the level of information to output;

 ;;; zero indicates just printing the debug-function's name, and one
 ;;; indicates displaying call-like, one-liner format with argument
 ;;; values.
 ;;; zero indicates just printing the debug-function's name, and one
 ;;; indicates displaying call-like, one-liner format with argument
 ;;; values.

@@ -582,37 +580,55 @@ 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."
   (let ((old-hook *debugger-hook*))
     (when old-hook
       (let ((*debugger-hook* nil))
 (defun invoke-debugger (condition)
   #!+sb-doc
   "Enter the debugger."
   (let ((old-hook *debugger-hook*))
     (when old-hook
       (let ((*debugger-hook* nil))

-       (funcall hook condition hook))))
+       (funcall old-hook condition old-hook))))

   (sb!unix:unix-sigsetmask 0)
   (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))
     (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*.
-           (*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*)

@@ -620,19 +636,59 @@ Function and macro commands:
            (*print-readably* nil)
            (*print-pretty* t)
            (*package* original-package))
            (*print-readably* nil)
            (*print-pretty* t)
            (*package* original-package))

+
+       ;; Before we start our own output, finish any pending output.
+       ;; Otherwise, if the user tried to track the progress of
+       ;; his program using PRINT statements, he'd tend to lose
+       ;; the last line of output or so, and get confused.
+       (flush-standard-output-streams)
+
+       ;; The initial output here goes to *ERROR-OUTPUT*, because the
+       ;; initial output is not interactive, just an error message,
+       ;; and 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*
        (format *error-output*

-              "~2&debugger invoked on ~S of type ~S:~%  ~A~%"
-              '*debug-condition*
-              (type-of *debug-condition*)
-              *debug-condition*)
-       (let (;; FIXME: like the bindings of *STANDARD-INPUT* and
-            ;; *STANDARD-OUTPUT* above..
+              "~2&debugger invoked on condition of type ~S:~%  "
+              (type-of *debug-condition*))
+       (princ-debug-condition-carefully *error-output*)
+       (terpri *error-output*)
+
+       ;; After the initial error/condition/whatever announcement to
+       ;; *ERROR-OUTPUT*, we become interactive, and should talk on
+       ;; *DEBUG-IO* from now on. (KLUDGE: This is a normative
+       ;; statement, not a description of reality.:-| There's a lot of
+       ;; older debugger code which was written to do i/o on whatever
+       ;; stream was in fashion at the time, and not all of it has
+       ;; been converted to behave this way. -- WHN 2000-11-16)
+       (let (;; FIXME: The first two bindings here seem wrong,
+            ;; violating the principle of least surprise, and making
+            ;; it impossible for the user to do reasonable things
+            ;; like using PRINT at the debugger prompt to send output
+            ;; to the program's ordinary (possibly
+            ;; redirected-to-a-file) *STANDARD-OUTPUT*, or using
+            ;; PEEK-CHAR or some such thing on the program's ordinary
+            ;; (possibly also redirected) *STANDARD-INPUT*.
+            (*standard-input* *debug-io*)
+            (*standard-output* *debug-io*)
+            ;; This seems reasonable: e.g. if the user has redirected
+            ;; *ERROR-OUTPUT* to some log file, it's probably wrong
+            ;; to send errors which occur in interactive debugging to
+            ;; that file, and right to send them to *DEBUG-IO*.

             (*error-output* *debug-io*))
         (unless (typep condition 'step-condition)
             (*error-output* *debug-io*))
         (unless (typep condition 'step-condition)

-          (show-restarts *debug-restarts* *error-output*))
+          (format *debug-io*
+                  "~%~@<Within the debugger, you can type HELP for help. At ~
+                   any command prompt (within the debugger or not) you can ~
+                   type (SB-EXT:QUIT) to terminate the SBCL executable. ~
+                   The condition which caused the debugger to be entered ~
+                   is bound to ~S.~:@>~2%"
+                  '*debug-condition*)
+          (show-restarts *debug-restarts* *debug-io*)
+          (terpri *debug-io*))

         (internal-debug))))))
 
         (internal-debug))))))
 

-(defun show-restarts (restarts &optional (s *error-output*))
+(defun show-restarts (restarts s)

   (when restarts
     (format s "~&restarts:~%")
     (let ((count 0)
   (when restarts
     (format s "~&restarts:~%")
     (let ((count 0)

@@ -656,18 +712,17 @@ Function and macro commands:
                 (push name names-used))))
        (incf count)))))
 
                 (push name names-used))))
        (incf count)))))
 

-;;; This calls DEBUG-LOOP, performing some simple initializations before doing
-;;; so. INVOKE-DEBUGGER calls this to actually get into the debugger.
-;;; SB!CONDITIONS::ERROR-ERROR calls this in emergencies to get into a debug
-;;; prompt as quickly as possible with as little risk as possible for stepping
-;;; on whatever is causing recursive errors.
+;;; 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
+;;; to get into a debug prompt as quickly as possible with as little
+;;; risk as possible for stepping on whatever is causing recursive
+;;; errors.

 (defun internal-debug ()
   (let ((*in-the-debugger* t)
        (*read-suppress* nil))
     (unless (typep *debug-condition* 'step-condition)
 (defun internal-debug ()
   (let ((*in-the-debugger* t)
        (*read-suppress* nil))
     (unless (typep *debug-condition* 'step-condition)

-      (clear-input *debug-io*)
-      (format *debug-io*
-             "~&Within the debugger, you can type HELP for help.~%"))
+      (clear-input *debug-io*))

     #!-mp (debug-loop)
     #!+mp (sb!mp:without-scheduling (debug-loop))))
 \f
     #!-mp (debug-loop)
     #!+mp (sb!mp:without-scheduling (debug-loop))))
 \f

@@ -708,8 +763,11 @@ 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)
-               (funcall *debug-prompt*)
+             (with-simple-restart (abort
+                                  "Reduce debugger level (to debug level ~D)."
+                                   level)
+               (debug-prompt *debug-io*)
+               (force-output *debug-io*)

                (let ((input (sb!int:get-stream-command *debug-io*)))
                  (cond (input
                         (let ((cmd-fun (debug-command-p
                (let ((input (sb!int:get-stream-command *debug-io*)))
                  (cond (input
                         (let ((cmd-fun (debug-command-p

@@ -763,9 +821,7 @@ Function and macro commands:
     (unless (boundp '*)
       (setq * nil)
       (fresh-line)
     (unless (boundp '*)
       (setq * nil)
       (fresh-line)

-      ;; FIXME: Perhaps this shouldn't be WARN (for fear of complicating
-      ;; the debugging situation?) but at least it should go to *ERROR-OUTPUT*.
-      ;; (And probably it should just be WARN.)
+      ;; FIXME: The way INTERACTIVE-EVAL does this seems better.

       (princ "Setting * to NIL (was unbound marker)."))))
 \f
 ;;;; debug loop functions
       (princ "Setting * to NIL (was unbound marker)."))))
 \f
 ;;;; debug loop functions

@@ -823,8 +879,9 @@ Function and macro commands:
                   (:set
                    `(setf (sb!di:debug-var-value (car vars) *current-frame*)
                           ,value-var))))
                   (:set
                    `(setf (sb!di:debug-var-value (car vars) *current-frame*)
                           ,value-var))))

-              ;; If there weren't any exact matches, flame about ambiguity
-              ;; unless all the variables have the same name.
+              ;; If there weren't any exact matches, flame about
+              ;; ambiguity unless all the variables have the same
+              ;; name.

               ((and (not exact)
                     (find-if-not
                      #'(lambda (v)
               ((and (not exact)
                     (find-if-not
                      #'(lambda (v)

@@ -836,8 +893,8 @@ Function and macro commands:
                               (delete-duplicates
                                vars :test #'string=
                                :key #'sb!di:debug-var-symbol-name))))
                               (delete-duplicates
                                vars :test #'string=
                                :key #'sb!di:debug-var-symbol-name))))

-              ;; All names are the same, so see whether the user ID'ed one of
-              ;; them.
+              ;; All names are the same, so see whether the user
+              ;; ID'ed one of them.

               (id-supplied
                (let ((v (find id vars :key #'sb!di:debug-var-id)))
                  (unless v
               (id-supplied
                (let ((v (find id vars :key #'sb!di:debug-var-id)))
                  (unless v

@@ -879,11 +936,11 @@ Function and macro commands:
 (defun (setf var) (value name &optional (id 0 id-supplied))
   (define-var-operation :set value))
 
 (defun (setf var) (value name &optional (id 0 id-supplied))
   (define-var-operation :set value))
 

-;;; This returns the COUNT'th arg as the user sees it from args, the result of
-;;; SB!DI:DEBUG-FUNCTION-LAMBDA-LIST. If this returns a potential
-;;; DEBUG-VAR from the lambda-list, then the second value is T. If this
-;;; returns a keyword symbol or a value from a rest arg, then the second value
-;;; is NIL.
+;;; This returns the COUNT'th arg as the user sees it from args, the
+;;; result of SB!DI:DEBUG-FUNCTION-LAMBDA-LIST. If this returns a
+;;; potential DEBUG-VAR from the lambda-list, then the second value is
+;;; T. If this returns a keyword symbol or a value from a rest arg,
+;;; then the second value is NIL.

 (declaim (ftype (function (index list)) nth-arg))
 (defun nth-arg (count args)
   (let ((n count))
 (declaim (ftype (function (index list)) nth-arg))
 (defun nth-arg (count args)
   (let ((n count))

@@ -900,7 +957,7 @@ Function and macro commands:
        :rest ((let ((var (second ele)))
                 (lambda-var-dispatch var (sb!di:frame-code-location
                                           *current-frame*)
        :rest ((let ((var (second ele)))
                 (lambda-var-dispatch var (sb!di:frame-code-location
                                           *current-frame*)

-                  (error "unused REST-arg before n'th argument")
+                  (error "unused &REST argument before n'th argument")

                   (dolist (value
                            (sb!di:debug-var-value var *current-frame*)
                            (error
                   (dolist (value
                            (sb!di:debug-var-value var *current-frame*)
                            (error

@@ -909,7 +966,7 @@ Function and macro commands:
                     (if (zerop n)
                         (return-from nth-arg (values value nil))
                         (decf n)))
                     (if (zerop n)
                         (return-from nth-arg (values value nil))
                         (decf n)))

-                  (error "invalid REST-arg before n'th argument")))))
+                  (error "invalid &REST argument before n'th argument")))))

       (decf n))))
 
 (defun arg (n)
       (decf n))))
 
 (defun arg (n)

@@ -1037,12 +1094,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)

@@ -1077,17 +1137,25 @@ 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)))
     (when (eq num :prompt)
 
 (def-debug-command "RESTART" ()
   (let ((num (read-if-available :prompt)))
     (when (eq num :prompt)

-      (show-restarts *debug-restarts*)
+      (show-restarts *debug-restarts* *debug-io*)

       (write-string "restart: ")
       (force-output)
       (setf num (read *standard-input*)))
       (write-string "restart: ")
       (force-output)
       (setf num (read *standard-input*)))

@@ -1126,8 +1194,8 @@ Function and macro commands:
 (def-debug-command-alias "?" "HELP")
 
 (def-debug-command "ERROR" ()
 (def-debug-command-alias "?" "HELP")
 
 (def-debug-command "ERROR" ()

-  (format t "~A~%" *debug-condition*)
-  (show-restarts *debug-restarts*))
+  (format *debug-io* "~A~%" *debug-condition*)
+  (show-restarts *debug-restarts* *debug-io*))

 
 (def-debug-command "BACKTRACE" ()
   (backtrace (read-if-available most-positive-fixnum)))
 
 (def-debug-command "BACKTRACE" ()
   (backtrace (read-if-available most-positive-fixnum)))

@@ -1177,8 +1245,9 @@ Function and macro commands:
 \f
 ;;;; source location printing
 
 \f
 ;;;; source location printing
 

-;;; We cache a stream to the last valid file debug source so that we won't have
-;;; to repeatedly open the file.
+;;; We cache a stream to the last valid file debug source so that we
+;;; won't have to repeatedly open the file.
+;;;

 ;;; KLUDGE: This sounds like a bug, not a feature. Opening files is fast
 ;;; in the 1990s, so the benefit is negligible, less important than the
 ;;; potential of extra confusion if someone changes the source during
 ;;; KLUDGE: This sounds like a bug, not a feature. Opening files is fast
 ;;; in the 1990s, so the benefit is negligible, less important than the
 ;;; potential of extra confusion if someone changes the source during

@@ -1201,16 +1270,17 @@ Function and macro commands:
                   *cached-readtable* nil))
         sb!int:*before-save-initializations*)
 
                   *cached-readtable* nil))
         sb!int:*before-save-initializations*)
 

-;;; 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.
+;;; 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)
 (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*)
 
 (defvar *cached-top-level-form*)
 (defvar *cached-form-number-translations*)
 

-;;; Given a code location, return the associated form-number translations and
-;;; the actual top-level form. We check our cache --- if there is a miss, we
-;;; dispatch on the kind of the debug source.
+;;; Given a code location, return the associated form-number
+;;; translations and the actual top-level form. We check our cache ---
+;;; if there is a miss, we dispatch on the kind of the debug source.

 (defun get-top-level-form (location)
   (let ((d-source (sb!di:code-location-debug-source location)))
     (if (and (eq d-source *cached-debug-source*)
 (defun get-top-level-form (location)
   (let ((d-source (sb!di:code-location-debug-source location)))
     (if (and (eq d-source *cached-debug-source*)

@@ -1227,9 +1297,9 @@ Function and macro commands:
                        (sb!di:form-number-translations res offset))
                  (setq *cached-top-level-form* res))))))
 
                        (sb!di:form-number-translations res offset))
                  (setq *cached-top-level-form* res))))))
 

-;;; Locates the source file (if it still exists) and grabs the top-level form.
-;;; If the file is modified, we use the top-level-form offset instead of the
-;;; recorded character offset.
+;;; Locate the source file (if it still exists) and grab the top-level
+;;; form. If the file is modified, we use the top-level-form offset
+;;; instead of the recorded character offset.

 (defun get-file-top-level-form (location)
   (let* ((d-source (sb!di:code-location-debug-source location))
         (tlf-offset (sb!di:code-location-top-level-form-offset location))
 (defun get-file-top-level-form (location)
   (let* ((d-source (sb!di:code-location-debug-source location))
         (tlf-offset (sb!di:code-location-top-level-form-offset location))

@@ -1298,9 +1368,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)