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

Fixing PR12443

Browse Source 
There is a big comment in thread.rkt that explains the problem and the
"fix". I think something better could and should be done, but I don't
know what it is.

original commit: 022ce2d8d7de60d63d21eb67119466283d9e8be3
This commit is contained in:
Jay McCarthy 2012-01-03 14:11:00 -07:00
parent 2410b71326
commit fbea030c27
1 changed files with 66 additions and 45 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

111
collects/mzlib/thread.rkt
View File

@ -59,51 +59,72 @@
(let ([l (tcp-listen port-number 5 #t)] (let ([l (tcp-listen port-number 5 #t)]
[can-break? (break-enabled)]) [can-break? (break-enabled)])
(dynamic-wind (dynamic-wind
void void
(lambda () (lambda ()
;; All connections should use the same parameterization, ;; All connections should use the same parameterization,
;; to facilitate transferring continuations from one ;; to facilitate transferring continuations from one
;; connection to another: ;; connection to another:
(let ([paramz (current-parameterization)]) (let ([paramz (current-parameterization)])
;; Loop to handle connections: ;; Loop to handle connections:
(let loop () (let loop ()
(with-handlers ([exn:fail:network? handle-exn]) ;; Introducing this thread causes PR12443 to no longer fail.
;; Make a custodian for the next session:
(let ([c (make-custodian)]) ;; The Web Server will definitely kill the custodian
(parameterize ([current-custodian c]) ;; associated with the resources of the connection. I
;; disable breaks during session set-up... ;; think what is going on is that the loop here is
(parameterize-break #f ;; attached to one of these custodians (eventually)
;; ... but enable breaks while blocked on an accept: ;; and then the listening loop thread gets killed
(let-values ([(r w) ((if can-break? ;; too. This patch basically just disconnects the loop
tcp-accept/enable-break ;; from the new custodian. The error reported in the
tcp-accept) ;; PR still shows up, but it has no effect on the
l)]) ;; response time/etc, whereas before it would stop
;; Handler thread: ;; listening and 'ab' would fail.
(let ([t (thread (lambda () (thread-wait
;; First, install the parameterization (thread
;; used for all connections: (λ ()
(call-with-parameterization (with-handlers
paramz ([exn:fail:network? handle-exn])
(lambda () ;; Make a custodian for the next session:
;; Install this connection's custodian (let ([c (make-custodian)])
;; for this thread in the shared (parameterize
;; parameterization: ([current-custodian c])
(current-custodian c) ;; disable breaks during session set-up...
;; Enable breaking: (parameterize-break
(when can-break? #f
(break-enabled #t)) ;; ... but enable breaks while blocked on an accept:
;; Call the handler (let-values ([(r w) ((if can-break?
(handler r w)))))]) tcp-accept/enable-break
;; Clean-up and timeout thread: tcp-accept)
(thread (lambda () l)])
(sync/timeout connection-timeout t) ;; Handler thread:
(when (thread-running? t) (let ([t
;; Only happens if connection-timeout is not #f (thread
(break-thread t)) (lambda ()
(sync/timeout connection-timeout t) ;; First, install the parameterization
(custodian-shutdown-all c))))))))) ;; used for all connections:
(loop)))) (call-with-parameterization
(lambda () (tcp-close l))))) 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)))))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Couroutine ;; Couroutine