X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=contrib%2Fsb-introspect%2Fsb-introspect.lisp;h=5a36bf4b74d482b51f4b20974d9b538d73378ff4;hb=23a229276c2447a658b7a30217ec774067c27d5e;hp=8ef31134f107fcacd0f71eed33fbf28b4dac8737;hpb=cb83aa22932bf4b9bc74ac6f0fcd91db1702ad33;p=sbcl.git

diff --git a/contrib/sb-introspect/sb-introspect.lisp b/contrib/sb-introspect/sb-introspect.lisp
index 8ef3113..5a36bf4 100644
--- a/contrib/sb-introspect/sb-introspect.lisp
+++ b/contrib/sb-introspect/sb-introspect.lisp
@@ -320,8 +320,11 @@ If an unsupported TYPE is requested, the function will return NIL.
        (when source
          (setf (definition-source-description source)
                (append (method-qualifiers object)
-                       (sb-pcl::unparse-specializers
-                        (sb-mop:method-specializers object)))))
+                       (if (sb-mop:method-generic-function object)
+                           (sb-pcl::unparse-specializers
+                            (sb-mop:method-generic-function object)
+                            (sb-mop:method-specializers object))
+                           (sb-mop:method-specializers object)))))
        source))
     #+sb-eval
     (sb-eval:interpreted-function
@@ -337,8 +340,10 @@ If an unsupported TYPE is requested, the function will return NIL.
              (struct-predicate-structure-class object)))
            (t
             (find-function-definition-source object))))
+    ((or condition standard-object structure-object)
+     (find-definition-source (class-of object)))
     (t
-     (error "Don't know how to retrive source location for a ~S~%"
+     (error "Don't know how to retrieve source location for a ~S~%"
             (type-of object)))))
 
 (defun find-function-definition-source (function)
@@ -411,8 +416,7 @@ not found"
         #+sb-eval
         ((typep function 'sb-eval:interpreted-function)
          (sb-eval:interpreted-function-lambda-list function))
-        (t (sb-impl::%simple-fun-arglist
-            (sb-impl::%closure-fun function)))))
+        (t (sb-kernel:%simple-fun-arglist (sb-kernel:%fun-fun function)))))
 
 (defun struct-accessor-structure-class (function)
   (let ((self (sb-vm::%simple-fun-self function)))
@@ -495,7 +499,8 @@ list of the symbols :dynamic, :static, or :read-only."
      (lambda (obj header size)
        (when (= sb-vm:code-header-widetag header)
          (funcall fn obj size)))
-     space)))
+     space
+     t)))
 
 (declaim (inline map-caller-code-components))
 (defun map-caller-code-components (function spaces fn)