From: William Harold Newman Date: Mon, 26 Nov 2001 03:53:07 +0000 (+0000) Subject: 0.pre7.86.flaky7.12: X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=2bdff49151d220d89e5da8c4a9af25372d4f6f36;p=sbcl.git 0.pre7.86.flaky7.12: (now bootstraps successfully even without :SB-SHOW) made unbound-PRINT-OBJECT hack unconditional --- diff --git a/src/code/class.lisp b/src/code/class.lisp index bce896c..4abd970 100644 --- a/src/code/class.lisp +++ b/src/code/class.lisp @@ -441,7 +441,6 @@ (declaim (ftype (function (symbol index simple-vector layout-depthoid) layout) find-and-init-or-check-layout)) (defun find-and-init-or-check-layout (name length inherits depthoid) - (/show0 "entering FIND-AND-INIT-OR-CHECK-LAYOUT") (let ((layout (find-layout name))) (init-or-check-layout layout (or (sb!xc:find-class name nil) diff --git a/src/code/pprint.lisp b/src/code/pprint.lisp index 390149c..9b3f51e 100644 --- a/src/code/pprint.lisp +++ b/src/code/pprint.lisp @@ -905,7 +905,6 @@ (defun pprint-dispatch (object &optional (table *print-pprint-dispatch*)) (declare (type (or pprint-dispatch-table null) table)) - (/show0 "entering PPRINT-DISPATCH") (let* ((table (or table *initial-pprint-dispatch*)) (cons-entry (and (consp object) diff --git a/src/code/print.lisp b/src/code/print.lisp index 77ad049..b3a74a5 100644 --- a/src/code/print.lisp +++ b/src/code/print.lisp @@ -388,9 +388,7 @@ ;;; Output OBJECT to STREAM observing all printer control variables. (defun output-object (object stream) - (/show0 "entering OUTPUT-OBJECT") (labels ((print-it (stream) - (/show0 "entering PRINT-IT in OUTPUT-OBJECT") (if *print-pretty* (if *pretty-printer* (funcall *pretty-printer* object stream) @@ -398,7 +396,6 @@ (output-ugly-object object stream))) (output-ugly-object object stream))) (check-it (stream) - (/show0 "entering CHECK-IT") (let ((marker (check-for-circularity object t))) (case marker (:initiate @@ -415,7 +412,6 @@ (cond (;; Maybe we don't need to bother with circularity detection. (or (not *print-circle*) (uniquely-identified-by-print-p object)) - (/show0 "in obviously-don't-bother case") (print-it stream)) (;; If we have already started circularity detection, this ;; object might be a shared reference. If we have not, then @@ -423,14 +419,14 @@ ;; reference to itself or multiple shared references. (or *circularity-hash-table* (compound-object-p object)) - (/show0 "in CHECK-IT case") (check-it stream)) (t - (/show0 "in don't-bother-after-all case") (print-it stream))))) -;;; a hack for debugging -#!+sb-show +;;; a hack to work around recurring gotchas with printing while +;;; DEFGENERIC PRINT-OBJECT is being built +;;; +;;; (hopefully will go away naturally when CLOS moves into cold init) (defvar *print-object-is-disabled-p*) ;;; Output OBJECT to STREAM observing all printer control variables @@ -438,7 +434,6 @@ ;;; then the pretty printer will be used for any components of OBJECT, ;;; just not for OBJECT itself. (defun output-ugly-object (object stream) - (/show0 "entering OUTPUT-UGLY-OBJECT") (typecase object ;; KLUDGE: The TYPECASE approach here is non-ANSI; the ANSI definition of ;; PRINT-OBJECT says it provides printing and we're supposed to provide @@ -451,15 +446,15 @@ ;; a method on an external symbol in the CL package which is ;; applicable to arg lists containing only direct instances of ;; standardized classes. - ;; Thus, in order for the user to detect our sleaziness, he has to do - ;; something relatively obscure like + ;; Thus, in order for the user to detect our sleaziness in conforming + ;; code, he has to do something relatively obscure like ;; (1) actually use tools like FIND-METHOD to look for PRINT-OBJECT ;; methods, or ;; (2) define a PRINT-OBJECT method which is specialized on the stream ;; value (e.g. a Gray stream object). ;; As long as no one comes up with a non-obscure way of detecting this ;; sleaziness, fixing this nonconformity will probably have a low - ;; priority. -- WHN 20000121 + ;; priority. -- WHN 2001-11-25 (fixnum (output-integer object stream)) (list @@ -467,24 +462,13 @@ (output-symbol object stream) (output-list object stream))) (instance - (/show0 "in PRINT-OBJECT case") - #!-sb-show - (print-object object stream) - - ;; After being bitten several times by the difficulty of - ;; debugging problems around DEFGENERIC PRINT-OBJECT when the old - ;; placeholder printer is disabled by FMAKUNBOUND 'PRINT-OBJECT - ;; and/or DEFGENERIC has already executed but DEFMETHODs haven't, - ;; I added this workaround to allow output during that - ;; interval... -- WHN 2001-11-25 - #!+sb-show (cond ((not (and (boundp '*print-object-is-disabled-p*) *print-object-is-disabled-p*)) (print-object object stream)) ((typep object 'structure-object) (default-structure-print object stream *current-level*)) (t - (write-string "#")))) + (write-string "#" stream)))) (function (unless (and (funcallable-instance-p object) (printed-as-funcallable-standard-class object stream)) @@ -520,13 +504,12 @@ (fdefn (output-fdefn object stream)) (t - (/show0 "in OUTPUT-RANDOM case") (output-random object stream)))) ;;;; symbols -;;; Values of *PRINT-CASE* and (READTABLE-CASE *READTABLE*) the last -;;; time the printer was called. +;;; values of *PRINT-CASE* and (READTABLE-CASE *READTABLE*) the last +;;; time the printer was called (defvar *previous-case* nil) (defvar *previous-readtable-case* nil) @@ -1066,7 +1049,6 @@ ;;; use until CLOS is set up (at which time it will be replaced with ;;; the real generic function implementation) (defun print-object (instance stream) - (/show0 "in pre-CLOS PRINT-OBJECT placeholder") (default-structure-print instance stream *current-level*)) ;;;; integer, ratio, and complex printing (i.e. everything but floats) diff --git a/src/code/target-defstruct.lisp b/src/code/target-defstruct.lisp index 864a436..3937071 100644 --- a/src/code/target-defstruct.lisp +++ b/src/code/target-defstruct.lisp @@ -412,11 +412,9 @@ (write-char #\space stream) (pprint-newline :linear stream)))))))) (defun %default-structure-ugly-print (structure stream) - (/show0 "entering %DEFAULT-STRUCTURE-UGLY-PRINT") (let* ((layout (%instance-layout structure)) (name (sb!xc:class-name (layout-class layout))) (dd (layout-info layout))) - (/show0 "got LAYOUT, NAME, and DD") (descend-into (stream) (write-string "#S(" stream) (prin1 name stream) @@ -441,15 +439,11 @@ stream)))))) (defun default-structure-print (structure stream depth) (declare (ignore depth)) - (/show0 "entering DEFAULT-STRUCTURE-PRINT") (cond ((funcallable-instance-p structure) - (/show0 "in FUNCALLABLE-INSTANCE-P case") (print-unreadable-object (structure stream :identity t :type t))) (*print-pretty* - (/show0 "in *PRINT-PRETTY* case") (%default-structure-pretty-print structure stream)) (t - (/show0 "in ugly-print case") (%default-structure-ugly-print structure stream)))) (def!method print-object ((x structure-object) stream) (default-structure-print x stream *current-level*)) diff --git a/src/pcl/print-object.lisp b/src/pcl/print-object.lisp index 6436c3d..9eb42a7 100644 --- a/src/pcl/print-object.lisp +++ b/src/pcl/print-object.lisp @@ -42,7 +42,6 @@ #+sb-show (*/show* nil) ;; (another workaround for the problem of debugging while the ;; printer is disabled here) - #+sb-show (sb-impl::*print-object-is-disabled-p* t)) (fmakunbound 'print-object) (defgeneric print-object (object stream))