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

fix `raco setup -j' for a non-places build

Browse Source 
When places are not enabled, then `raco setup' uses multiple
Racket processes that commuincate via pipes. Don't try to send
a place channel over a pipe.

Merge to v5.3.4
This commit is contained in:
Matthew Flatt 2013-04-09 12:16:13 -06:00
parent 8d7c231cd8
commit 2295d16074
1 changed files with 27 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

48
collects/setup/scribble.rkt
View File

@ -69,33 +69,39 @@
(setup-printf "error running" (module-path-prefix->string (doc-src-spec doc))) (setup-printf "error running" (module-path-prefix->string (doc-src-spec doc)))
(eprintf errstr)) (eprintf errstr))
;; We use a lock to control writing to the database, because ;; We use a lock to control writing to the database. It's not
;; the database or binding doesn't seem to deal well with concurrent ;; strictly necessary, but place channels can deal with blocking
;; writers within a process. ;; more efficiently than the database connection.
(define no-lock void) (define no-lock void)
(define (lock-via-channel lock-ch) (define (lock-via-channel lock-ch)
(let ([saved-ch #f]) (if lock-ch
(lambda (mode) (let ([saved-ch #f])
(case mode (lambda (mode)
[(lock) (case mode
(define ch (sync lock-ch)) [(lock)
(place-channel-put ch 'lock) (define ch (sync lock-ch))
(set! saved-ch ch)] (place-channel-put ch 'lock)
[(unlock) (set! saved-ch ch)]
(place-channel-put saved-ch 'done) [(unlock)
(set! saved-ch #f)])))) (place-channel-put saved-ch 'done)
(set! saved-ch #f)])))
void))
(define lock-ch #f) (define lock-ch #f)
(define lock-ch-in #f) (define lock-ch-in #f)
(define (init-lock-ch!) (define (init-lock-ch!)
(unless lock-ch (unless lock-ch
(set!-values (lock-ch lock-ch-in) (place-channel)) ;; If places are not available, then tasks will be run
(thread (lambda () ;; in separate OS processes, and we can do without an
(define-values (ch ch-in) (place-channel)) ;; extra lock.
(let loop () (when (place-enabled?)
(place-channel-put lock-ch-in ch) (set!-values (lock-ch lock-ch-in) (place-channel))
(place-channel-get ch-in) (thread (lambda ()
(place-channel-get ch-in) (define-values (ch ch-in) (place-channel))
(loop)))))) (let loop ()
(place-channel-put lock-ch-in ch)
(place-channel-get ch-in)
(place-channel-get ch-in)
(loop)))))))
(define (call-with-lock lock thunk) (define (call-with-lock lock thunk)
(lock 'lock) (lock 'lock)
(dynamic-wind (dynamic-wind