place: fix place-kill for Racket thread simulation

Where true places are not supported, `place` is simulated
using Racket threads, and `place-kill` did not kill off the
simulated place well enough.

Relevant to #2930
This commit is contained in:
Matthew Flatt 2019-11-27 06:20:31 -07:00
parent 82f4067b9a
commit ad7511dd29

View File

@ -53,27 +53,29 @@
(define result-box (box 0))
(define plumber (make-plumber))
(define done? #f)
(define th (thread
(lambda ()
(with-continuation-mark
parameterization-key
(get-original-parameterization)
(parameterize ([current-namespace (make-base-namespace)]
[current-custodian cust]
[exit-handler (lambda (v)
(plumber-flush-all plumber)
(set-box! result-box (if (byte? v) v 0))
(custodian-shutdown-all cust))]
[current-plumber plumber])
(dynamic-wind
void
(lambda ()
((dynamic-require mod funcname) cch)
(plumber-flush-all plumber)
(set! done? #t))
(lambda ()
(unless done?
(set-box! result-box 1)))))))))
(define th
(parameterize ([current-custodian cust])
(thread
(lambda ()
(with-continuation-mark
parameterization-key
(get-original-parameterization)
(parameterize ([current-namespace (make-base-namespace)]
[current-custodian cust]
[exit-handler (lambda (v)
(plumber-flush-all plumber)
(set-box! result-box (if (byte? v) v 0))
(custodian-shutdown-all cust))]
[current-plumber plumber])
(dynamic-wind
void
(lambda ()
((dynamic-require mod funcname) cch)
(plumber-flush-all plumber)
(set! done? #t))
(lambda ()
(unless done?
(set-box! result-box 1))))))))))
(parameterize ([current-custodian cust])
;; When main thread ends, all threads, etc., should end:
(thread (lambda () (thread-wait th) (custodian-shutdown-all cust))))