\f
;;;; variables and constants
-(defvar *debug-print-level* 3
+;;; things to consider when tweaking these values:
+;;; * We're afraid to just default them to NIL and NIL, in case the
+;;; user inadvertently causes a hairy data structure to be printed
+;;; when he inadvertently enters the debugger.
+;;; * We don't want to truncate output too much. These days anyone
+;;; can easily run their Lisp in a windowing system or under Emacs,
+;;; so it's not the end of the world even if the worst case is a
+;;; few thousand lines of output.
+;;; * As condition :REPORT methods are converted to use the pretty
+;;; printer, they acquire *PRINT-LEVEL* constraints, so e.g. under
+;;; sbcl-0.7.1.28's old value of *DEBUG-PRINT-LEVEL*=3, an
+;;; ARG-COUNT-ERROR printed as
+;;; error while parsing arguments to DESTRUCTURING-BIND:
+;;; invalid number of elements in
+;;; #
+;;; to satisfy lambda list
+;;; #:
+;;; exactly 2 expected, but 5 found
+(defvar *debug-print-level* 5
#!+sb-doc
"*PRINT-LEVEL* for the debugger")
-
-(defvar *debug-print-length* 5
+(defvar *debug-print-length* 7
#!+sb-doc
"*PRINT-LENGTH* for the debugger")
*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)))
) ; EVAL-WHEN
;;; This is used in constructing arg lists for debugger printing when
-;;; the arg list is unavailable, some arg is unavailable or unused,
-;;; etc.
+;;; the arg list is unavailable, some arg is unavailable or unused, etc.
(defstruct (unprintable-object
(:constructor make-unprintable-object (string))
(:print-object (lambda (x s)
- (print-unreadable-object (x s :type t)
+ (print-unreadable-object (x s)
(write-string (unprintable-object-string x)
s))))
(:copier nil))
;;; These are bound on each invocation of INVOKE-DEBUGGER.
(defvar *debug-restarts*)
(defvar *debug-condition*)
+(defvar *nested-debug-condition*)
(defun invoke-debugger (condition)
#!+sb-doc
(when old-hook
(let ((*debugger-hook* nil))
(funcall old-hook condition old-hook))))
- (sb!unix:unix-sigsetmask 0)
+ ;; FIXME: No-one seems to know what this is for. Nothing is noticeably
+ ;; broken on sunos...
+ #!-sunos (sb!unix:unix-sigsetmask 0)
;; Elsewhere in the system, we use the SANE-PACKAGE function for
;; this, but here causing an exception just as we're trying to handle
(*readtable* *debug-readtable*)
(*print-readably* nil)
(*print-pretty* t)
- (*package* original-package))
+ (*package* original-package)
+ (*nested-debug-condition* nil))
;; Before we start our own output, finish any pending output.
;; Otherwise, if the user tried to track the progress of
(type-of *debug-condition*)
*debug-condition*)
(error (condition)
- (format *error-output*
- "~&(caught ~S trying to print ~S when entering debugger)~%"
- (type-of condition)
- '*debug-condition*)
+ (setf *nested-debug-condition* condition)
+ (let ((ndc-type (type-of *nested-debug-condition*)))
+ (format *error-output*
+ "~&~@<(A ~S was caught when trying to print ~S when ~
+ entering the debugger. Printing was aborted and the ~
+ ~S was stored in ~S.)~@:>~%"
+ ndc-type
+ '*debug-condition*
+ ndc-type
+ '*nested-debug-condition*))
(when (typep condition 'cell-error)
;; what we really want to know when it's e.g. an UNBOUND-VARIABLE:
(format *error-output*
- "~&(CELL-ERROR-NAME = ~S)~%)"
+ "~&(CELL-ERROR-NAME ~S) = ~S~%"
+ '*debug-condition*
(cell-error-name *debug-condition*)))))
;; After the initial error/condition/whatever announcement to
;; 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))
projects / sbcl.git / blobdiff