diff --git a/code/purify.lisp b/code/purify.lisp
index f57c22b028adca52eeac6aceb7d6e3db03ff40dc..e75120da24318d121c268c0960d40d173e1ab777 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.16 1994/02/14 13:48:24 ram Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/purify.lisp,v 1.17 1994/02/14 14:05:23 ram Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -23,6 +23,28 @@
   (static-roots c-call:unsigned-long)
   (read-only-roots c-call:unsigned-long))
 
+
+;;; COMPACT-ENVIRONMENT-AUX  --  Internal
+;;;
+;;;    Compact the info environment.  Written with gratuitous recursion to
+;;; make sure that our (and compact-info-environment's) local variables are
+;;; above the stack top when purify runs.
+;;;
+(defun compact-environment-aux (name n)
+  (cond
+   ((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 (c::volatile-info-env-table old-ie) 0)))
+   (t
+    (compact-environment-aux name (1- n))
+    n)))
+
+
 (defun purify (&key root-structures (environment-name "Auxiliary"))
   "This function optimizes garbage collection by moving all currently live
    objects into non-collected storage.  ROOT-STRUCTURES is an optional list of
@@ -35,16 +57,8 @@
    ENVIRONMENT-NAME is gratuitous documentation for compacted version of the
    current global environment (as seen in C::*INFO-ENVIRONMENT*.)  If NIL is
    supplied, then environment compaction is inhibited."
-  (when environment-name
-    (let ((old-ie (car *info-environment*)))
-      (setq *info-environment*
-	    (list* (make-info-environment :name "Working")
-		   (compact-info-environment (first *info-environment*)
-					     :name environment-name)
-		   (rest *info-environment*)))
-      ;; next 2 lines for GC.
-      (shrink-vector (c::volatile-info-env-table old-ie) 0)
-      (setq old-ie nil)))
+
+  (when environment-name (compact-environment-aux environment-name 200))
 
   (let ((*gc-notify-before*
 	 #'(lambda (bytes-in-use)