X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=contrib%2Fsb-aclrepl%2Finspect.lisp;h=f8077760118ea3c1a705f714fe5c96ef1510882f;hb=8a8a8922802460741d6f8f6c11d71b1f414cf3a7;hp=ce7031d4ce5482b09d1b5530917d7ac2a01540d7;hpb=90107fa554438ccc3788d1e11a6d022bb11c326e;p=sbcl.git

diff --git a/contrib/sb-aclrepl/inspect.lisp b/contrib/sb-aclrepl/inspect.lisp
index ce7031d..f807776 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:
@@ -12,7 +12,8 @@
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (defconstant +default-inspect-length+ 20))
 
-(defstruct inspect
+(defstruct (%inspect (:constructor make-inspect)
+		     (:conc-name inspect-))
   ;; stack of parents of inspected object
   object-stack 
   ;;  a stack of indices of parent object components
@@ -58,12 +59,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 +598,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 +614,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 +649,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 +676,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 +782,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))