X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fpurify.lisp;h=82cc7cd7f5e0dcf0be80908e7a40ab7579d3d9ca;hb=4898ef32c639b1c7f4ee13a5ba566ce6debd03e6;hp=32bef5b2e34dd356b0a16a5a3550c434e59e010d;hpb=a530bbe337109d898d5b4a001fc8f1afa3b5dc39;p=sbcl.git

diff --git a/src/code/purify.lisp b/src/code/purify.lisp
index 32bef5b..82cc7cd 100644
--- a/src/code/purify.lisp
+++ b/src/code/purify.lisp
@@ -9,12 +9,9 @@
 
 (in-package "SB!KERNEL")
 
-(file-comment
-  "$Header$")
-
-(sb!alien:def-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)
@@ -24,17 +21,17 @@
    ((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*)))
+            (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.
@@ -48,20 +45,5 @@
    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))))
-    #!-gencgc (gc t)
-    #!+gencgc (gc :verbose t))
-  nil)
+  (%purify (get-lisp-obj-address root-structures)
+           (get-lisp-obj-address nil)))