- (when (eql type sb-vm:symbol-header-widetag)
- (ignore-errors
- (let ((read-only-space-refs (sb-vm::list-referencing-objects :read-only obj))
- (static-space-refs (sb-vm::list-referencing-objects :static obj))
- (dynamic-space-refs (sb-vm::list-referencing-objects :dynamic obj)))
- (when (>= 1 (+ (length read-only-space-refs)
- (length static-space-refs)
- (length dynamic-space-refs)))
- (format t "Symbol ~a::~a~%"
- (and (symbol-package obj) (package-name (symbol-package obj)))
- (symbol-name obj))
- (unless (null read-only-space-refs)
- (princ " Reference in read-only space: ")
- (print-stale-reference (car read-only-space-refs) t)
- (terpri))
- (unless (null static-space-refs)
- (princ " Reference in static space: ")
- (print-stale-reference (car static-space-refs) t)
- (terpri))
- (unless (null dynamic-space-refs)
- (princ " Reference in dynamic space: ")
- (print-stale-reference (car dynamic-space-refs) t)
- (terpri)))))))
+ (block mapper
+ (when (eql type sb-vm:symbol-header-widetag)
+ (ignore-errors
+ (let ((refs (let ((res nil)
+ (count 0))
+ (dolist (space '(:static :dynamic :read-only))
+ (sb-vm::map-referencing-objects
+ (lambda (o)
+ (when (> (incf count) 1)
+ (return-from mapper nil))
+ (push (cons space o) res))
+ space obj))
+ res)))
+ (let ((externalp (external-symbol-p obj)))
+ (format t "~:[S~;External s~]ymbol ~:[#~;~:*~A:~]~2:*~:[:~;~]~*~A~%"
+ externalp
+ (and (symbol-package obj)
+ (package-name (symbol-package obj)))
+ (symbol-name obj)))
+ (if (null refs)
+ (progn (princ " No references found") (terpri))
+ (progn
+ (ecase (caar refs)
+ (:read-only
+ (princ " Reference in read-only space: "))
+ (:static
+ (princ " Reference in static space: "))
+ (:dynamic
+ (princ " Reference in dynamic space: ")))
+ (print-stale-reference (cdar refs) t)
+ (terpri))))))))