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 ;;; * output is not necessarily terribly clear;
7 ;;; * takes a long time (several hours on CSR's 300MHz x86 desktop) to
10 ;;; Comment from Eric Marsden:
12 ;;; This file contains code that attempts to identify symbols in a
13 ;;; CMUCL image that are stale. For example, the package descriptions
14 ;;; in src/code/package.lisp can get out of sync with the source code,
15 ;;; leading to symbols that are exported without being used anywhere.
17 ;;; The routines work by walking all the objects allocated in a heap
18 ;;; image (using the function VM::MAP-ALLOCATED-OBJECTS). For each
19 ;;; object of type symbol, it scans the entire heap for objects that
20 ;;; reference that symbol. If it finds no references, or if there is
21 ;;; only one reference that looks like it is likely from the internals
22 ;;; of a package-related datastructure, the name of the symbol and its
23 ;;; package is displayed.
25 ;;; The "references to that symbol" are found using the function
26 ;;; SB-VM::MAP-REFERENCING-OBJECTS. Consider for example a function
27 ;;; that uses the value of a symbol. The code-object for that function
28 ;;; contains a reference to the symbol, so that a call to SYMBOL-VALUE
29 ;;; can be made at runtime. The data structures corresponding to a
30 ;;; package must maintain a list of its exported an imported symbols.
31 ;;; They contain a hashtable, which contains a vector, which contains
32 ;;; symbols. So all exported symbols will have at least one
33 ;;; referencing object: a vector related to some package.
35 ;;; Limitations: these routines may provide a number of false
36 ;;; positives (symbols that are not actually stale). There are also a
37 ;;; number of PCL-related symbols that are displayed, but probably
38 ;;; used internally by PCL. Moral: the output of these routines must
39 ;;; be checked carefully before going on a code deletion spree.
41 (defun print-stale-reference (obj stream)
43 (format stream "vector (probable package internals)"))
44 ((sb-c::compiled-debug-fun-p obj)
45 (format stream "#<compiled-debug-fun ~A>"
46 (sb-c::compiled-debug-fun-name obj)))
47 ((sb-kernel:code-component-p obj)
48 (format stream "#<code ~A>"
49 (let ((dinfo (sb-kernel:%code-debug-info obj)))
51 ((eq dinfo :bogus-lra) "BOGUS-LRA")
52 (t (sb-c::debug-info-name dinfo))))))
54 (format stream "~w" obj))))
56 (defun external-symbol-p (obj)
57 (declare (type symbol obj))
58 (let ((package (symbol-package obj)))
60 (eq (nth-value 1 (find-symbol (symbol-name obj) package))
63 (defun find-stale-objects ()
64 (dolist (space '(:static :dynamic :read-only))
65 (sb-vm::map-allocated-objects
66 (lambda (obj type size)
67 (declare (optimize (safety 0))
70 (when (eql type sb-vm:symbol-header-widetag)
72 (let ((refs (let ((res nil)
74 (dolist (space '(:static :dynamic :read-only))
75 (sb-vm::map-referencing-objects
77 (when (> (incf count) 1)
78 (return-from mapper nil))
79 (push (cons space o) res))
82 (let ((externalp (external-symbol-p obj)))
83 (format t "~:[S~;External s~]ymbol ~:[#~;~:*~A:~]~2:*~:[:~;~]~*~A~%"
85 (and (symbol-package obj)
86 (package-name (symbol-package obj)))
89 (progn (princ " No references found") (terpri))
93 (princ " Reference in read-only space: "))
95 (princ " Reference in static space: "))
97 (princ " Reference in dynamic space: ")))
98 (print-stale-reference (cdar refs) t)