0.6.8.12:
[sbcl.git] / src / code / debug.lisp
index 0c6b537..80ae5ca 100644 (file)
   "*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")
 "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
@@ -599,7 +595,19 @@ 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*)) ; protected 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))
@@ -722,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
@@ -1051,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)
@@ -1091,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)))
@@ -1312,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)