+(defmethod inspected-description ((object vector))
+ (declare (vector object))
+ (format nil "a ~:[~;displaced ~]vector (~W)"
+ (and (sb-kernel:array-header-p object)
+ (sb-kernel:%array-displaced-p object))
+ (length object)))
+
+(defmethod inspected-description ((object simple-vector))
+ (declare (simple-vector object))
+ (format nil "a simple ~A vector (~D)"
+ (array-element-type object)
+ (length object)))
+
+(defmethod inspected-description ((object array))
+ (declare (array object))
+ (format nil "~:[A displaced~;An~] array of ~A with dimensions ~W"
+ (and (sb-kernel:array-header-p object)
+ (sb-kernel:%array-displaced-p object))
+ (array-element-type object)
+ (array-dimensions object)))
+
+(defun simple-cons-pair-p (object)
+ (atom (cdr object)))
+
+(defmethod inspected-description ((object cons))
+ (if (simple-cons-pair-p object)
+ "a cons cell"
+ (inspected-description-of-nontrivial-list object)))
+
+(defun cons-safe-length (object)
+ "Returns (VALUES LENGTH LIST-TYPE) where length is the number of
+cons cells and LIST-TYPE is :normal, :dotted, or :cyclic"
+ (do ((length 1 (1+ length))
+ (lst (cdr object) (cdr lst)))
+ ((or (not (consp lst))
+ (eq object lst))
+ (cond
+ ((null lst)
+ (values length :normal))
+ ((atom lst)
+ (values length :dotted))
+ ((eq object lst)
+ (values length :cyclic))))
+ ;; nothing to do in body
+ ))
+
+(defun inspected-description-of-nontrivial-list (object)
+ (multiple-value-bind (length list-type) (cons-safe-length object)
+ (format nil "a ~A list with ~D element~:*~P~A"
+ (string-downcase (symbol-name list-type)) length
+ (ecase list-type
+ ((:dotted :cyclic) "+tail")
+ (:normal "")))))
+
+(defun n-word-bits-hex-format ()
+ (case sb-vm::n-word-bits
+ (64 "~16,'0X")
+ (32 "~8,'0X")
+ (t "~X")))
+
+(defun ref32-hexstr (obj &optional (offset 0))
+ (format nil "~8,'0X" (ref32 obj offset)))
+
+(defun ref32 (obj &optional (offset 0))
+ (sb-sys::without-gcing
+ (sb-sys:sap-ref-32
+ (sb-sys:int-sap
+ (logand (sb-kernel:get-lisp-obj-address obj) (lognot sb-vm:lowtag-mask)))
+ offset)))
+
+(defun description-maybe-internals (fmt objects internal-fmt &rest args)
+ (let ((base (apply #'format nil fmt objects)))
+ (if *skip-address-display*
+ base
+ (concatenate 'string
+ base " " (apply #'format nil internal-fmt args)))))
+
+(defmethod inspected-description ((object double-float))
+ (let ((start (round (* 2 sb-vm::n-word-bits) 8)))
+ (description-maybe-internals "double-float ~W" (list object)
+ "[#~A ~A]"
+ (ref32-hexstr object (+ start 4))
+ (ref32-hexstr object start))))
+
+(defmethod inspected-description ((object single-float))
+ (description-maybe-internals "single-float ~W" (list object)
+ "[#x~A]"
+ (ref32-hexstr object (round sb-vm::n-word-bits 8))))
+
+(defmethod inspected-description ((object fixnum))
+ (description-maybe-internals
+ "fixnum ~W" (list object)
+ (concatenate 'string "[#x" (n-word-bits-hex-format) "]")
+ (ash object (1- sb-vm:n-lowtag-bits))))
+
+(defmethod inspected-description ((object complex))
+ (format nil "complex number ~W" object))
+
+(defmethod inspected-description ((object simple-string))
+ (format nil "a simple-string (~W) ~W" (length object) object))
+
+(defun bignum-words (bignum)
+ "Return the number of words in a bignum"
+ (ash
+ (logand (ref32 bignum) (lognot sb-vm:widetag-mask))
+ (- sb-vm:n-widetag-bits)))
+
+(defun bignum-component-at (bignum offset)
+ "Return the word at offset"
+ (case sb-vm::n-word-bits
+ (32
+ (ref32 bignum (* 4 (1+ offset))))
+ (64
+ (let ((start (* 8 (1+ offset))))
+ (+ (ref32 bignum start)
+ (ash (ref32 bignum (+ 4 start)) 32))))))
+
+(defmethod inspected-description ((object bignum))
+ (format nil "bignum ~W with ~D ~A-bit word~P" object
+ (bignum-words object) sb-vm::n-word-bits (bignum-words object)))
+
+(defmethod inspected-description ((object ratio))
+ (format nil "ratio ~W" object))
+
+(defmethod inspected-description ((object character))
+ ;; FIXME: This will need to change as and when we get more characters
+ ;; than just the 256 we have today.
+ (description-maybe-internals
+ "character ~W char-code #x~2,'0X"
+ (list object (char-code object))
+ "[#x~8,'0X]"
+ (logior sb-vm:character-widetag (ash (char-code object)
+ sb-vm:n-widetag-bits))))
+
+(defmethod inspected-description ((object t))
+ (format nil "a generic object ~W" object))
+
+(defmethod inspected-description ((object (eql *inspect-unbound-object-marker*)))
+ "..unbound..")