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         (t
  48          (format stream "~w" obj))))
  49
  50 (defun external-symbol-p (obj)
  51   (declare (type symbol obj))
  52   (let ((package (symbol-package obj)))
  53     (and package
  54          (eq (nth-value 1 (find-symbol (symbol-name obj) package))
  55              :external))))
  56
  57 (defun find-stale-objects ()
  58   (sb-vm:map-allocated-objects
  59      (lambda (obj type size)
  60        (declare (optimize (safety 0))
  61                 (ignore size))
  62        (block mapper
  63          (when (eql type sb-vm:symbol-widetag)
  64            (ignore-errors
  65              (let ((refs (let ((res nil)
  66                                (count 0))
  67                            (dolist (space '(:static :dynamic :read-only
  68                                             #+immobile-space :immobile))
  69                              (sb-vm::map-referencing-objects
  70                               (lambda (o)
  71                                 (when (> (incf count) 1)
  72                                   (return-from mapper nil))
  73                                 (push (cons space o) res))
  74                               ;; FIXME: while we could use :ALL here,
  75                               ;; then we have a different problem:
  76                               ;; inferring the space for the preceding PUSH.
  77                               ;; That's most readily done by calling SB-VM::SPACE-BOUNDS
  78                               ;; for each known space, storing those answers somewhere,
  79                               ;; and comparing GET-LISP-OBJ-ADDRESS of O to each space.
  80                               ;; Would that be the tail wagging the dog?
  81                               space obj))
  82                            res)))
  83                (let ((externalp (external-symbol-p obj)))
  84                  (format t "~:[S~;External s~]ymbol ~:[#~;~:*~A:~]~2:*~:[:~;~]~*~A~%"
  85                          externalp
  86                          (and (symbol-package obj)
  87                               (package-name (symbol-package obj)))
  88                          (symbol-name obj)))
  89                (if (null refs)
  90                    (progn (princ "   No references found") (terpri))
  91                    (progn
  92                      (ecase (caar refs)
  93                        (:read-only
  94                         (princ "   Reference in read-only space: "))
  95                        (:static
  96                         (princ "   Reference in static space: "))
  97                        (:dynamic
  98                         (princ "   Reference in dynamic space: ")))
  99                      (print-stale-reference (cdar refs) t)
 100                      (terpri))))))))
 101      :all))