+ Switched cwd to thread-fluids

+ Added with-cwd-aligned* for exec
+ Moved reinitializer from syslog to scsh-utilities

scsh/scsh-interfaces.scm

@@ -590,7 +590,8 @@
 	  check-arg conjoin disjoin negate compose reverse! call/cc
 	  deprecated-proc
 	  deposit-bit-field
-	  real->exact-integer))
+	  real->exact-integer
+	  make-reinitializer))
 
 (define-interface weak-tables-interface
   (export make-weak-table weak-table-set! weak-table-ref weak-table-walk

scsh/scsh-package.scm

@@ -33,7 +33,8 @@
 
 
 (define-structure scsh-utilities scsh-utilities-interface
-  (open bitwise error-package loopholes let-opt scheme)
+  (open bitwise error-package loopholes let-opt scheme define-record-types 
+	records)
   (files utilities)
 ;  (optimize auto-integrate)
   )
@@ -162,7 +163,7 @@
 	conditions
 	scsh-utilities
 	handle
-	fluids
+	fluids thread-fluids
 	weak-tables
 
 	scsh-char-set-low-level-lib         ; rdelim.scm needs it.
@@ -463,5 +464,6 @@
   (open scheme define-record-types finite-types
 	locks thread-fluids
 	external-calls
+	scsh-utilities
 	bitwise)
   (files syslog))

scsh/scsh.scm

@@ -287,26 +287,22 @@
 ;;; working directory per thread
 
 ;;; this reflects the cwd of the process
-(define-record cache
+(define *unix-cwd* 'uninitialized)
-  cwd)
+(define cwd-lock 'uninitialized)
 
-(define-record-resumer type/cache
+(define (initialize-cwd)
-  (lambda (cache)
+  (set! *unix-cwd* (process-cwd))
-    (set-cache:cwd cache  (process-cwd))))  ; set the cache to an impossible filename.  
+  (set! cwd-lock (make-lock)))
-
-(define *unix-cwd* 
-  (make-cache  (process-cwd))) ; Initialise the cache to an impossible filename.
 
 (define (unix-cwd)
-  (cache:cwd *unix-cwd*))
+  *unix-cwd*)
 
-(define cwd-lock (make-lock))
 
 ;;; Actually do the syscall and update the cache
 ;;; assumes the cwd lock obtained
 (define (chdir-and-cache dir)
   (process-chdir dir)
-  (set-cache:cwd *unix-cwd* (process-cwd)))
+  (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.
@@ -325,32 +321,27 @@
 		    result))))
 
 ;;; The thread-specific CWD: A fluid
-(define-record state
-  cwd)
 
-(define-record-resumer type/state
+(define $cwd
-  (lambda (state)
+  (make-thread-fluid
-    (set-state:cwd state (make-fluid (process-cwd)))))
+   (process-cwd)))
 
-(define $cwd (make-state (make-fluid (process-cwd))))
+(define (cwd) (thread-fluid $cwd))
-
+(define (set-cwd! dir) (set-thread-fluid! $cwd dir))
-(define (cwd) (fluid (state:cwd $cwd)))
-(define (set-cwd! dir) (set-fluid! (state:cwd $cwd) dir))
 (define (let-cwd dir thunk)
-  (let-fluid (state:cwd $cwd) dir thunk))
+  (let-thread-fluid $cwd dir thunk))
 
 (define (with-cwd* dir thunk) 
   (let ((changed-dir #f))
     (with-lock cwd-lock
 	       (lambda ()
-		 (align-cwd!)
 		 (chdir-and-cache dir)
 		 (set! changed-dir (unix-cwd))))
     (let-cwd changed-dir thunk)))
 
 ;; Align the Unix CWD with the scsh CWD.
 ;; Since another thread could disalign, this call and
-;; any ensuing syscall that relies upon it should
+;; any ensuring syscall that relies upon it should
 ;; be "glued together" with the cwd lock.
 
 (define (align-cwd!)
@@ -362,7 +353,6 @@
 (define (chdir dir)
   (with-lock cwd-lock
 	     (lambda ()
-	       (align-cwd!)
 	       (chdir-and-cache dir)
 	       (set-cwd! (unix-cwd)))))
 
@@ -388,6 +378,12 @@
 ;;; (define (exported-delete-file fname)
 ;;;;  (with-cwd-aligned (really-delete-file fname)))
 
+(initialize-cwd)
+
+(define cwd-reinitializer
+  (make-reinitializer initialize-cwd))
+
+
 ;;; umask 
 (define (with-umask* mask thunk)
   (let ((old-mask #f))
@@ -828,7 +824,9 @@
   (flush-all-ports)
   (with-env-aligned* 
    (lambda ()
-     (%exec prog (cons prog arglist) env))))
+     (with-cwd-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)) =>
@@ -844,20 +842,22 @@
   (flush-all-ports)
   (with-env-aligned*
    (lambda ()
-     (let ((prog (stringify prog)))
+     (with-cwd-aligned*
-       (if (string-index prog #\/)
+      (lambda ()
-	   
+	(let ((prog (stringify prog)))
-	   ;; Contains a slash -- no path search.
+	  (if (string-index prog #\/)
-	   (%exec prog (cons prog arglist) env)
+	      
-	   
+	      ;; Contains a slash -- no path search.
-	;; Try each directory in PATH-LIST.
+	      (%exec prog (cons prog arglist) env)
-	   (let ((argv (list->vector (cons prog (map stringify arglist)))))
+	      
-	     (for-each (lambda (dir)
+	      ;; Try each directory in PATH-LIST.
-			 (let ((binary (string-append dir "/" prog)))
+	      (let ((argv (list->vector (cons prog (map stringify arglist)))))
-			   (%%exec/errno binary argv env)))
+		(for-each (lambda (dir)
-		       (fluid exec-path-list)))))
+			    (let ((binary (string-append dir "/" prog)))
-     
+			      (%%exec/errno binary argv env)))
-     (error "No executable found." prog arglist))))
+			  (fluid exec-path-list)))))
+	
+	(error "No executable found." prog arglist))))))
    
 (define (exec-path prog . arglist)
   (apply exec-path/env prog #t arglist))

scsh/syslog.scm

@@ -260,23 +260,6 @@
 		    (make-syslog-channel ident options facility mask)
 		    thunk))
 
-;----------------
-; A record type whose only purpose is to run some code when we start up an
-; image.
-
-(define-record-type reinitializer :reinitializer
-  (make-reinitializer thunk)
-  reinitializer?
-  (thunk reinitializer-thunk))
-
-(define-record-discloser :reinitializer
-  (lambda (r)
-    (list 'reinitializer (reinitializer-thunk r))))
-
-(define-record-resumer :reinitializer
-  (lambda (r)
-    ((reinitializer-thunk r))))
-
 (initialize-syslog)
 
 (define syslog-reinitializer

scsh/utilities.scm

@@ -251,3 +251,19 @@
       (if (= i len)
 	  v
 	  (lp (f v (string-ref s i)) (+ i 1))))))
+;----------------
+; A record type whose only purpose is to run some code when we start up an
+; image.
+
+(define-record-type reinitializer :reinitializer
+  (make-reinitializer thunk)
+  reinitializer?
+  (thunk reinitializer-thunk))
+
+(define-record-discloser :reinitializer
+  (lambda (r)
+    (list 'reinitializer (reinitializer-thunk r))))
+
+(define-record-resumer :reinitializer
+  (lambda (r)
+    ((reinitializer-thunk r))))