]> birchwood-abbey.net Git - mit-scheme.git/commitdiff
Restore *working-directory-pathname* internally.
authorTaylor R Campbell <campbell+mit-scheme@mumble.net>
Tue, 7 Jul 2020 17:21:56 +0000 (17:21 +0000)
committerTaylor R Campbell <campbell+mit-scheme@mumble.net>
Tue, 7 Jul 2020 18:41:38 +0000 (18:41 +0000)
This way we can avoid storing the original working directory in bands
(not yet done in this commit).

(cherry picked from commit ecab16647b545417d5b12bec9a5e03aad0bc1e97)

src/runtime/rep.scm
src/runtime/runtime.pkg
src/runtime/wrkdir.scm

index 2ca7c9399fbd31c8d04497167d23b066f01b6b7f..c23dd5dec240db1a065e215cf1d4792f5a94718e 100644 (file)
@@ -126,8 +126,8 @@ USA.
                            (notification-output-port #f)
                            (trace-output-port #f)
                            (interaction-i/o-port #f)
-                           (working-directory-pathname
-                            (working-directory-pathname))
+                           (*working-directory-pathname*
+                            (*working-directory-pathname*))
                            (current-library-db (current-library-db))
                            (param:nearest-cmdl cmdl)
                            (param:standard-error-hook #f)
index 99ecd71b7683cdc95ed99516b5228a72e71c017d..1acbd123a329372bb1aad9def2a7269e064efc85 100644 (file)
@@ -5424,7 +5424,9 @@ USA.
   (export ()
          set-working-directory-pathname!
          with-working-directory-pathname
-         working-directory-pathname))
+         working-directory-pathname)
+  (export (runtime rep)
+         *working-directory-pathname*))
 
 (define-package (runtime user-interface)
   (files "usrint")
index 85df2f4d9526b40b12b444d1246e0f3c7ae21d6e..bc82a063094cf1dace40197f32460679e1f6e1cd 100644 (file)
@@ -31,7 +31,7 @@ USA.
 
 (add-boot-deps! '(runtime pathname))
 \f
-(define-deferred working-directory-pathname
+(define-deferred *working-directory-pathname*
   (make-general-parameter #f
                          default-parameter-converter
                          default-parameter-merger
@@ -43,8 +43,11 @@ USA.
   (param:default-pathname-defaults pathname)
   pathname)
 
+(define (working-directory-pathname)
+  (*working-directory-pathname*))
+
 (define (reset!)
-  (working-directory-pathname
+  (*working-directory-pathname*
    (pathname-simplify
     (pathname-as-directory
      (string-from-primitive
@@ -69,7 +72,7 @@ USA.
                                  "no such directory")
                              'set-working-directory-pathname!
                              (list name)))
-    (working-directory-pathname pathname)
+    (*working-directory-pathname* pathname)
     (cmdl/set-default-directory (nearest-cmdl) pathname)
     pathname))
 
@@ -77,7 +80,7 @@ USA.
   (let ((pathname (new-pathname name)))
     (fluid-let ((*default-pathname-defaults* pathname))
       (parameterize ((param:default-pathname-defaults pathname)
-                    (working-directory-pathname pathname))
+                    (*working-directory-pathname* pathname))
        (thunk)))))
 
 (define (new-pathname name)