X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=contrib%2Fsb-introspect%2Fintrospect.lisp;h=f0312845f06e4500542c0b9b8893661de15679ed;hb=c000ff1b6d3dbfc0c0b993cfb36f80ec301bda71;hp=735d92fd0c57adee9c74b6eb41d3ec346651d32d;hpb=e5334bc7f2c88a5819e45e2d6e1cfe18af355169;p=sbcl.git diff --git a/contrib/sb-introspect/introspect.lisp b/contrib/sb-introspect/introspect.lisp index 735d92f..f031284 100644 --- 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))