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

add support for thread-safe compilation to compiler/cm (and use it in drracket)

Browse Source
This commit is contained in:
Robby Findler 2011-07-30 08:57:45 -04:00
parent 085b497b1c
commit a672704e5e
3 changed files with 98 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

59
collects/compiler/cm.rkt
View File

@ -1,14 +1,15 @@
#lang scheme/base
#lang racket/base
(require syntax/modcode
syntax/modresolve
syntax/modread
setup/main-collects
unstable/file
scheme/file
scheme/list
scheme/path
racket/file
racket/list
racket/path
racket/promise
openssl/sha1)
openssl/sha1
racket/place)
(provide make-compilation-manager-load/use-compiled-handler
managed-compile-zo
@ -22,7 +23,10 @@
get-file-sha1
get-compiled-file-sha1
with-compile-output
parallel-lock-client)
parallel-lock-client
make-compile-lock
compile-lock->parallel-lock-client)
(define manager-compile-notify-handler (make-parameter void))
(define trace (make-parameter void))
@ -649,3 +653,46 @@
(define (get-file-sha1 path)
(get-source-sha1 path))
(define (make-compile-lock)
(define-values (manager-side-chan build-side-chan) (place-channel))
(struct pending (response-chan bytes))
(define currently-locked-files (make-hash))
(define pending-requests '())
(thread
(λ ()
(let loop ()
(define req (place-channel-get manager-side-chan))
(define command (list-ref req 0))
(define bytes (list-ref req 1))
(define response-manager-side (list-ref req 2))
(cond
[(eq? command 'lock)
(cond
[(hash-ref currently-locked-files bytes #f)
(set! pending-requests (cons (pending response-manager-side bytes)
pending-requests))
(loop)]
[else
(hash-set! currently-locked-files bytes #t)
(place-channel-put response-manager-side #t)
(loop)])]
[(eq? command 'unlock)
(define (same-bytes? pending) (equal? (pending-bytes pending) bytes))
(define to-unlock (filter same-bytes? pending-requests))
(set! pending-requests (filter (compose not same-bytes?) pending-requests))
(for ([pending (in-list to-unlock)])
(place-channel-put (pending-response-chan pending) #f))
(hash-remove! currently-locked-files bytes)
(loop)]))))
build-side-chan)
(define (compile-lock->parallel-lock-client build-side-chan)
(λ (command zo-path)
(define-values (response-builder-side response-manager-side) (place-channel))
(place-channel-put build-side-chan (list command zo-path response-manager-side))
(when (eq? command 'lock)
(place-channel-get response-builder-side))))

8
collects/drracket/private/module-language.rkt
View File

@ -271,6 +271,7 @@
(cons (build-path "compiled" "drracket" "errortrace")
(use-compiled-file-paths)))]))
(parallel-lock-client module-language-parallel-lock-client)
(current-load/use-compiled (make-compilation-manager-load/use-compiled-handler #t))
(let* ([cd (find-collects-dir)]
[no-dirs (if cd
@ -872,4 +873,9 @@
[else
(loop (+ pos 1))]))))
(super-new))))
(super-new)))
(define module-language-parallel-lock-client
(compile-lock->parallel-lock-client
(make-compile-lock))))

44
collects/scribblings/raco/make.scrbl
View File

@ -273,6 +273,7 @@ A parameter whose value is called for each file that is loaded and
@racket[#f], then the file is compiled as usual. The default is
@racket[(lambda (x) #f)].}
@defproc[(file-stamp-in-collection [p path?]) (or/c (cons/c number? promise?) #f)]{
Calls @racket[file-stamp-in-paths] with @racket[p] and
@racket[(current-library-collection-paths)].}
@ -321,12 +322,25 @@ windows, @racket[with-compile-output] creates a second temporary file
@racket[tmp-path2], renames @racket[p] to @racket[tmp-path2], renames
@racket[tmp-path] to @racket[p], and finally deletes @racket[tmp-path2].}
@defparam[parallel-lock-client proc ([command (or/c 'lock 'unlock)] [zo-path bytes?] . -> . boolean?)]{
@defparam[parallel-lock-client proc
(or/c #f
(->i ([command (or/c 'lock 'unlock)]
[file bytes?])
[res (command) (if (eq? command 'lock)
boolean?
void?)]))]{
Holds the parallel compilation lock client, which prevents compilation races
between parallel builders. The @racket[proc] function takes a command argument
of either @racket['lock] or @racket['unlock]. The @racket[zo-path] argument
specifies the path of the zo for which compilation should be locked.
Holds the parallel compilation lock client, which
is used by the result of @racket[make-compilation-manager-load/use-compiled-handler] to
prevent compilation races between parallel builders.
When @racket[proc] is @racket[#f] (the default), no checking for parallel
compilation is done (and thus multiple threads or places running compilations
via @racket[make-compilation-manager-load/use-compiled-handler] will potentially
corrupt each other's @filepath{.zo} files).
When @racket[proc] is a function, its first argument is a command, indicating
if it wants to lock or unlock the path specified in the second argument.
When the @racket[proc] @racket['lock] command returns @racket[#t], the current
builder has obtained the lock for @racket[zo-path].
@ -336,7 +350,9 @@ release the lock by calling @racket[proc] @racket['unlock] with the exact same
When the @racket[proc] @racket['lock] command returns @racket[#f], another
parallel builder obtained the lock first and has already compiled the zo. The
parallel builder should continue without compiling @racket[zo-path].
parallel builder should continue without compiling @racket[zo-path].
(In this case, @racket[make-compilation-manager-load/use-compiled-handler]'s
result will not call @racket[proc] with @racket['unlock].)
@examples[
#:eval cm-eval
@ -354,6 +370,22 @@ parallel builder should continue without compiling @racket[zo-path].
(lc 'unlock zo-name)))))
]
}
@defproc[(compile-lock->parallel-lock-client [pc place-channel?])
(-> (or/c 'lock 'unlock) bytes? boolean?)]{
Returns a function that follows the @racket[parallel-lock-client]
by communicating over @racket[pc]. The argument must have
be the result of @racket[make-compile-lock].
}
@defproc[(make-compile-lock) place-channel?]{
Creates a @racket[place-channel?] that can be used with
@racket[compile-lock->parallel-lock-client] to avoid concurrent
compilations of the same racket source files in multiple places.
}
@; ----------------------------------------------------------------------
@section[#:tag "api:parallel-build"]{API for Parallel-Build}