Resolve `scheme-subprocess-environment' lazily.

Avoids keeping an unnecessary copy of the environment around.

(This is also redundant with the R7RS environment API -- we have two
primitives for getting a copy of C `environ', added 28 years apart.)

(cherry picked from commit 529576d11ef0c6d62ce6cf57d54bf2dbacbe7187)

diff --git a/src/runtime/process.scm b/src/runtime/process.scm
index 9dad0b817302e04a3d7ed42721720de4c3786310..0e26457c5528e9edf46738685f19ad2a663d5af9 100644 (file)
--- a/src/runtime/process.scm
+++ b/src/runtime/process.scm
@@ -30,7 +30,6 @@ USA.
 (declare (usual-integrations))
 \f
 (define subprocess-finalizer)
-(define scheme-subprocess-environment)
 
 (define (initialize-package!)
   (set! subprocess-finalizer
@@ -39,14 +38,8 @@ USA.
                           subprocess-index
                           set-subprocess-index!))
   (set! subprocess-support-loaded? #t)
-  (reset-package!)
-  (add-event-receiver! event:after-restore reset-package!)
   (add-event-receiver! event:before-exit delete-all-processes))
 
-(define (reset-package!)
-  (set! scheme-subprocess-environment ((ucode-primitive scheme-environment 0)))
-  unspecific)
-
 (define (delete-all-processes)
   (for-each subprocess-delete (subprocess-list)))
 
@@ -175,6 +168,7 @@ USA.
                         (and (cdr environment)
                              (->namestring (cdr environment))))
                   (set! environment (car environment))))
+            (set! environment (resolve-environment environment))
             (without-interruption
              (lambda ()
                (let ((index
@@ -442,8 +436,16 @@ USA.
 \f
 ;;;; Environment Bindings
 
+(define scheme-subprocess-environment
+  '|#[(runtime subprocess)scheme-subprocess-environment]|)
+
+(define (resolve-environment environment)
+  (if (eq? environment scheme-subprocess-environment)
+      ((ucode-primitive scheme-environment 0))
+      environment))
+
 (define (process-environment-bind environment . bindings)
-  (let ((bindings* (vector->list environment)))
+  (let ((bindings* (vector->list (resolve-environment environment))))
     (for-each (lambda (binding)
                (let ((b
                       (find-environment-variable