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

.

Browse Source 
original commit: 4682e54f83e879ee536d410ce1a147083d15d233
This commit is contained in:
Matthew Flatt 2001-12-28 16:19:56 +00:00
parent 3ada00788f
commit ffa48b2215
2 changed files with 32 additions and 32 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
collects/mzlib/file.ss
View File

@ -327,7 +327,7 @@
(format "the size of the name list (~a) does not match the size of the value list (~a): " (format "the size of the name list (~a) does not match the size of the value list (~a): "
(length names) (length vals)) (length names) (length vals))
vals)) vals))
(let ([lock-file (build-path (find-system-path 'pref-dir) "PREFLOCK")]) (let ([lock-file (build-path (find-system-path 'pref-dir) ".plt-PREFLOCK")])
(with-handlers ([(lambda (x) (with-handlers ([(lambda (x)
(and (exn:i/o:filesystem? x) (and (exn:i/o:filesystem? x)
(eq? (exn:i/o:filesystem-detail x) 'already-exists))) (eq? (exn:i/o:filesystem-detail x) 'already-exists)))

60
collects/mzlib/thread.ss
View File

@ -140,33 +140,33 @@
(let ([l (tcp-listen port-number)] (let ([l (tcp-listen port-number)]
[can-break? (break-enabled)]) [can-break? (break-enabled)])
(dynamic-wind (dynamic-wind
void void
(lambda () (lambda ()
;; loop to handle connections ;; loop to handle connections
(let loop () (let loop ()
(with-handlers ([not-break-exn? void]) (with-handlers ([not-break-exn? void])
;; Make a custodian for the next session: ;; Make a custodian for the next session:
(let ([c (make-custodian)]) (let ([c (make-custodian)])
(parameterize ([current-custodian c]) (parameterize ([current-custodian c])
;; disable breaks during session set-up... ;; disable breaks during session set-up...
(parameterize ([break-enabled #f]) (parameterize ([break-enabled #f])
;; ... but enabled breaks while blocked on an accept: ;; ... but enable breaks while blocked on an accept:
(let-values ([(r w) ((if can-break? (let-values ([(r w) ((if can-break?
tcp-accept/enable-break tcp-accept/enable-break
tcp-accept) tcp-accept)
l)]) l)])
;; Handler thread: ;; Handler thread:
(let ([t (thread (lambda () (let ([t (thread (lambda ()
(when can-break? (when can-break?
(break-enabled #t)) (break-enabled #t))
(handler r w)))]) (handler r w)))])
;; Clean-up and timeout thread: ;; Clean-up and timeout thread:
(thread (lambda () (thread (lambda ()
(object-wait-multiple connection-timeout t) (object-wait-multiple connection-timeout t)
(when (thread-running? t) (when (thread-running? t)
;; Only happens if connection-timeout is not #f ;; Only happens if connection-timeout is not #f
(break-thread t)) (break-thread t))
(object-wait-multiple connection-timeout t) (object-wait-multiple connection-timeout t)
(custodian-shutdown-all c))))))))) (custodian-shutdown-all c)))))))))
(loop))) (loop)))
(lambda () (tcp-close l)))))) (lambda () (tcp-close l))))))