X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=contrib%2Fsb-aclrepl%2Finspect.lisp;h=b09fc599d0ae328312f1a1d88a8b0652a0120c09;hb=a22dd643fb599880f4c0856e1a85bffe4358aea8;hp=ce7031d4ce5482b09d1b5530917d7ac2a01540d7;hpb=90107fa554438ccc3788d1e11a6d022bb11c326e;p=sbcl.git diff --git a/contrib/sb-aclrepl/inspect.lisp b/contrib/sb-aclrepl/inspect.lisp index ce7031d..b09fc59 100644 --- a/contrib/sb-aclrepl/inspect.lisp +++ b/contrib/sb-aclrepl/inspect.lisp @@ -1,4 +1,4 @@ -/nick;;;; Inspector for sb-aclrepl +;;;; Inspector for sb-aclrepl ;;;; ;;;; The documentation, which may or may not apply in its entirety at ;;;; any given time, for this functionality is on the ACL website: @@ -58,12 +58,10 @@ The commands are: (defun inspector-fun (object input-stream output-stream) - (declare (ignore input-stream)) (let ((*current-inspect* nil) (*inspect-raw* nil) (*inspect-length* *inspect-length*) (*skip-address-display* nil)) - (setq object (eval object)) (setq *current-inspect* (make-inspect)) (reset-stack object "(inspect ...)") (redisplay output-stream) @@ -599,7 +597,7 @@ position with the label if the label is a string." cons cells and LIST-TYPE is :normal, :dotted, or :cyclic" (do ((length 1 (1+ length)) (lst (cdr object) (cdr lst))) - ((or (not(consp lst)) + ((or (not (consp lst)) (eq object lst)) (cond ((null lst) @@ -615,10 +613,9 @@ cons cells and LIST-TYPE is :normal, :dotted, or :cyclic" (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 - (case list-type + (ecase list-type ((:dotted :cyclic) "+tail") - (t ""))))) - + (:normal ""))))) (defun ref32-hexstr (obj &optional (offset 0)) (format nil "~8,'0X" (ref32 obj offset))) @@ -651,7 +648,7 @@ cons cells and LIST-TYPE is :normal, :dotted, or :cyclic" (defmethod inspected-description ((object fixnum)) (description-maybe-internals "fixnum ~W" (list object) "[#x~8,'0X]" - (sb-kernel:get-lisp-obj-address object))) + (ash object (1- sb-vm:n-lowtag-bits)))) (defmethod inspected-description ((object complex)) (format nil "complex number ~W" object)) @@ -678,10 +675,14 @@ cons cells and LIST-TYPE is :normal, :dotted, or :cyclic" (format nil "ratio ~W" object)) (defmethod inspected-description ((object character)) - (description-maybe-internals "character ~W char-code #x~4,'0X" + ;; 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]" - (sb-kernel:get-lisp-obj-address object))) + (logior sb-vm:base-char-widetag + (ash (char-code object) + sb-vm:n-widetag-bits)))) (defmethod inspected-description ((object t)) (format nil "a generic object ~W" object)) @@ -780,7 +781,11 @@ cons cells and LIST-TYPE is :normal, :dotted, or :cyclic" (list components (length components) :named nil))) (defmethod inspected-parts ((object sb-kernel:funcallable-instance)) - (let ((components (inspected-structure-parts object))) + (let ((components (inspected-standard-object-parts object))) + (list components (length components) :named nil))) + +(defmethod inspected-parts ((object condition)) + (let ((components (inspected-standard-object-parts object))) (list components (length components) :named nil))) (defmethod inspected-parts ((object function))