X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=contrib%2Fstale-symbols.lisp;h=e59e79595eedba1caf6d0a4a2b57a8aa46b7fc75;hb=3db292921fabecad0ba8107097d763ba2a044136;hp=1e84555db16fdbea544b6a6bb55eff7128685a04;hpb=f9aaac53a4a43ebae198f53079857acb2d628eb0;p=sbcl.git diff --git a/contrib/stale-symbols.lisp b/contrib/stale-symbols.lisp index 1e84555..e59e795 100644 --- a/contrib/stale-symbols.lisp +++ b/contrib/stale-symbols.lisp @@ -3,8 +3,6 @@ ;;; ;;; Known deficiencies: ;;; -;;; * flags CATCH tags as stale; -;;; * flags constants (under certain circumstances) as stale; ;;; * output is not necessarily terribly clear; ;;; * takes a long time (several hours on CSR's 300MHz x86 desktop) to ;;; run. @@ -23,67 +21,80 @@ ;;; only one reference that looks like it is likely from the internals ;;; of a package-related datastructure, the name of the symbol and its ;;; package is displayed. +;;; ;;; The "references to that symbol" are found using the function -;;; VM::LIST-REFERENCING-OBJECTS. Consider for example a function that -;;; uses the value of a symbol. The code-object for that function +;;; SB-VM::MAP-REFERENCING-OBJECTS. Consider for example a function +;;; that uses the value of a symbol. The code-object for that function ;;; contains a reference to the symbol, so that a call to SYMBOL-VALUE ;;; can be made at runtime. The data structures corresponding to a ;;; package must maintain a list of its exported an imported symbols. ;;; They contain a hashtable, which contains a vector, which contains -;;; symbols. So all exported symbols will have at least one referencing -;;; object: a vector related to some package. -;;; -;;; Limitations: these routines will provide a number of false -;;; positives (symbols that are not actually stale). Throw/catch tags -;;; are displayed, but are not stale. It displays the names of -;;; restarts. Worse, it displays the names of CMUCL-internal constants. -;;; These symbols that name constants are not referenced from anywhere -;;; expect the package datastructures because the compiler can -;;; substitute their value wherever they're used in the CMUCL source -;;; code, without keeping a reference to the symbol hanging around. -;;; There are also a number of PCL-related symbols that are displayed, -;;; but probably used internally by PCL. +;;; symbols. So all exported symbols will have at least one +;;; referencing object: a vector related to some package. ;;; -;;; Moral: the output of these routines must be checked carefully -;;; before going on a code deletion spree. +;;; Limitations: these routines may provide a number of false +;;; positives (symbols that are not actually stale). There are also a +;;; number of PCL-related symbols that are displayed, but probably +;;; used internally by PCL. Moral: the output of these routines must +;;; be checked carefully before going on a code deletion spree. (defun print-stale-reference (obj stream) (cond ((vectorp obj) (format stream "vector (probable package internals)")) - ((sb-c::compiled-debug-function-p obj) - (format stream "#" - (sb-c::compiled-debug-function-name obj))) + ((sb-c::compiled-debug-fun-p obj) + (format stream "#" + (sb-c::compiled-debug-fun-name obj))) + ((sb-kernel:code-component-p obj) + (format stream "#" + (let ((dinfo (sb-kernel:%code-debug-info obj))) + (cond + ((eq dinfo :bogus-lra) "BOGUS-LRA") + (t (sb-c::debug-info-name dinfo)))))) (t (format stream "~w" obj)))) +(defun external-symbol-p (obj) + (declare (type symbol obj)) + (let ((package (symbol-package obj))) + (and package + (eq (nth-value 1 (find-symbol (symbol-name obj) package)) + :external)))) + (defun find-stale-objects () (dolist (space '(:static :dynamic :read-only)) (sb-vm::map-allocated-objects (lambda (obj type size) (declare (optimize (safety 0)) (ignore size)) - (when (eql type sb-vm:symbol-header-widetag) - (ignore-errors - (let ((read-only-space-refs (sb-vm::list-referencing-objects :read-only obj)) - (static-space-refs (sb-vm::list-referencing-objects :static obj)) - (dynamic-space-refs (sb-vm::list-referencing-objects :dynamic obj))) - (when (>= 1 (+ (length read-only-space-refs) - (length static-space-refs) - (length dynamic-space-refs))) - (format t "Symbol ~a::~a~%" - (and (symbol-package obj) - (package-name (symbol-package obj))) - (symbol-name obj)) - (unless (null read-only-space-refs) - (princ " Reference in read-only space: ") - (print-stale-reference (car read-only-space-refs) t) - (terpri)) - (unless (null static-space-refs) - (princ " Reference in static space: ") - (print-stale-reference (car static-space-refs) t) - (terpri)) - (unless (null dynamic-space-refs) - (princ " Reference in dynamic space: ") - (print-stale-reference (car dynamic-space-refs) t) - (terpri))))))) + (block mapper + (when (eql type sb-vm:symbol-header-widetag) + (ignore-errors + (let ((refs (let ((res nil) + (count 0)) + (dolist (space '(:static :dynamic :read-only)) + (sb-vm::map-referencing-objects + (lambda (o) + (when (> (incf count) 1) + (return-from mapper nil)) + (push (cons space o) res)) + space obj)) + res))) + (let ((externalp (external-symbol-p obj))) + (format t "~:[S~;External s~]ymbol ~:[#~;~:*~A:~]~2:*~:[:~;~]~*~A~%" + externalp + (and (symbol-package obj) + (package-name (symbol-package obj))) + (symbol-name obj))) + (if (null refs) + (progn (princ " No references found") (terpri)) + (progn + (ecase (caar refs) + (:read-only + (princ " Reference in read-only space: ")) + (:static + (princ " Reference in static space: ")) + (:dynamic + (princ " Reference in dynamic space: "))) + (print-stale-reference (cdar refs) t) + (terpri)))))))) space)))