(in-package "SB!KERNEL")
-(sb!alien:define-alien-routine ("purify" %purify) sb!c-call:void
- (static-roots sb!c-call:unsigned-long)
- (read-only-roots sb!c-call:unsigned-long))
+(sb!alien:define-alien-routine ("purify" %purify) sb!alien:void
+ (static-roots sb!alien:unsigned-long)
+ (read-only-roots sb!alien:unsigned-long))
;;; Compact the info environment. This is written with gratuitous
;;; recursion to make sure that our (and compact-info-environment's)
((zerop n)
(let ((old-ie (car *info-environment*)))
(setq *info-environment*
- (list* (make-info-environment :name "Working")
- (compact-info-environment (first *info-environment*)
- :name name)
- (rest *info-environment*)))
- (shrink-vector (sb!c::volatile-info-env-table old-ie) 0)))
+ (list* (make-info-environment :name "Working")
+ (compact-info-environment (first *info-environment*)
+ :name name)
+ (rest *info-environment*)))
+ (%shrink-vector (sb!c::volatile-info-env-table old-ie) 0)))
(t
(compact-environment-aux name (1- n))
n)))
(defun purify (&key root-structures (environment-name "Auxiliary"))
- #!+sb-doc
+ ;; #!+sb-doc
"This function optimizes garbage collection by moving all currently live
objects into non-collected storage. ROOT-STRUCTURES is an optional list of
objects which should be copied first to maximize locality.
ENVIRONMENT-NAME is gratuitous documentation for compacted version of the
current global environment (as seen in SB!C::*INFO-ENVIRONMENT*.) If NIL is
- supplied, then environment compaction is inhibited."
-
- (when environment-name (compact-environment-aux environment-name 200))
-
- (let ((*gc-notify-before*
- #'(lambda (notify-stream bytes-in-use)
- (declare (ignore bytes-in-use))
- (write-string "[doing purification: " notify-stream)
- (force-output notify-stream)))
- (*internal-gc*
- #'(lambda ()
- (%purify (get-lisp-obj-address root-structures)
- (get-lisp-obj-address nil))))
- (*gc-notify-after*
- #'(lambda (notify-stream &rest ignore)
- (declare (ignore ignore))
- (write-line "done]" notify-stream))))
- (gc))
- nil)
+ supplied, then environment compaction is inhibited.
+
+ This function is a no-op on platforms using the generational garbage
+ collector (x86, x86-64, ppc)."
+ #!+gencgc
+ (declare (ignore root-structures environment-name))
+ #!-gencgc
+ (progn
+ (when environment-name
+ (compact-environment-aux environment-name 200))
+ (%purify (get-lisp-obj-address root-structures)
+ (get-lisp-obj-address nil))))