+ Derive general make-process-resource from cwd stuff

+ Implement cwd with make-process-resource
+ Implement umask with make-process-resource
+ Add with-umask-aligned* to exec

scsh/scsh.scm

@@ -283,32 +283,6 @@
 	    #f))			; AFTER doesn't appear in LIST.
       (cons elt list))) 
 
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; working directory per thread
-
-;;; this reflects the cwd of the process
-(define *unix-cwd* 'uninitialized)
-(define cwd-lock 'uninitialized)
-
-(define (initialize-cwd)
-  (set! *unix-cwd* (process-cwd))
-  (set! cwd-lock (make-lock)))
-
-(define (unix-cwd)
-  *unix-cwd*)
-
-
-;;; Actually do the syscall and update the cache
-;;; assumes the cwd lock obtained
-(define (chdir-and-cache dir)
-  (process-chdir dir)
-  (set! *unix-cwd* (process-cwd)))
-
-;;; Dynamic-wind is not the right thing to take care of the lock;
-;;; it would release the lock on every context switch.
-;;; With-lock releases the lock on a condition, using call/cc will 
-;;; skrew things up
-
 ;;; Should be moved to somewhere else
 (define (with-lock lock thunk)
   (with-handler (lambda (condition more)
@@ -320,57 +294,88 @@
 		    (release-lock lock)
 		    result))))
 
-;;; The thread-specific CWD: A fluid
 
-(define $cwd
+;;; A resource is a part of the process state for which every thread
+;;; has its own value
+(define-syntax  make-process-resource
+  (syntax-rules ()
+    ((make-process-resource 
+      initialize-resource 
+      thread-read-resource thread-set-resource with-resource* 
+      with-resource-aligned* process-read-resource process-set-resource)
+(begin 
+(define *resource-cache* 'uninitialized)
+(define resource-lock 'uninitialized)
+
+(define (initialize-resource)
+  (set! *resource-cache* (process-read-resource))
+  (set! resource-lock (make-lock)))
+
+(define (cache-value)
+  *resource-cache*)
+
+;;; Actually do the syscall and update the cache
+;;; assumes the resource lock obtained
+(define (change-and-cache dir)
+  (process-set-resource dir)
+  (set! *resource-cache* (process-read-resource)))
+
+;;; Dynamic-wind is not the right thing to take care of the lock;
+;;; it would release the lock on every context switch.
+;;; With-lock releases the lock on a condition, using call/cc will 
+;;; skrew things up
+
+;;; The thread-specific resource: A thread fluid
+
+(define $resource
   (make-thread-fluid
-   (process-cwd)))
+   (process-read-resource)))
 
-(define (cwd) (thread-fluid $cwd))
+(define (thread-read-resource) (thread-fluid $resource))
-(define (set-cwd! dir) (set-thread-fluid! $cwd dir))
+(define (set-resource! dir) (set-thread-fluid! $resource dir))
-(define (let-cwd dir thunk)
+(define (let-resource dir thunk)
-  (let-thread-fluid $cwd dir thunk))
+  (let-thread-fluid $resource dir thunk))
 
-(define (with-cwd* dir thunk) 
+(define (with-resource* dir thunk) 
-  (let ((changed-dir #f))
+  (let ((changed-dir #f))  ; TODO 0.5 used to have a dynamic-wind here!!!
-    (with-lock cwd-lock
+    (with-lock resource-lock
 	       (lambda ()
-		 (chdir-and-cache dir)
+		 (change-and-cache dir)
-		 (set! changed-dir (unix-cwd))))
+		 (set! changed-dir (cache-value))))
-    (let-cwd changed-dir thunk)))
+    (let-resource changed-dir thunk)))
 
-;; Align the Unix CWD with the scsh CWD.
+;; Align the value of the Unix resource with scsh's value.
 ;; Since another thread could disalign, this call and
 ;; any ensuring syscall that relies upon it should
-;; be "glued together" with the cwd lock.
+;; be "glued together" with the resource lock.
 
-(define (align-cwd!)
+(define (align-resource!)
-  (let ((dir (cwd)))
+  (let ((dir (thread-read-resource)))
-    (if (not (string=? dir (unix-cwd)))
+    (if (not (string=? dir (cache-value)))
-	  (chdir-and-cache dir))))
+	  (change-and-cache dir))))
 
-
+(define (thread-set-resource dir)
-(define (chdir dir)
+  (with-lock resource-lock
-  (with-lock cwd-lock
 	     (lambda ()
-	       (chdir-and-cache dir)
+	       (change-and-cache dir)
-	       (set-cwd! (unix-cwd)))))
+	       (set-resource! (cache-value)))))
 
 ;;; For thunks that don't raise exceptions or throw to continuations,
 ;;; this is overkill & probably a little heavyweight for frequent use.
 ;;; But it is general.
 ;;;
-;;; A less-general, more lightweight hack could be done just for syscalls.
+;;; A less-general, more lightweight hack could be done just for
-;;; We could probably dump the DYNAMIC-WINDs and build the rest of the pattern
+;;; syscalls.  We could probably dump the DYNAMIC-WINDs and build the
-;;; into one of the syscall-defining macros, or something.
+;;; rest of the pattern into one of the syscall-defining macros, or
-;;; Olin adds the following: the efficient way to do things is not with
+;;; something.  
-;;; a dynamic wind or a lock. Just turn off interrupts, sync the cwd, do
+;;; Olin adds the following: the efficient way to do things is not
-;;; the syscall, turn them back on. 
+;;; with a dynamic wind or a lock. Just turn off interrupts, sync the
+;;; resource, do the syscall, turn them back on.
 
-(define (with-cwd-aligned* thunk)
+(define (with-resource-aligned* thunk)
   (dynamic-wind (lambda ()
-		  (with-lock cwd-lock
+		  (with-lock resource-lock
-			     align-cwd!)) 
+			     align-resource!)) 
 		thunk 
 		values))
 
@@ -378,24 +383,26 @@
 ;;; (define (exported-delete-file fname)
 ;;;;  (with-cwd-aligned (really-delete-file fname)))
 
+
+(define resource-reinitializer
+  (make-reinitializer initialize-resource))))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; working directory per thread
+(make-process-resource 
+ initialize-cwd cwd chdir with-cwd* with-cwd-aligned*
+ process-cwd process-chdir)
+
 (initialize-cwd)
 
-(define cwd-reinitializer
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-  (make-reinitializer initialize-cwd))
+;;; umask per thread
 
+(make-process-resource 
+ initialize-umask umask set-umask with-umask* with-umask-aligned*
+ process-umask set-process-umask)
 
-;;; umask 
+(initialize-umask)
-(define (with-umask* mask thunk)
-  (let ((old-mask #f))
-    (dynamic-wind
-      (lambda ()
-	(set! old-mask (umask))
-	(set-umask mask))
-      thunk
-      (lambda ()
-	(set! mask (umask))
-	(set-umask old-mask)))))
-
 ;;; Sugar:
 
 (define-simple-syntax (with-cwd dir . body)
@@ -826,7 +833,9 @@
    (lambda ()
      (with-cwd-aligned*
       (lambda ()
-	(%exec prog (cons prog arglist) env))))))
+	(with-umask-aligned*
+	 (lambda ()
+	   (%exec prog (cons prog arglist) env))))))))
 
 ;(define (exec-path/env prog env . arglist)
 ;  (cond ((exec-path-search (stringify prog) (fluid exec-path-list)) =>
@@ -843,6 +852,8 @@
   (with-env-aligned*
    (lambda ()
      (with-cwd-aligned*
+      (lambda ()
+	(with-umask-aligned*
 	 (lambda ()
 	   (let ((prog (stringify prog)))
 	     (if (string-index prog #\/)
@@ -857,7 +868,7 @@
 				 (%%exec/errno binary argv env)))
 			     (fluid exec-path-list)))))
 	   
-	(error "No executable found." prog arglist))))))
+	   (error "No executable found." prog arglist))))))))
    
 (define (exec-path prog . arglist)
   (apply exec-path/env prog #t arglist))

scsh/syscalls.scm

@@ -194,12 +194,12 @@
 
 ;;; UMASK
 
-(define-foreign set-umask (umask (mode_t mask)) no-declare ; integer on SunOS
+(define-foreign set-process-umask (umask (mode_t mask)) no-declare ; integer on SunOS
   mode_t)
 
-(define (umask)
+(define (process-umask)
-  (let ((m (set-umask 0)))
+  (let ((m (set-process-umask 0)))
-    (set-umask m)
+    (set-process-umask m)
     m))