X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fdebug.lisp;h=19f3896848b8f73aa50165950015d7025e5322f6;hb=755ff8f53315160fcb2d92207dfe24ae7ed4d4c6;hp=4943a5120bd926ff39a03b1cdb214f62a0914aec;hpb=06ab5194e064ef8855d6952d02f9cae55e8e75e4;p=sbcl.git diff --git a/src/code/debug.lisp b/src/code/debug.lisp index 4943a51..19f3896 100644 --- a/src/code/debug.lisp +++ b/src/code/debug.lisp @@ -78,22 +78,24 @@ *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. +"The prompt is square brackets, with number(s) indicating the current control + stack level and, if you've entered the debugger recursively, how deeply + recursed you are. +Any command -- including the name of a restart -- may be uniquely abbreviated. 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 - does affect these variables. +Debug commands do not affect *, //, and similar variables, but evaluation in + the debug loop does affect these variables. SB-DEBUG:*FLUSH-DEBUG-ERRORS* controls whether errors at the debug prompt - drop you into deeper into the debugger. + drop you deeper into the debugger. Getting in and out of the debugger: 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. + The number of any restart, or its name, or a unique abbreviation for its + name, is a valid command, and is the same as using RESTART to invoke that + restart. Changing frames: U up frame D down frame @@ -125,7 +127,12 @@ Function and macro commands: (SB-DEBUG:ARG n) Return the n'th argument in the current frame. (SB-DEBUG:VAR string-or-symbol [id]) - Returns the value of the specified variable in the current frame.") + Returns the value of the specified variable in the current frame. + +Other commands: + SLURP Discard all pending input on *STANDARD-INPUT*. (This can be + useful when the debugger was invoked to handle an error in + deeply nested input syntax, and now the reader is confused.)") ;;; This is used to communicate to DEBUG-LOOP that we are at a step breakpoint. (define-condition step-condition (simple-condition) ()) @@ -261,30 +268,32 @@ Function and macro commands: ;;;; the BREAKPOINT-INFO structure ;;; info about a made breakpoint -(defstruct (breakpoint-info (:copier nil)) +(defstruct (breakpoint-info (:copier nil) + (:constructor %make-breakpoint-info)) ;; where we are going to stop - (place (missing-arg) :type (or sb!di:code-location sb!di:debug-fun)) - ;; the breakpoint returned by sb!di:make-breakpoint - (breakpoint (missing-arg) :type sb!di:breakpoint) + (place (missing-arg) + :type (or sb!di:code-location sb!di:debug-fun) + :read-only t) + ;; the breakpoint returned by SB!DI:MAKE-BREAKPOINT + (breakpoint (missing-arg) :type sb!di:breakpoint :read-only t) ;; the function returned from SB!DI:PREPROCESS-FOR-EVAL. If result is ;; non-NIL, drop into the debugger. - (break #'identity :type function) - ;; the function returned from sb!di:preprocess-for-eval. If result is + (break #'identity :type function :read-only t) + ;; the function returned from SB!DI:PREPROCESS-FOR-EVAL. If result is ;; non-NIL, eval (each) print and print results. - (condition #'identity :type function) - ;; the list of functions from sb!di:preprocess-for-eval to evaluate. - ;; Results are conditionally printed. Car of each element is the - ;; function, cdr is the form it goes with. - (print nil :type list) + (condition #'identity :type function :read-only t) + ;; the list of functions from SB!DI:PREPROCESS-FOR-EVAL to evaluate. + ;; Results are conditionally printed. CAR of each element is the + ;; function, CDR is the form it goes with. + (print nil :type list :read-only t) ;; the number used when listing the possible breakpoints within a - ;; function. Could also be a symbol such as start or end. - (code-location-number (missing-arg) :type (or symbol integer)) - ;; the number used when listing the breakpoints active and to delete - ;; breakpoints - (breakpoint-number (missing-arg) :type integer)) - -;;; Return a new BREAKPOINT-INFO structure with the info passed. -(defun create-breakpoint-info (place breakpoint code-location-number + ;; function; or could also be a symbol such as START or END + (code-location-selector (missing-arg) :type (or symbol integer) :read-only t) + ;; the number used when listing the active breakpoints, and when + ;; deleting breakpoints + (breakpoint-number (missing-arg) :type integer :read-only t)) + +(defun create-breakpoint-info (place breakpoint code-location-selector &key (break #'identity) (condition #'identity) (print nil)) (setf *breakpoints* @@ -296,25 +305,25 @@ Function and macro commands: (first breakpoints))))) i)))) - (make-breakpoint-info :place place :breakpoint breakpoint - :code-location-number code-location-number - :breakpoint-number breakpoint-number - :break break :condition condition :print print))) + (%make-breakpoint-info :place place + :breakpoint breakpoint + :code-location-selector code-location-selector + :breakpoint-number breakpoint-number + :break break + :condition condition + :print print))) -;;; Print the breakpoint info for the breakpoint-info structure passed. (defun print-breakpoint-info (breakpoint-info) (let ((place (breakpoint-info-place breakpoint-info)) - (bp-number (breakpoint-info-breakpoint-number breakpoint-info)) - (loc-number (breakpoint-info-code-location-number breakpoint-info))) + (bp-number (breakpoint-info-breakpoint-number breakpoint-info))) (case (sb!di:breakpoint-kind (breakpoint-info-breakpoint breakpoint-info)) (:code-location (print-code-location-source-form place 0) (format t "~&~S: ~S in ~S" bp-number - loc-number - (sb!di:debug-fun-name (sb!di:code-location-debug-fun - place)))) + (breakpoint-info-code-location-selector breakpoint-info) + (sb!di:debug-fun-name (sb!di:code-location-debug-fun place)))) (:fun-start (format t "~&~S: FUN-START in ~S" bp-number (sb!di:debug-fun-name place))) @@ -699,15 +708,14 @@ reset to ~S." ;; 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, + (let (;; FIXME: Rebinding *STANDARD-OUTPUT* here seems 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*) + ;; redirected-to-a-file) *STANDARD-OUTPUT*. (CMU CL + ;; used to rebind *STANDARD-INPUT* here too, but that's + ;; been fixed already.) (*standard-output* *debug-io*) ;; This seems reasonable: e.g. if the user has redirected ;; *ERROR-OUTPUT* to some log file, it's probably wrong @@ -806,7 +814,7 @@ reset to ~S." '*flush-debug-errors*) (/show0 "throwing DEBUG-LOOP-CATCHER") (throw 'debug-loop-catcher nil))))) - ;; We have to bind level for the restart function created by + ;; We have to bind LEVEL for the restart function created by ;; WITH-SIMPLE-RESTART. (let ((level *debug-command-level*) (restart-commands (make-restart-commands))) @@ -829,7 +837,7 @@ reset to ~S." (apply cmd-fun (sb!int:stream-command-args input)))))) (t - (let* ((exp (read)) + (let* ((exp (read *debug-io*)) (cmd-fun (debug-command-p exp restart-commands))) (cond ((not cmd-fun) @@ -1206,7 +1214,7 @@ argument") (show-restarts *debug-restarts* *debug-io*) (write-string "restart: ") (force-output) - (setf num (read *standard-input*))) + (setf num (read *debug-io*))) (let ((restart (typecase num (unsigned-byte (nth num *debug-restarts*)) @@ -1621,17 +1629,19 @@ argument") (if function (describe function) (format t "can't figure out the function for this frame")))) + +(!def-debug-command "SLURP" () + (loop while (read-char-no-hang *standard-input*))) ;;;; debug loop command utilities -(defun read-prompting-maybe (prompt &optional (in *standard-input*) - (out *standard-output*)) - (unless (sb!int:listen-skip-whitespace in) - (princ prompt out) - (force-output out)) - (read in)) +(defun read-prompting-maybe (prompt) + (unless (sb!int:listen-skip-whitespace *debug-io*) + (princ prompt) + (force-output)) + (read *debug-io*)) -(defun read-if-available (default &optional (stream *standard-input*)) - (if (sb!int:listen-skip-whitespace stream) - (read stream) +(defun read-if-available (default) + (if (sb!int:listen-skip-whitespace *debug-io*) + (read *debug-io*) default))