*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
(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.)")
\f
;;; This is used to communicate to DEBUG-LOOP that we are at a step breakpoint.
(define-condition step-condition (simple-condition) ())
;;;; 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*
(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)))
;; 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
'*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)))
(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)
(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*))
(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*)))
\f
;;;; 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))