From b2e4d51b1b3cca3b4bc5f9fc60f01715da89975e Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Wed, 12 Sep 2018 06:15:09 -0600 Subject: [PATCH] raco setup: fix problem with processes-based build The procsses-based build was technically broken with the addition of a "prefetch" thread (some time back) to improve parallelism, because the `write`-based implementation of messages did not protect again interleaving by different threads. The problem turns out to be easier to expose when running with RacketCS. --- racket/collects/setup/parallel-do.rkt | 12 ++++++++++-- 1 file changed, 10 insertions(+), 2 deletions(-) diff --git a/racket/collects/setup/parallel-do.rkt b/racket/collects/setup/parallel-do.rkt index 5df332d1d4..ea7acde276 100644 --- a/racket/collects/setup/parallel-do.rkt +++ b/racket/collects/setup/parallel-do.rkt @@ -398,11 +398,19 @@ (define orig-err (current-error-port)) (define orig-out (current-output-port)) (define orig-in (current-input-port)) + (define send-lock (make-semaphore 1)) (define (raw-send msg) (cond [ch (place-channel-put ch msg)] - [else (write (convert-paths msg) orig-out) - (flush-output orig-out)])) + [else + (define c-msg (convert-paths msg)) + ;; Multiple threads might try to write (e.g., for prefetching), + ;; so make sure the writes are not interleaved + (call-with-semaphore + send-lock + (lambda () + (write c-msg orig-out))) + (flush-output orig-out)])) (define (raw-recv) (cond [ch (place-channel-get ch)]