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)))