Handle run-program with :directory nil.

[sbcl.git] / src / code / purify.lisp

diff --git a/src/code/purify.lisp b/src/code/purify.lisp
index 162b86c..ecf071c 100644 (file)
--- a/src/code/purify.lisp
+++ b/src/code/purify.lisp
@@ -21,11 +21,11 @@
    ((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)))
@@ -42,8 +42,15 @@
 
    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."
+   supplied, then environment compaction is inhibited.
 
-  (when environment-name (compact-environment-aux environment-name 200))
-  (%purify (get-lisp-obj-address root-structures)
-          (get-lisp-obj-address nil)))
+   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))))