suzanne.soy/compatibility
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

.

Browse Source 
original commit: 3cd19fde7e140d5c3870ea34d97635fe8768732e
This commit is contained in:
Matthew Flatt 2005-04-15 16:09:00 +00:00
parent 25643f3746
commit b2399cae60
1 changed files with 42 additions and 44 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

86
collects/mzlib/thread.ss
View File

@ -74,50 +74,48 @@
(dynamic-wind
void
(lambda ()
;; Introduce parameter dynamic binding that we can mutate:
(parameterize ([current-custodian (current-custodian)])
;; All connections should use the same parameterization,
;; to facilitate transferring continuations from one
;; connection to another:
(let ([paramz (current-parameterization)])
;; Loop to handle connections:
(let loop ()
(with-handlers ([exn:fail:network? handle-exn])
;; Make a custodian for the next session:
(let ([c (make-custodian)])
(parameterize ([current-custodian c])
;; disable breaks during session set-up...
(parameterize-break #f
;; ... but enable breaks while blocked on an accept:
(let-values ([(r w) ((if can-break?
tcp-accept/enable-break
tcp-accept)
l)])
;; Handler thread:
(let ([t (thread (lambda ()
;; First, install the parameterization
;; used for all connections:
(call-with-parameterization
paramz
(lambda ()
;; Install this connection's custodian
;; for this thread in the shared
;; parameterization:
(current-custodian c)
;; Enable breaking:
(when can-break?
(break-enabled #t))
;; Call the handler
(handler r w)))))])
;; Clean-up and timeout thread:
(thread (lambda ()
(sync/timeout connection-timeout t)
(when (thread-running? t)
;; Only happens if connection-timeout is not #f
(break-thread t))
(sync/timeout connection-timeout t)
(custodian-shutdown-all c)))))))))
(loop)))))
;; All connections should use the same parameterization,
;; to facilitate transferring continuations from one
;; connection to another:
(let ([paramz (current-parameterization)])
;; Loop to handle connections:
(let loop ()
(with-handlers ([exn:fail:network? handle-exn])
;; Make a custodian for the next session:
(let ([c (make-custodian)])
(parameterize ([current-custodian c])
;; disable breaks during session set-up...
(parameterize-break #f
;; ... but enable breaks while blocked on an accept:
(let-values ([(r w) ((if can-break?
tcp-accept/enable-break
tcp-accept)
l)])
;; Handler thread:
(let ([t (thread (lambda ()
;; First, install the parameterization
;; used for all connections:
(call-with-parameterization
paramz
(lambda ()
;; Install this connection's custodian
;; for this thread in the shared
;; parameterization:
(current-custodian c)
;; Enable breaking:
(when can-break?
(break-enabled #t))
;; Call the handler
(handler r w)))))])
;; Clean-up and timeout thread:
(thread (lambda ()
(sync/timeout connection-timeout t)
(when (thread-running? t)
;; Only happens if connection-timeout is not #f
(break-thread t))
(sync/timeout connection-timeout t)
(custodian-shutdown-all c)))))))))
(loop))))
(lambda () (tcp-close l))))))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;