From: Chris Hanson <org/chris-hanson/cph>
Date: Thu, 2 Jun 1994 21:41:07 +0000 (+0000)
Subject: Patch UNIX/SYSTEM so that it works properly when the working directory
X-Git-Tag: 20090517-FFI~7165
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=6f1859fbc84c4b8ce1695f70e514b62918a52cd7;p=mit-scheme.git

Patch UNIX/SYSTEM so that it works properly when the working directory
is different from that of the microcode and when multiple threads are
in use.
---

diff --git a/v7/src/runtime/unxprm.scm b/v7/src/runtime/unxprm.scm
index c0d577f99..8795e0b8f 100644
--- a/v7/src/runtime/unxprm.scm
+++ b/v7/src/runtime/unxprm.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: unxprm.scm,v 1.29 1994/03/11 05:19:06 cph Exp $
+$Id: unxprm.scm,v 1.30 1994/06/02 21:41:07 cph Exp $
 
 Copyright (c) 1988-94 Massachusetts Institute of Technology
 
@@ -247,8 +247,24 @@ MIT in each case. |#
 (define-integrable unix/current-pid
   (ucode-primitive current-pid 0))
 
-(define-integrable unix/system
-  (ucode-primitive system 1))
+(define (unix/system string)
+  (let ((wd-inside (->namestring (working-directory-pathname)))
+	(wd-outside)
+	(ti-outside))
+    (dynamic-wind
+     (lambda ()
+       (set! wd-outside ((ucode-primitive working-directory-pathname 0)))
+       ((ucode-primitive set-working-directory-pathname! 1) wd-inside)
+       (set! ti-outside (thread-timer-interval))
+       (set-thread-timer-interval! #f))
+     (lambda ()
+       ((ucode-primitive system 1) string))
+     (lambda ()
+       ((ucode-primitive set-working-directory-pathname! 1) wd-outside)
+       (set! wd-outside)
+       (set-thread-timer-interval! ti-outside)
+       (set! ti-outside)
+       unspecific))))
 
 (define (file-touch filename)
   ((ucode-primitive file-touch 1) (->namestring (merge-pathnames filename))))