From a890b8ddcde8f7981c2802fd6dba00dc094249cd Mon Sep 17 00:00:00 2001
From: wlott <wlott>
Date: Thu, 26 Mar 1992 03:18:51 +0000
Subject: [PATCH] Changed purify to bind *INTERNAL-GC* and then invoke the
 garbage collector so all the auxiliary stuff (hooks, etc.) gets handled
 correctly.

---
 code/purify.lisp | 27 +++++++++++++++------------
 1 file changed, 15 insertions(+), 12 deletions(-)

diff --git a/code/purify.lisp b/code/purify.lisp
index 28a5daca8..1ced80ba2 100644
--- a/code/purify.lisp
+++ b/code/purify.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/purify.lisp,v 1.12 1992/02/14 23:45:24 wlott Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/purify.lisp,v 1.13 1992/03/26 03:18:51 wlott Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -23,16 +23,19 @@
   (read-only-roots c-call:unsigned-long))
 
 (defun purify (&key root-structures constants)
-  (write-string "[Doing purification: ")
-  (force-output)
-  (without-gcing
-   (clear-auto-gc-trigger)
-   (%purify (get-lisp-obj-address root-structures)
-	    (get-lisp-obj-address constants))
-   (when *gc-trigger*
-     (setf *gc-trigger* *bytes-consed-between-gcs*)
-     (set-auto-gc-trigger *gc-trigger*)))
-  (write-line "Done.]")
-  (force-output)
+  (let ((*gc-notify-before*
+	 #'(lambda (bytes-in-use)
+	     (declare (ignore bytes-in-use))
+	     (write-string "[Doing purification: ")
+	     (force-output)))
+	(*internal-gc*
+	 #'(lambda ()
+	     (%purify (get-lisp-obj-address root-structures)
+		      (get-lisp-obj-address constants))))
+	(*gc-notify-after*
+	 #'(lambda (&rest ignore)
+	     (declare (ignore ignore))
+	     (write-line "Done.]"))))
+    (gc t))
   nil)
 
-- 
GitLab