0.pre7.58:
[sbcl.git] / src / code / print.lisp
index cb53bcc..5cd2a14 100644 (file)
 (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")
-                    ((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 (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)