scsh-conservatory
/
scsh-0.6
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Use make-preserved-thread-fluid for the process resources. 

Fixed indentation.
This commit is contained in:
mainzelm 2001-12-05 08:34:37 +00:00
parent 8bba3a13e1
commit 3620d702f0
1 changed files with 86 additions and 85 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

171
scsh/scsh.scm
View File

@ -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