src/code/purify.lisp

   1 ;;;; This software is part of the SBCL system. See the README file for
   2 ;;;; more information.
   3 ;;;;
   4 ;;;; This software is derived from the CMU CL system, which was
   5 ;;;; written at Carnegie Mellon University and released into the
   6 ;;;; public domain. The software is in the public domain and is
   7 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
   8 ;;;; files for more information.
   9
  10 (in-package "SB!KERNEL")
  11
  12 (file-comment
  13   "$Header$")
  14
  15 (sb!alien:def-alien-routine ("purify" %purify) sb!c-call:void
  16   (static-roots sb!c-call:unsigned-long)
  17   (read-only-roots sb!c-call:unsigned-long))
  18
  19 ;;; Compact the info environment. This is written with gratuitous
  20 ;;; recursion to make sure that our (and compact-info-environment's)
  21 ;;; local variables are above the stack top when purify runs.
  22 (defun compact-environment-aux (name n)
  23   (cond
  24    ((zerop n)
  25     (let ((old-ie (car *info-environment*)))
  26       (setq *info-environment*
  27             (list* (make-info-environment :name "Working")
  28                    (compact-info-environment (first *info-environment*)
  29                                              :name name)
  30                    (rest *info-environment*)))
  31       (shrink-vector (sb!c::volatile-info-env-table old-ie) 0)))
  32    (t
  33     (compact-environment-aux name (1- n))
  34     n)))
  35
  36 (defun purify (&key root-structures (environment-name "Auxiliary"))
  37   #!+sb-doc
  38   "This function optimizes garbage collection by moving all currently live
  39    objects into non-collected storage. ROOT-STRUCTURES is an optional list of
  40    objects which should be copied first to maximize locality.
  41
  42    DEFSTRUCT structures defined with the (:PURE T) option are moved into
  43    read-only storage, further reducing GC cost. List and vector slots of pure
  44    structures are also moved into read-only storage.
  45
  46    ENVIRONMENT-NAME is gratuitous documentation for compacted version of the
  47    current global environment (as seen in SB!C::*INFO-ENVIRONMENT*.) If NIL is
  48    supplied, then environment compaction is inhibited."
  49
  50   (when environment-name (compact-environment-aux environment-name 200))
  51
  52   (let ((*gc-notify-before*
  53          #'(lambda (notify-stream bytes-in-use)
  54              (declare (ignore bytes-in-use))
  55              (write-string "[doing purification: " notify-stream)
  56              (force-output notify-stream)))
  57         (*internal-gc*
  58          #'(lambda ()
  59              (%purify (get-lisp-obj-address root-structures)
  60                       (get-lisp-obj-address nil))))
  61         (*gc-notify-after*
  62          #'(lambda (notify-stream &rest ignore)
  63              (declare (ignore ignore))
  64              (write-line "done]" notify-stream))))
  65     #!-gencgc (gc t)
  66     #!+gencgc (gc :verbose t))
  67   nil)