Use make-preserved-thread-fluid for the process resources.
Fixed indentation.
This commit is contained in:
parent
8bba3a13e1
commit
3620d702f0
|
@ -142,47 +142,48 @@
|
|||
;;; (thread-set-resource ('X -> unspec))
|
||||
|
||||
(define-syntax make-process-resource
|
||||
(syntax-rules ()
|
||||
(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)
|
||||
(begin
|
||||
(define *resource-cache* 'uninitialized)
|
||||
(define resource-lock 'uninitialized)
|
||||
|
||||
(define (initialize-resource)
|
||||
(define (initialize-resource)
|
||||
(set! *resource-cache* (process-read-resource))
|
||||
(set! $resource ;;; TODO The old thread-fluid will remain
|
||||
(make-thread-fluid
|
||||
(make-preserved-thread-fluid
|
||||
(process-read-resource)))
|
||||
(set! resource-lock (make-lock)))
|
||||
|
||||
(define (cache-value)
|
||||
(define (cache-value)
|
||||
*resource-cache*)
|
||||
|
||||
;;; Actually do the syscall and update the cache
|
||||
;;; assumes the resource lock obtained
|
||||
(define (change-and-cache dir)
|
||||
;; 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
|
||||
;; 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
|
||||
;; The thread-specific resource: A thread fluid
|
||||
|
||||
(define $resource 'empty-resource-value)
|
||||
(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)
|
||||
(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)
|
||||
(define (with-resource* dir thunk)
|
||||
(let ((changed-dir #f)) ; TODO 0.5 used to have a dynamic-wind here!!!
|
||||
(with-lock resource-lock
|
||||
(lambda ()
|
||||
|
@ -190,48 +191,48 @@
|
|||
(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.
|
||||
;; 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!)
|
||||
(define (align-resource!)
|
||||
(let ((dir (thread-read-resource)))
|
||||
(if (not (resource-eq? dir (cache-value)))
|
||||
(change-and-cache dir))))
|
||||
|
||||
(define (thread-change-resource 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.
|
||||
;; 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)
|
||||
(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
|
||||
(define resource-reinitializer
|
||||
(make-reinitializer (lambda () (warn "calling resumer") (initialize-resource))))))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
|
Loading…
Reference in New Issue