Add :application-type parameter for save-lisp-and-die on Windows.
[sbcl.git] / contrib / stale-symbols.lisp
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.
3 ;;;
4 ;;; Known deficiencies:
5 ;;;
6 ;;; * output is not necessarily terribly clear;
7 ;;; * takes a long time (several hours on CSR's 300MHz x86 desktop) to
8 ;;;   run.
9 ;;;
10 ;;; Comment from Eric Marsden:
11 ;;;
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.
16 ;;;
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.
24 ;;;
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.
34 ;;;
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.
40
41 (defun print-stale-reference (obj stream)
42   (cond ((vectorp obj)
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)))
50                    (cond
51                      ((eq dinfo :bogus-lra) "BOGUS-LRA")
52                      (t (sb-c::debug-info-name dinfo))))))
53         (t
54          (format stream "~w" obj))))
55
56 (defun external-symbol-p (obj)
57   (declare (type symbol obj))
58   (let ((package (symbol-package obj)))
59     (and package
60          (eq (nth-value 1 (find-symbol (symbol-name obj) package))
61              :external))))
62
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))
68                 (ignore size))
69        (block mapper
70          (when (eql type sb-vm:symbol-header-widetag)
71            (ignore-errors
72              (let ((refs (let ((res nil)
73                                (count 0))
74                            (dolist (space '(:static :dynamic :read-only))
75                              (sb-vm::map-referencing-objects
76                               (lambda (o)
77                                 (when (> (incf count) 1)
78                                   (return-from mapper nil))
79                                 (push (cons space o) res))
80                               space obj))
81                            res)))
82                (let ((externalp (external-symbol-p obj)))
83                  (format t "~:[S~;External s~]ymbol ~:[#~;~:*~A:~]~2:*~:[:~;~]~*~A~%"
84                          externalp
85                          (and (symbol-package obj)
86                               (package-name (symbol-package obj)))
87                          (symbol-name obj)))
88                (if (null refs)
89                    (progn (princ "   No references found") (terpri))
90                    (progn
91                      (ecase (caar refs)
92                        (:read-only
93                         (princ "   Reference in read-only space: "))
94                        (:static
95                         (princ "   Reference in static space: "))
96                        (:dynamic
97                         (princ "   Reference in dynamic space: ")))
98                      (print-stale-reference (cdar refs) t)
99                      (terpri))))))))
100      space)))