\f
;;;; OUTPUT-OBJECT -- the main entry point
-(defvar *pretty-printer* nil
- #!+sb-doc
- "The current pretty printer. 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.")
+;;; 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)
;;; Output OBJECT to STREAM observing all printer control variables.
(defun output-object (object stream)
(defun output-function (object stream)
(let* ((*print-length* 3) ; in case we have to..
(*print-level* 3) ; ..print an interpreted function definition
- (name (cond ((find (function-subtype object)
- #(#.sb!vm:closure-header-type
- #.sb!vm:byte-code-closure-type))
- "CLOSURE")
- (#!+sb-interpreter
- (sb!eval::interpreted-function-p object)
- (or (sb!eval::interpreted-function-%name object)
- (sb!eval:interpreted-function-lambda-expression
- object)))
- ((find (function-subtype object)
- #(#.sb!vm:function-header-type
- #.sb!vm:closure-function-header-type))
- (%function-name object))
- (t 'no-name-available)))
+ ;; FIXME: This find-the-function-name idiom ought to be
+ ;; pulled out in a function somewhere.
+ (name (case (function-subtype object)
+ (#.sb!vm:closure-header-widetag "CLOSURE")
+ (#.sb!vm:simple-fun-header-widetag (%simple-fun-name object))
+ (t 'no-name-available)))
(identified-by-name-p (and (symbolp name)
(fboundp name)
(eq (fdefinition name) object))))
(print-unreadable-object (object stream :identity t)
(let ((lowtag (get-lowtag object)))
(case lowtag
- (#.sb!vm:other-pointer-type
+ (#.sb!vm:other-pointer-lowtag
(let ((type (get-type object)))
(case type
- (#.sb!vm:value-cell-header-type
+ (#.sb!vm:value-cell-header-widetag
(write-string "value cell " stream)
- (output-object (sb!c:value-cell-ref object) stream))
+ (output-object (value-cell-ref object) stream))
(t
(write-string "unknown pointer object, type=" stream)
(let ((*print-base* 16) (*print-radix* t))
(output-integer type stream))))))
- ((#.sb!vm:function-pointer-type
- #.sb!vm:instance-pointer-type
- #.sb!vm:list-pointer-type)
+ ((#.sb!vm:fun-pointer-lowtag
+ #.sb!vm:instance-pointer-lowtag
+ #.sb!vm:list-pointer-lowtag)
(write-string "unknown pointer object, type=" stream))
(t
(case (get-type object)
- (#.sb!vm:unbound-marker-type
+ (#.sb!vm:unbound-marker-widetag
(write-string "unbound marker" stream))
(t
(write-string "unknown immediate object, lowtag=" stream)