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 (sb!alien:define-alien-routine ("purify" %purify) sb!alien:void
  13   (static-roots sb!alien:unsigned-long)
  14   (read-only-roots sb!alien:unsigned-long))
  15
  16 ;;; Compact the info environment. This is written with gratuitous
  17 ;;; recursion to make sure that our (and compact-info-environment's)
  18 ;;; local variables are above the stack top when purify runs.
  19 (defun compact-environment-aux (name n)
  20   (cond
  21    ((zerop n)
  22     (let ((old-ie (car *info-environment*)))
  23       (setq *info-environment*
  24             (list* (make-info-environment :name "Working")
  25                    (compact-info-environment (first *info-environment*)
  26                                              :name name)
  27                    (rest *info-environment*)))
  28       (%shrink-vector (sb!c::volatile-info-env-table old-ie) 0)))
  29    (t
  30     (compact-environment-aux name (1- n))
  31     n)))
  32
  33 (defun purify (&key root-structures (environment-name "Auxiliary"))
  34   ;; #!+sb-doc
  35   "This function optimizes garbage collection by moving all currently live
  36    objects into non-collected storage. ROOT-STRUCTURES is an optional list of
  37    objects which should be copied first to maximize locality.
  38
  39    DEFSTRUCT structures defined with the (:PURE T) option are moved into
  40    read-only storage, further reducing GC cost. List and vector slots of pure
  41    structures are also moved into read-only storage.
  42
  43    ENVIRONMENT-NAME is gratuitous documentation for compacted version of the
  44    current global environment (as seen in SB!C::*INFO-ENVIRONMENT*.) If NIL is
  45    supplied, then environment compaction is inhibited.
  46
  47    This function is a no-op on platforms using the generational garbage
  48    collector (x86, x86-64, ppc)."
  49   #!+gencgc
  50   (declare (ignore root-structures environment-name))
  51   #!-gencgc
  52   (progn
  53     (when environment-name
  54       (compact-environment-aux environment-name 200))
  55     (%purify (get-lisp-obj-address root-structures)
  56              (get-lisp-obj-address nil))))