1 ;;; This code is currently essentially the same as code posted by Eric
2 ;;; Marsden to cmucl-imp, to detect stale symbols in a core.
4 ;;; Known deficiencies:
6 ;;; * flags CATCH tags as stale;
7 ;;; * flags constants (under certain circumstances) as stale;
8 ;;; * output is not necessarily terribly clear;
9 ;;; * takes a long time (several hours on CSR's 300MHz x86 desktop) to
12 (defun print-stale-reference (obj stream)
14 (format stream "vector (probable package internals)"))
15 ((sb-c::compiled-debug-function-p obj)
16 (format stream "#<compiled-debug-function ~a>"
17 (sb-c::compiled-debug-function-name obj)))
19 (format stream "~w" obj))))
21 (defun find-stale-objects ()
22 (dolist (space '(:static :dynamic :read-only))
23 (sb-vm::map-allocated-objects
24 (lambda (obj type size)
25 (declare (optimize (safety 0))
27 (when (eql type sb-vm:symbol-header-widetag)
29 (let ((read-only-space-refs (sb-vm::list-referencing-objects :read-only obj))
30 (static-space-refs (sb-vm::list-referencing-objects :static obj))
31 (dynamic-space-refs (sb-vm::list-referencing-objects :dynamic obj)))
32 (when (>= 1 (+ (length read-only-space-refs)
33 (length static-space-refs)
34 (length dynamic-space-refs)))
35 (format t "Symbol ~a::~a~%"
36 (and (symbol-package obj) (package-name (symbol-package obj)))
38 (unless (null read-only-space-refs)
39 (princ " Reference in read-only space: ")
40 (print-stale-reference (car read-only-space-refs) t)
42 (unless (null static-space-refs)
43 (princ " Reference in static space: ")
44 (print-stale-reference (car static-space-refs) t)
46 (unless (null dynamic-space-refs)
47 (princ " Reference in dynamic space: ")
48 (print-stale-reference (car dynamic-space-refs) t)