diff --git a/scsh/scsh.scm b/scsh/scsh.scm index 48b7488..ee1f30a 100644 --- a/scsh/scsh.scm +++ b/scsh/scsh.scm @@ -142,97 +142,98 @@ ;;; (thread-set-resource ('X -> unspec)) (define-syntax make-process-resource - (syntax-rules () - ((make-process-resource - initialize-resource - thread-read-resource thread-set-resource! thread-change-resource - with-resource* with-resource-aligned* - process-read-resource process-set-resource resource-eq?) -(begin -(define *resource-cache* 'uninitialized) -(define resource-lock 'uninitialized) + (syntax-rules + () + ((make-process-resource + initialize-resource + thread-read-resource thread-set-resource! thread-change-resource + with-resource* with-resource-aligned* + process-read-resource process-set-resource resource-eq?) + (begin + (define *resource-cache* 'uninitialized) + (define resource-lock 'uninitialized) + + (define (initialize-resource) + (set! *resource-cache* (process-read-resource)) + (set! $resource ;;; TODO The old thread-fluid will remain + (make-preserved-thread-fluid + (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 'empty-resource-value) + + (define (thread-read-resource) (thread-fluid $resource)) + (define (thread-set-resource! dir) (set-thread-fluid! $resource dir)) + (define (let-resource dir thunk) + (let-thread-fluid $resource dir thunk)) + + (define (with-resource* dir thunk) + (let ((changed-dir #f)) ; TODO 0.5 used to have a dynamic-wind here!!! + (with-lock resource-lock + (lambda () + (change-and-cache dir) + (set! changed-dir (cache-value)))) + (let-resource changed-dir thunk))) + + ;; 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 resource lock. + + (define (align-resource!) + (let ((dir (thread-read-resource))) + (if (not (resource-eq? dir (cache-value))) + (change-and-cache dir)))) -(define (initialize-resource) - (set! *resource-cache* (process-read-resource)) - (set! $resource ;;; TODO The old thread-fluid will remain - (make-thread-fluid - (process-read-resource))) - (set! resource-lock (make-lock))) + (define (thread-change-resource dir) + (with-lock resource-lock + (lambda () + (align-resource!) + (change-and-cache dir) + (thread-set-resource! (cache-value))))) -(define (cache-value) - *resource-cache*) + ;; 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. We could probably dump the DYNAMIC-WINDs and build the + ;; rest of the pattern into one of the syscall-defining macros, or + ;; something. + ;; Olin adds the following: the efficient way to do things is not + ;; with a dynamic wind or a lock. Just turn off interrupts, sync the + ;; resource, do the syscall, turn them back on. -;;; 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))) + (define (with-resource-aligned* thunk) + (dynamic-wind (lambda () + (with-lock resource-lock + align-resource!)) + thunk + values)) -;;; 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 'empty-resource-value) - -(define (thread-read-resource) (thread-fluid $resource)) -(define (thread-set-resource! dir) (set-thread-fluid! $resource dir)) -(define (let-resource dir thunk) - (let-thread-fluid $resource dir thunk)) - -(define (with-resource* dir thunk) - (let ((changed-dir #f)) ; TODO 0.5 used to have a dynamic-wind here!!! - (with-lock resource-lock - (lambda () - (change-and-cache dir) - (set! changed-dir (cache-value)))) - (let-resource changed-dir thunk))) - -;; 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 resource lock. - -(define (align-resource!) - (let ((dir (thread-read-resource))) - (if (not (resource-eq? dir (cache-value))) - (change-and-cache dir)))) - -(define (thread-change-resource dir) - (with-lock resource-lock - (lambda () - (align-resource!) - (change-and-cache dir) - (thread-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. We could probably dump the DYNAMIC-WINDs and build the -;;; rest of the pattern into one of the syscall-defining macros, or -;;; something. -;;; Olin adds the following: the efficient way to do things is not -;;; with a dynamic wind or a lock. Just turn off interrupts, sync the -;;; resource, do the syscall, turn them back on. - -(define (with-resource-aligned* thunk) - (dynamic-wind (lambda () - (with-lock resource-lock - align-resource!)) - thunk - values)) - -;;; example syscall -;;; (define (exported-delete-file fname) -;;;; (with-cwd-aligned (really-delete-file fname))) + ;; example syscall + ;; (define (exported-delete-file fname) + ;; (with-cwd-aligned (really-delete-file fname))) -(define resource-reinitializer - (make-reinitializer (lambda () (warn "calling resumer") (initialize-resource)))))))) + (define resource-reinitializer + (make-reinitializer (lambda () (warn "calling resumer") (initialize-resource)))))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; working directory per thread