Update of /cvsroot/scsh/scsh-0.6/scsh
In directory usw-pr-cvs1:/tmp/cvs-serv24815/scsh
Modified Files:
scsh-interfaces.scm scsh-package.scm scsh.scm syslog.scm
utilities.scm
Log Message:
+ Switched cwd to thread-fluids
+ Added with-cwd-aligned* for exec
+ Moved reinitializer from syslog to scsh-utilities
Index: scsh-interfaces.scm
===================================================================
RCS file: /cvsroot/scsh/scsh-0.6/scsh/scsh-interfaces.scm,v
retrieving revision 1.21
retrieving revision 1.22
diff -C2 -r1.21 -r1.22
*** scsh-interfaces.scm 2001/07/07 19:29:29 1.21
--- scsh-interfaces.scm 2001/07/09 18:29:26 1.22
***************
*** 591,595 ****
deprecated-proc
deposit-bit-field
! real->exact-integer))
(define-interface weak-tables-interface
--- 591,596 ----
deprecated-proc
deposit-bit-field
! real->exact-integer
! make-reinitializer))
(define-interface weak-tables-interface
Index: scsh-package.scm
===================================================================
RCS file: /cvsroot/scsh/scsh-0.6/scsh/scsh-package.scm,v
retrieving revision 1.21
retrieving revision 1.22
diff -C2 -r1.21 -r1.22
*** scsh-package.scm 2001/07/07 19:29:29 1.21
--- scsh-package.scm 2001/07/09 18:29:26 1.22
***************
*** 34,38 ****
(define-structure scsh-utilities scsh-utilities-interface
! (open bitwise error-package loopholes let-opt scheme)
(files utilities)
; (optimize auto-integrate)
--- 34,39 ----
(define-structure scsh-utilities scsh-utilities-interface
! (open bitwise error-package loopholes let-opt scheme define-record-types
! records)
(files utilities)
; (optimize auto-integrate)
***************
*** 163,167 ****
scsh-utilities
handle
! fluids
weak-tables
--- 164,168 ----
scsh-utilities
handle
! fluids thread-fluids
weak-tables
***************
*** 464,467 ****
--- 465,469 ----
locks thread-fluids
external-calls
+ scsh-utilities
bitwise)
(files syslog))
Index: scsh.scm
===================================================================
RCS file: /cvsroot/scsh/scsh-0.6/scsh/scsh.scm,v
retrieving revision 1.14
retrieving revision 1.15
diff -C2 -r1.14 -r1.15
*** scsh.scm 2001/06/02 17:45:25 1.14
--- scsh.scm 2001/07/09 18:29:26 1.15
***************
*** 288,305 ****
;;; this reflects the cwd of the process
! (define-record cache
! cwd)
! (define-record-resumer type/cache
! (lambda (cache)
! (set-cache:cwd cache (process-cwd)))) ; set the cache to an impossible
filename.
- (define *unix-cwd*
- (make-cache (process-cwd))) ; Initialise the cache to an impossible
filename.
-
(define (unix-cwd)
! (cache:cwd *unix-cwd*))
- (define cwd-lock (make-lock))
;;; Actually do the syscall and update the cache
--- 288,301 ----
;;; 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
***************
*** 307,311 ****
(define (chdir-and-cache dir)
(process-chdir dir)
! (set-cache:cwd *unix-cwd* (process-cwd)))
;;; Dynamic-wind is not the right thing to take care of the lock;
--- 303,307 ----
(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;
***************
*** 326,342 ****
;;; The thread-specific CWD: A fluid
- (define-record state
- cwd)
-
- (define-record-resumer type/state
- (lambda (state)
- (set-state:cwd state (make-fluid (process-cwd)))))
! (define $cwd (make-state (make-fluid (process-cwd))))
! (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))
(define (with-cwd* dir thunk)
--- 322,334 ----
;;; The thread-specific CWD: A fluid
! (define $cwd
! (make-thread-fluid
! (process-cwd)))
! (define (cwd) (thread-fluid $cwd))
! (define (set-cwd! dir) (set-thread-fluid! $cwd dir))
(define (let-cwd dir thunk)
! (let-thread-fluid $cwd dir thunk))
(define (with-cwd* dir thunk)
***************
*** 344,348 ****
(with-lock cwd-lock
(lambda ()
- (align-cwd!)
(chdir-and-cache dir)
(set! changed-dir (unix-cwd))))
--- 336,339 ----
***************
*** 351,355 ****
;; Align the Unix CWD with the scsh CWD.
;; Since another thread could disalign, this call and
! ;; any ensuing syscall that relies upon it should
;; be "glued together" with the cwd lock.
--- 342,346 ----
;; Align the Unix CWD with the scsh CWD.
;; Since another thread could disalign, this call and
! ;; any ensuring syscall that relies upon it should
;; be "glued together" with the cwd lock.
***************
*** 363,367 ****
(with-lock cwd-lock
(lambda ()
- (align-cwd!)
(chdir-and-cache dir)
(set-cwd! (unix-cwd)))))
--- 354,357 ----
***************
*** 389,392 ****
--- 379,388 ----
;;;; (with-cwd-aligned (really-delete-file fname)))
+ (initialize-cwd)
+
+ (define cwd-reinitializer
+ (make-reinitializer initialize-cwd))
+
+
;;; umask
(define (with-umask* mask thunk)
***************
*** 829,833 ****
(with-env-aligned*
(lambda ()
! (%exec prog (cons prog arglist) env))))
;(define (exec-path/env prog env . arglist)
--- 825,831 ----
(with-env-aligned*
(lambda ()
! (with-cwd-aligned*
! (lambda ()
! (%exec prog (cons prog arglist) env))))))
;(define (exec-path/env prog env . arglist)
***************
*** 845,862 ****
(with-env-aligned*
(lambda ()
! (let ((prog (stringify prog)))
! (if (string-index prog #\/)
!
! ;; Contains a slash -- no path search.
! (%exec prog (cons prog arglist) env)
!
! ;; Try each directory in PATH-LIST.
! (let ((argv (list->vector (cons prog (map stringify arglist)))))
! (for-each (lambda (dir)
! (let ((binary (string-append dir "/" prog)))
! (%%exec/errno binary argv env)))
! (fluid exec-path-list)))))
!
! (error "No executable found." prog arglist))))
(define (exec-path prog . arglist)
--- 843,862 ----
(with-env-aligned*
(lambda ()
! (with-cwd-aligned*
! (lambda ()
! (let ((prog (stringify prog)))
! (if (string-index prog #\/)
!
! ;; Contains a slash -- no path search.
! (%exec prog (cons prog arglist) env)
!
! ;; Try each directory in PATH-LIST.
! (let ((argv (list->vector (cons prog (map stringify arglist)))))
! (for-each (lambda (dir)
! (let ((binary (string-append dir "/" prog)))
! (%%exec/errno binary argv env)))
! (fluid exec-path-list)))))
!
! (error "No executable found." prog arglist))))))
(define (exec-path prog . arglist)
Index: syslog.scm
===================================================================
RCS file: /cvsroot/scsh/scsh-0.6/scsh/syslog.scm,v
retrieving revision 1.6
retrieving revision 1.7
diff -C2 -r1.6 -r1.7
*** syslog.scm 2001/06/27 15:29:37 1.6
--- syslog.scm 2001/07/09 18:29:26 1.7
***************
*** 261,281 ****
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)
--- 261,264 ----
Index: utilities.scm
===================================================================
RCS file: /cvsroot/scsh/scsh-0.6/scsh/utilities.scm,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -r1.3 -r1.4
*** utilities.scm 1999/09/23 23:02:52 1.3
--- utilities.scm 2001/07/09 18:29:26 1.4
***************
*** 252,253 ****
--- 252,269 ----
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))))
|