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 ;;; * flags CATCH tags as stale;
   7 ;;; * flags constants (under certain circumstances) as stale;
   8 ;;; * output is not necessarily terribly clear;
   9 ;;; * takes a long time (several hours on CSR's 300MHz x86 desktop) to
  10 ;;;   run.
  11 ;;;
  12 ;;; Comment from Eric Marsden:
  13 ;;;
  14 ;;; This file contains code that attempts to identify symbols in a
  15 ;;; CMUCL image that are stale. For example, the package descriptions
  16 ;;; in src/code/package.lisp can get out of sync with the source code,
  17 ;;; leading to symbols that are exported without being used anywhere.
  18 ;;;
  19 ;;; The routines work by walking all the objects allocated in a heap
  20 ;;; image (using the function VM::MAP-ALLOCATED-OBJECTS). For each
  21 ;;; object of type symbol, it scans the entire heap for objects that
  22 ;;; reference that symbol. If it finds no references, or if there is
  23 ;;; only one reference that looks like it is likely from the internals
  24 ;;; of a package-related datastructure, the name of the symbol and its
  25 ;;; package is displayed.
  26 ;;; The "references to that symbol" are found using the function
  27 ;;; VM::LIST-REFERENCING-OBJECTS. Consider for example a function that
  28 ;;; uses the value of a symbol. The code-object for that function
  29 ;;; contains a reference to the symbol, so that a call to SYMBOL-VALUE
  30 ;;; can be made at runtime. The data structures corresponding to a
  31 ;;; package must maintain a list of its exported an imported symbols.
  32 ;;; They contain a hashtable, which contains a vector, which contains
  33 ;;; symbols. So all exported symbols will have at least one referencing
  34 ;;; object: a vector related to some package.
  35 ;;;
  36 ;;; Limitations: these routines will provide a number of false
  37 ;;; positives (symbols that are not actually stale). Throw/catch tags
  38 ;;; are displayed, but are not stale. It displays the names of
  39 ;;; restarts. Worse, it displays the names of CMUCL-internal constants.
  40 ;;; These symbols that name constants are not referenced from anywhere
  41 ;;; expect the package datastructures because the compiler can
  42 ;;; substitute their value wherever they're used in the CMUCL source
  43 ;;; code, without keeping a reference to the symbol hanging around.
  44 ;;; There are also a number of PCL-related symbols that are displayed,
  45 ;;; but probably used internally by PCL.
  46 ;;;
  47 ;;; Moral: the output of these routines must be checked carefully
  48 ;;; before going on a code deletion spree.
  49
  50 (defun print-stale-reference (obj stream)
  51   (cond ((vectorp obj)
  52          (format stream "vector (probable package internals)"))
  53         ((sb-c::compiled-debug-function-p obj)
  54          (format stream "#<compiled-debug-function ~a>"
  55                  (sb-c::compiled-debug-function-name obj)))
  56         (t
  57          (format stream "~w" obj))))
  58
  59 (defun find-stale-objects ()
  60   (dolist (space '(:static :dynamic :read-only))
  61     (sb-vm::map-allocated-objects
  62      (lambda (obj type size)
  63        (declare (optimize (safety 0))
  64                 (ignore size))
  65        (when (eql type sb-vm:symbol-header-widetag)
  66          (ignore-errors
  67            (let ((read-only-space-refs (sb-vm::list-referencing-objects :read-only obj))
  68                  (static-space-refs (sb-vm::list-referencing-objects :static obj))
  69                  (dynamic-space-refs (sb-vm::list-referencing-objects :dynamic obj)))
  70              (when (>= 1 (+ (length read-only-space-refs)
  71                             (length static-space-refs)
  72                             (length dynamic-space-refs)))
  73                (format t "Symbol ~a::~a~%"
  74                        (and (symbol-package obj)
  75                             (package-name (symbol-package obj)))
  76                        (symbol-name obj))
  77                (unless (null read-only-space-refs)
  78                  (princ "   Reference in read-only space: ")
  79                  (print-stale-reference (car read-only-space-refs) t)
  80                  (terpri))
  81                (unless (null static-space-refs)
  82                  (princ "   Reference in static space: ")
  83                  (print-stale-reference (car static-space-refs) t)
  84                  (terpri))
  85                (unless (null dynamic-space-refs)
  86                  (princ "   Reference in dynamic space: ")
  87                  (print-stale-reference (car dynamic-space-refs) t)
  88                  (terpri)))))))
  89      space)))