Fix working-directory lossage.
authorStephen Adams <edu/mit/csail/zurich/adams>
Tue, 25 Oct 1994 01:44:33 +0000 (01:44 +0000)
committerStephen Adams <edu/mit/csail/zurich/adams>
Tue, 25 Oct 1994 01:44:33 +0000 (01:44 +0000)
v7/src/edwin/dos.scm

index b9787a33eb585783774cb325e1f84ed7568152b0..0bbff9eaf97092fb7f34c4dc46ce4fed47cd2f97 100644 (file)
@@ -1,8 +1,8 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Id: dos.scm,v 1.16 1994/10/07 20:04:59 adams Exp $
+;;;    $Id: dos.scm,v 1.17 1994/10/25 01:44:33 adams Exp $
 ;;;
-;;;    Copyright (c) 1992-1993 Massachusetts Institute of Technology
+;;;    Copyright (c) 1992-1994 Massachusetts Institute of Technology
 ;;;
 ;;;    This material was developed by the Scheme project at the
 ;;;    Massachusetts Institute of Technology, Department of
@@ -474,18 +474,24 @@ Includes the new backup.  Must be > 0."
   true)
 
 (define (os/quit dir)
-  (without-interrupts
-    (lambda ()
-      (with-real-working-directory-pathname dir %quit))))
+  (with-real-working-directory-pathname dir %quit))
 
 (define (with-real-working-directory-pathname dir thunk)
-  (let ((inside dir)
+  (let ((inside (->namestring (directory-pathname-as-file dir)))
        (outside false))
     (dynamic-wind
      (lambda ()
-       (set! outside (working-directory-pathname))
-       (set-working-directory-pathname! inside))
+       (stop-thread-timer)
+       (set! outside (->namestring
+                         (directory-pathname-as-file
+                          (working-directory-pathname))))
+       (set-working-directory-pathname! inside)
+       ((ucode-primitive set-working-directory-pathname! 1) inside))
      thunk
      (lambda ()
-       (set! inside (working-directory-pathname))
-       (set-working-directory-pathname! outside)))))
\ No newline at end of file
+       (set! inside (->namestring
+                    (directory-pathname-as-file
+                     (working-directory-pathname))))
+       ((ucode-primitive set-working-directory-pathname! 1) outside)
+       (set-working-directory-pathname! outside)
+       (start-thread-timer)))))
\ No newline at end of file