X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fdebug.lisp;h=80ae5cae7642fb56c91f49c1f3df42ce042c41f9;hb=b1de52969f584c63d43fb35da4a8a6a4e0e619f0;hp=b4115b587fec36ea2555739d7d925b8efcde6a8e;hpb=a530bbe337109d898d5b4a001fc8f1afa3b5dc39;p=sbcl.git diff --git a/src/code/debug.lisp b/src/code/debug.lisp index b4115b5..80ae5ca 100644 --- a/src/code/debug.lisp +++ b/src/code/debug.lisp @@ -10,9 +10,6 @@ ;;;; files for more information. (in-package "SB!DEBUG") - -(file-comment - "$Header$") ;;;; variables and constants @@ -25,10 +22,10 @@ "*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") @@ -67,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 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. @@ -96,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 @@ -582,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." @@ -590,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*) @@ -620,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*)) @@ -708,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 @@ -1037,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) @@ -1077,12 +1104,20 @@ Function and macro commands: ;;;; 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))) @@ -1204,7 +1239,7 @@ Function and macro commands: ;;; 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*) @@ -1298,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)