From 4217a388a178099c43202df208c78ca81e0d9d1f Mon Sep 17 00:00:00 2001 From: William Harold Newman Date: Sun, 29 Sep 2002 18:48:53 +0000 Subject: [PATCH] 0.7.8.6: made the debugger no longer rebind *PRINT-PRETTY*, since it made it unnecessarily difficult to debug problems involving PRINT-OBJECT bugs, and was just too DWIMish As long as I'm killing DWIMish things in INVOKE-DEBUGGER, comment out the sigsetmask(0). As long as as I'm cleaning up pretty-printer-related stuff, get rid of *PRETTY-PRINTER* too. (Since in ANSI the pretty printer is not an optional add-on, we shouldn't need the Spice-Lisp-ish hook to support the addition of a pretty printer.) --- package-data-list.lisp-expr | 6 ++-- src/code/debug.lisp | 77 ++++++++++++++++++++++++++----------------- src/code/pprint.lisp | 1 - src/code/print.lisp | 10 +----- version.lisp-expr | 2 +- 5 files changed, 52 insertions(+), 44 deletions(-) diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr index ca4183e..1d0ec00 100644 --- a/package-data-list.lisp-expr +++ b/package-data-list.lisp-expr @@ -963,7 +963,7 @@ is a good idea, but see SB-SYS re. blurring of boundaries." "*CURRENT-LEVEL-IN-PRINT*" "*EMPTY-TYPE*" "*GC-INHIBIT*" "*NEED-TO-COLLECT-GARBAGE*" - "*PRETTY-PRINTER*" "*CONTROL-STACK-EXHAUSTION-SAP*" + "*CONTROL-STACK-EXHAUSTION-SAP*" "*UNIVERSAL-TYPE*" "*UNIVERSAL-FUN-TYPE*" "*UNPARSE-FUN-TYPE-SIMPLIFY*" "*WILD-TYPE*" "32BIT-LOGICAL-AND" "32BIT-LOGICAL-ANDC1" @@ -1466,7 +1466,9 @@ definitely not guaranteed to be present in later versions of SBCL." :name "SB!PRETTY" :doc "private: implementation of pretty-printing" :use ("CL" "SB!EXT" "SB!INT" "SB!KERNEL") - :export ("PRETTY-STREAM" "PRETTY-STREAM-P" "!PPRINT-COLD-INIT")) + :export ("OUTPUT-PRETTY-OBJECT" + "PRETTY-STREAM" "PRETTY-STREAM-P" + "!PPRINT-COLD-INIT")) #s(sb-cold:package-data :name "SB!PROFILE" diff --git a/src/code/debug.lisp b/src/code/debug.lisp index ec3d3b2..c582585 100644 --- a/src/code/debug.lisp +++ b/src/code/debug.lisp @@ -646,10 +646,16 @@ Other commands: (when old-hook (let ((*debugger-hook* nil)) (funcall old-hook condition old-hook)))) - ;; FIXME: No-one seems to know what this is for. Nothing is noticeably - ;; broken on sunos... - #!-sunos (sb!unix:unix-sigsetmask 0) + ;; Note: CMU CL had (SB-UNIX:UNIX-SIGSETMASK 0) here. I deleted it + ;; around sbcl-0.7.8.5 (by which time it had mutated to have a + ;; #!-SUNOS prefix and a FIXME note observing that it wasn't needed + ;; on SunOS and no one knew why it was needed anywhere else either). + ;; So if something mysteriously breaks that has worked since the CMU + ;; CL days, that might be why. -- 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. @@ -660,37 +666,46 @@ Other commands: "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*)) + + ;; 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* ((*debug-condition* condition) - (*debug-restarts* (compute-restarts condition)) - ;; 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-IN-PRINT*. - ;; 2. It isn't customizable. - ;; 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. - (sb!kernel:*current-level-in-print* 0) - (*print-length* *debug-print-length*) - (*print-level* *debug-print-level*) - (*readtable* *debug-readtable*) - (*print-readably* nil) - (*print-pretty* t) - (*package* original-package) - (*nested-debug-condition* nil)) + (let ((*debug-condition* condition) + (*debug-restarts* (compute-restarts condition)) + (*nested-debug-condition* nil) + ;; 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) + (*print-length* *debug-print-length*) + (*print-level* *debug-print-level*) + (*readtable* *debug-readtable*) + (*print-readably* nil) + (*package* original-package) + (*print-pretty* original-print-pretty)) ;; 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, and get confused. + ;; 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) ;; (The initial output here goes to *ERROR-OUTPUT*, because the diff --git a/src/code/pprint.lisp b/src/code/pprint.lisp index baf4088..25fd9a0 100644 --- a/src/code/pprint.lisp +++ b/src/code/pprint.lisp @@ -1364,5 +1364,4 @@ (/show0 "leaving !PPRINT-COLD-INIT")) (setf *print-pprint-dispatch* (copy-pprint-dispatch nil)) - (setf *pretty-printer* #'output-pretty-object) (setf *print-pretty* t)) diff --git a/src/code/print.lisp b/src/code/print.lisp index ae7c7ec..04d85f4 100644 --- a/src/code/print.lisp +++ b/src/code/print.lisp @@ -376,11 +376,6 @@ ;;;; OUTPUT-OBJECT -- the main entry point -;;; the current pretty printer. This should be either a function that -;;; takes two arguments (the object and the stream) or NIL to indicate -;;; that there is no pretty printer installed. -(defvar *pretty-printer* nil) - ;;; Objects whose print representation identifies them EQLly don't ;;; need to be checked for circularity. (defun uniquely-identified-by-print-p (x) @@ -393,10 +388,7 @@ (defun output-object (object stream) (labels ((print-it (stream) (if *print-pretty* - (if *pretty-printer* - (funcall *pretty-printer* object stream) - (let ((*print-pretty* nil)) - (output-ugly-object object stream))) + (sb!pretty:output-pretty-object object stream) (output-ugly-object object stream))) (check-it (stream) (multiple-value-bind (marker initiate) diff --git a/version.lisp-expr b/version.lisp-expr index f16daa4..8ea633f 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -18,4 +18,4 @@ ;;; internal versions off the main CVS branch, it gets hairier, e.g. ;;; "0.pre7.14.flaky4.13".) -"0.7.8.5" +"0.7.8.6" -- 1.7.10.4