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   (sb-vm::map-allocated-objects
  65      (lambda (obj type size)
  66        (declare (optimize (safety 0))
  67                 (ignore size))
  68        (block mapper
  69          (when (eql type sb-vm:symbol-header-widetag)
  70            (ignore-errors
  71              (let ((refs (let ((res nil)
  72                                (count 0))
  73                            (dolist (space '(:static :dynamic :read-only
  74                                             #+immobile-space :immobile))
  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                               ;; FIXME: while we could use :ALL here,
  81                               ;; then we have a different problem:
  82                               ;; inferring the space for the preceding PUSH.
  83                               ;; That's most readily done by calling SB-VM::SPACE-BOUNDS
  84                               ;; for each known space, storing those answers somewhere,
  85                               ;; and comparing GET-LISP-OBJ-ADDRESS of O to each space.
  86                               ;; Would that be the tail wagging the dog?
  87                               space obj))
  88                            res)))
  89                (let ((externalp (external-symbol-p obj)))
  90                  (format t "~:[S~;External s~]ymbol ~:[#~;~:*~A:~]~2:*~:[:~;~]~*~A~%"
  91                          externalp
  92                          (and (symbol-package obj)
  93                               (package-name (symbol-package obj)))
  94                          (symbol-name obj)))
  95                (if (null refs)
  96                    (progn (princ "   No references found") (terpri))
  97                    (progn
  98                      (ecase (caar refs)
  99                        (:read-only
 100                         (princ "   Reference in read-only space: "))
 101                        (:static
 102                         (princ "   Reference in static space: "))
 103                        (:dynamic
 104                         (princ "   Reference in dynamic space: ")))
 105                      (print-stale-reference (cdar refs) t)
 106                      (terpri))))))))
 107      :all))