summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2016-10-31 22:13:30 +0100
committerAndy Wingo <wingo@pobox.com>2016-10-31 22:13:30 +0100
commit94a3433b9d1da4acf2737aa1db8ce129b90623d9 (patch)
tree00aa118e25145eed01caa6ec5617e0f31018ef81
parentb85f033526c77c89c38a0cdcc156b18a9784bb09 (diff)
REPL server avoids thread cleanup handlers
* module/system/repl/server.scm (serve-client): Avoid thread cleanup handlers.
-rw-r--r--module/system/repl/server.scm23
1 files changed, 12 insertions, 11 deletions
diff --git a/module/system/repl/server.scm b/module/system/repl/server.scm
index b1b8a6b8c..f6981edf0 100644
--- a/module/system/repl/server.scm
+++ b/module/system/repl/server.scm
@@ -133,16 +133,17 @@
(define (serve-client client addr)
(let ((thread (current-thread)))
- ;; Close the socket when this thread exits, even if canceled.
- (set-thread-cleanup! thread (lambda () (close-socket! client)))
- ;; Arrange to cancel this thread to forcefully shut down the socket.
+ ;; To shut down this thread and socket, cause it to unwind.
(add-open-socket! client (lambda () (cancel-thread thread))))
- (with-continuation-barrier
- (lambda ()
- (parameterize ((current-input-port client)
- (current-output-port client)
- (current-error-port client)
- (current-warning-port client))
- (with-fluids ((*repl-stack* '()))
- (start-repl))))))
+ (dynamic-wind
+ (lambda () #f)
+ (with-continuation-barrier
+ (lambda ()
+ (parameterize ((current-input-port client)
+ (current-output-port client)
+ (current-error-port client)
+ (current-warning-port client))
+ (with-fluids ((*repl-stack* '()))
+ (start-repl)))))
+ (lambda () (close-socket! client))))