Use make-preserved-thread-fluid for the process resources.
Fixed indentation.
This commit is contained in:
mainzelm
parent
8bba3a13e1
commit
3620d702f0
171
scsh/scsh.scm
171
scsh/scsh.scm
|
|
@ -142,97 +142,98 @@
|
||||||
;;; (thread-set-resource ('X -> unspec))
|
;;; (thread-set-resource ('X -> unspec))
|
||||||
|
|
||||||
(define-syntax make-process-resource
|
(define-syntax make-process-resource
|
||||||
(syntax-rules ()
|
(syntax-rules
|
||||||
((make-process-resource
|
()
|
||||||
initialize-resource
|
((make-process-resource
|
||||||
thread-read-resource thread-set-resource! thread-change-resource
|
initialize-resource
|
||||||
with-resource* with-resource-aligned*
|
thread-read-resource thread-set-resource! thread-change-resource
|
||||||
process-read-resource process-set-resource resource-eq?)
|
with-resource* with-resource-aligned*
|
||||||
(begin
|
process-read-resource process-set-resource resource-eq?)
|
||||||
(define *resource-cache* 'uninitialized)
|
(begin
|
||||||
(define resource-lock 'uninitialized)
|
(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)
|
(define (thread-change-resource dir)
|
||||||
(set! *resource-cache* (process-read-resource))
|
(with-lock resource-lock
|
||||||
(set! $resource ;;; TODO The old thread-fluid will remain
|
(lambda ()
|
||||||
(make-thread-fluid
|
(align-resource!)
|
||||||
(process-read-resource)))
|
(change-and-cache dir)
|
||||||
(set! resource-lock (make-lock)))
|
(thread-set-resource! (cache-value)))))
|
||||||
|
|
||||||
(define (cache-value)
|
;; For thunks that don't raise exceptions or throw to continuations,
|
||||||
*resource-cache*)
|
;; 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
|
(define (with-resource-aligned* thunk)
|
||||||
;;; assumes the resource lock obtained
|
(dynamic-wind (lambda ()
|
||||||
(define (change-and-cache dir)
|
(with-lock resource-lock
|
||||||
(process-set-resource dir)
|
align-resource!))
|
||||||
(set! *resource-cache* (process-read-resource)))
|
thunk
|
||||||
|
values))
|
||||||
|
|
||||||
;;; Dynamic-wind is not the right thing to take care of the lock;
|
;; example syscall
|
||||||
;;; it would release the lock on every context switch.
|
;; (define (exported-delete-file fname)
|
||||||
;;; With-lock releases the lock on a condition, using call/cc will
|
;; (with-cwd-aligned (really-delete-file fname)))
|
||||||
;;; 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)))
|
|
||||||
|
|
||||||
|
|
||||||
(define resource-reinitializer
|
(define resource-reinitializer
|
||||||
(make-reinitializer (lambda () (warn "calling resumer") (initialize-resource))))))))
|
(make-reinitializer (lambda () (warn "calling resumer") (initialize-resource))))))))
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
;;; working directory per thread
|
;;; working directory per thread
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue