A while ago I added SB-DEBUG:*DEBUG-PRINT-CIRCLE*, but now I think it
wasn't really such a good solution to the problem.
Having screwed up once, I thought I'd run my new bright idea past the
assembled multitudes before trying to enCVS it.
I propose to
* define a new special variable SB-DEBUG:*PRINT-VAR-ALIST* which
contains rebinding specifications, enforced by PROGV
* deprecate the old SB-DEBUG:*DEBUG-PRINT-FOO* variables
* (and during the deprecated but not removed period, give
*PRINT-VAR-ALIST* bindings precedence over SB-DEBUG:*DEBUG-PRINT-FOO*
bindings, so people who want to write bindings which will work
immediately and continue to work even after support for
SB-DEBUG:*DEBUG-PRINT-FOO* is gone can do so, by just specifying
bindings in SB-DEBUG:*DEBUG-PRINT-FOO*)
So one could write, e.g.,
(SETF SB-DEBUG:*PRINT-VAR-ALIST*
'((*PRINT-LEVEL* . 10)
(*PRINT-LENGTH* . 25)
(*PRINT-CIRCLE* . T)
(*PRINT-PRETTY* . T)))
comments? suggestions? (some better name? SB-DEBUG:*REBINDINGS-ALIST* ?)
I've been running for a couple of days with the code below as part of
my .sbclrc, and it seems to work OK. If I implement the change in
src/code/debug.lisp, it will probably look similar.
(Have I been doing a lot of debugging? Shrewd guess!)
(cl:in-package :sb-debug)
(defvar *print-var-alist* nil)
(export '*print-var-alist*)
(defun funcall-with-debug-io-syntax (fun &rest rest)
(declare (type function fun))
;;(format t "~&/entering FUNCALL-WITH-DEBUG-IO-SYNTAX ~S ~S" fun rest)
;; Try to force the other special variables into a useful state.
(let (;; Protect from WITH-STANDARD-IO-SYNTAX some variables where
;; any default we might use is less useful than just reusing
;; the global values.
(original-package *package*)
(original-print-pretty *print-pretty*))
(with-standard-io-syntax
(let (;; We want the printer and reader to be in a useful state,
;; regardless of where the debugger was invoked in the
;; program. WITH-STANDARD-IO-SYNTAX did much of what we
;; want, but
;; * It doesn't affect our internal special variables
;; like *CURRENT-LEVEL-IN-PRINT*.
;; * It isn't customizable.
;; * It doesn't set *PRINT-READABLY* to the same value
;; as the toplevel default.
;; * It sets *PACKAGE* to COMMON-LISP-USER, which is not
;; helpful behavior for a debugger.
;; * There's no particularly good debugger default for
;; *PRINT-PRETTY*, since T is usually what you want
;; -- except absolutely not what you want when you're
;; debugging failures in PRINT-OBJECT logic.
;; We try to address all these issues with explicit
;; rebindings here.
(sb-kernel:*current-level-in-print* 0)
(*package* original-package)
(*print-pretty* original-print-pretty)
(*print-readably* nil)
;; These rebindings are now (as of early 2004) deprecated,
;; with the new *PRINT-VAR-ALIST* mechanism preferred.
(*print-length* *debug-print-length*)
(*print-level* *debug-print-level*)
(*readtable* *debug-readtable*))
(progv
;; (Why NREVERSE? PROGV makes the later entries have
;; precedence over the earlier entries. *PRINT-VAR-ALIST*
;; is called an alist, so it's expected that its earlier
;; entries have precedence. And the earlier-has-precedence
;; behavior is mostly more convenient, so that programmers
;; can use PUSH or LIST* to customize *PRINT-VAR-ALIST*.)
(nreverse (mapcar #'car *print-var-alist*))
(nreverse (mapcar #'cdr *print-var-alist*))
(apply fun rest))))))
(defun invoke-debugger (condition)
;; #!+sb-doc
"Enter the debugger."
;;(print "/entering INVOKE-DEBUGGER")
(let ((old-hook *debugger-hook*))
(when old-hook
(let ((*debugger-hook* nil))
(funcall old-hook condition old-hook))))
(let ((old-hook *invoke-debugger-hook*))
(when old-hook
(let ((*invoke-debugger-hook* nil))
(funcall old-hook condition old-hook))))
;; Note: CMU CL had (SB-UNIX:UNIX-SIGSETMASK 0) here, to reset the
;; signal state in the case that we wind up in the debugger as a
;; result of something done by a signal handler. It's not
;; altogether obvious that this is necessary, and indeed SBCL has
;; not been doing it since 0.7.8.5. But nobody seems altogether
;; convinced yet
;; -- dan 2003.11.11, based on earlier comment of WHN 2002-09-28
;; We definitely want *PACKAGE* to be of valid type.
;;
;; 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*))
;; Before we start our own output, finish any pending output.
;; Otherwise, if the user tried to track the progress of his program
;; using PRINT statements, he'd tend to lose the last line of output
;; or so, which'd be confusing.
(flush-standard-output-streams)
;;(print "/calling FUNCALL-WITH-DEBUG-IO-SYNTAX")
(funcall-with-debug-io-syntax #'%invoke-debugger condition))
(defun %invoke-debugger (condition)
;;(print "/entering %INVOKE-DEBUGGER")
(let ((*debug-condition* condition)
(*debug-restarts* (compute-restarts condition))
(*nested-debug-condition* nil))
(handler-case
;; (The initial output here goes to *ERROR-OUTPUT*, because the
;; initial output is not interactive, just an error message, and
;; when people redirect *ERROR-OUTPUT*, they could reasonably
;; expect to see error messages logged there, regardless of what
;; the debugger does afterwards.)
(format *error-output*
"~2&~@<debugger invoked on a ~S in thread ~A: ~
~2I~_~A~:>~%"
(type-of *debug-condition*)
(sb-thread:current-thread-id)
*debug-condition*)
(error (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) = ~S~%"
'*debug-condition*
(cell-error-name *debug-condition*)))))
(let ((background-p (sb-thread::debugger-wait-until-foreground-thread
*debug-io*)))
;; After the initial error/condition/whatever announcement to
;; *ERROR-OUTPUT*, we become interactive, and should talk on
;; *DEBUG-IO* from now on. (KLUDGE: This is a normative
;; statement, not a description of reality.:-| There's a lot of
;; 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)
(unwind-protect
(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*. (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
;; to send errors which occur in interactive debugging to
;; that file, and right to send them to *DEBUG-IO*.
(*error-output* *debug-io*))
(unless (typep condition 'step-condition)
(when *debug-beginner-help-p*
(format *debug-io*
"~%~@<You can type HELP for debugger help, or ~
(SB-EXT:QUIT) to exit from SBCL.~:@>~2%"))
(show-restarts *debug-restarts* *debug-io*))
(internal-debug))
(when background-p
(sb-thread::release-foreground))))))
--
William Harold Newman <william.newman@...>
In examining the tasks of software development versus software maintenance,
most of the tasks are the same -- except for the additional maintenance
task of "understanding the existing product". -- Robert L. Glass, _Facts
and Fallacies of Software Engineering_
PGP key fingerprint 85 CE 1C BA 79 8D 51 8C B9 25 FB EE E0 C3 E5 7C