1.0.32.38: liberalize WHO-SPECIALIZES-DIRECTLY/GENERALLY

[sbcl.git] / contrib / sb-introspect / introspect.lisp

diff --git a/contrib/sb-introspect/introspect.lisp b/contrib/sb-introspect/introspect.lisp
index 735d92f..f031284 100644 (file)
--- a/contrib/sb-introspect/introspect.lisp
+++ b/contrib/sb-introspect/introspect.lisp
@@ -639,6 +639,8 @@ designated class.
 Experimental.
 "
   (let ((class (canonicalize-class-designator class-designator)))
+    (unless class
+      (return-from who-specializes-directly nil))
     (let ((result (collect-specializing-methods
                    #'(lambda (specl)
                        ;; Does SPECL specialize on CLASS directly?
@@ -670,6 +672,8 @@ designated class or a subclass of it.
 Experimental.
 "
   (let ((class (canonicalize-class-designator class-designator)))
+    (unless class
+      (return-from who-specializes-generally nil))
     (let ((result (collect-specializing-methods
                    #'(lambda (specl)
                        ;; Does SPECL specialize on CLASS or a subclass
@@ -689,9 +693,10 @@ Experimental.
                 result))))
 
 (defun canonicalize-class-designator (class-designator)
-  (etypecase class-designator
-    (symbol (find-class class-designator))
-    (class  class-designator)))
+  (typecase class-designator
+    (symbol (find-class class-designator nil))
+    (class  class-designator)
+    (t nil)))
 
 (defun method-generic-function-name (method)
   (sb-mop:generic-function-name (sb-mop:method-generic-function method)))
@@ -730,6 +735,11 @@ For :HEAP objects the secondary value is a plist:
     Indicates a \"large\" object subject to non-copying
     promotion. (GENCGC and :SPACE :DYNAMIC only.)
 
+  :BOXED
+    Indicates that the object is allocated in a boxed region. Unboxed
+    allocation is used for eg. specialized arrays after they have survived one
+    collection. (GENCGC and :SPACE :DYNAMIC only.)
+
   :PINNED
     Indicates that the page(s) on which the object resides are kept live due
     to conservative references. Note that object may reside on a pinned page
@@ -781,6 +791,7 @@ Experimental: interface subject to change."
                              (list :space space
                                    :generation (sb-alien:slot page 'sb-vm::gen)
                                    :write-protected (logbitp 0 flags)
+                                   :boxed (logbitp 2 flags)
                                    :pinned (logbitp 5 flags)
                                    :large (logbitp 6 flags)))))
                        (list :space space))