raco setup: add --places and --processes flags

Provide access to subprocess-based parallel builds even when places
are available.
This commit is contained in:
Matthew Flatt 2018-09-11 14:58:23 -06:00
parent dabbfed09f
commit fd730a6772
10 changed files with 68 additions and 28 deletions

View File

@ -583,6 +583,7 @@ field is a @racket[compile-event] as documented in
@defproc[(parallel-compile-files [list-of-files (listof path-string?)]
[#:worker-count worker-count exact-positive-integer? (processor-count)]
[#:use-places? use-places? any/c #t]
[#:handler handler (->i ([_worker-id exact-integer?]
[_handler-type symbol?]
[_path path-string?]
@ -596,7 +597,9 @@ field is a @racket[compile-event] as documented in
The @racket[parallel-compile-files] utility function is used by @exec{raco make} to
compile a list of paths in parallel. The optional
@racket[#:worker-count] argument specifies the number of compile workers to spawn during
parallel compilation. The callback, @racket[handler], is called with the symbol
parallel compilation. The compile workers are implemented as Racket places if @racket[use-places?]
is true, otherwise the compile workers are implemented as separate
Racket processes. The callback, @racket[handler], is called with the symbol
@racket['done] as the @racket[_handler-type] argument for each successfully compiled file,
@racket['output] when a
successful compilation produces stdout/stderr output, @racket['error] when a
@ -617,7 +620,8 @@ The return value is @racket[(void)] if it was successful, or @racket[#f] if ther
msg
out
err)])))]
}
@history[#:changed "7.0.0.19" @elem{Added the @racket[#:use-places?] argument.}]}
@defproc[(parallel-compile
[worker-count non-negative-integer?]
@ -631,12 +635,16 @@ The return value is @racket[(void)] if it was successful, or @racket[#f] if ther
[_err string?]
[_message string?])
void?)]
[collects-tree (listof any/c)]) (void)]{
[collects-tree (listof any/c)]
[#:use-places? use-places? any/c #t])
(void)]{
The @racket[parallel-compile] function is used by @exec{raco setup} to
compile collections in parallel. The @racket[worker-count] argument
specifies the number of compilation workers to spawn during parallel
compilation. The @racket[setup-fprintf] and @racket[append-error]
compilation. The @racket[use-places?] argument specified whether
to use places, otherwise separate processes
are used. The @racket[setup-fprintf] and @racket[append-error]
functions communicate intermediate compilation results and errors. The
@racket[collects-tree] argument is a compound data structure containing
an in-memory tree representation of the collects directory.
@ -647,7 +655,8 @@ second string is a short form (omitting evaluation context
information, for example).
@history[#:changed "6.1.1.8" @elem{Changed @racket[append-error] to allow
a pair of error strings.}]}
a pair of error strings.}
#:changed "7.0.0.19" @elem{Added the @racket[#:use-places?] argument.}]}
@; ----------------------------------------------------------------------

View File

@ -245,6 +245,12 @@ flags:
uses @racket[(processor-count)] jobs, which typically uses
all of the machine's processing cores.}
@item{@DFlag{places} --- use Racket places for parallel jobs; this
mode is the default if Racket places run in parallel.}
@item{@DFlag{processes} --- use separate processes for parallel jobs;
this mode is the default if Racket places cannot run in parallel.}
@item{@DFlag{verbose} or @Flag{v} --- more verbose output about
@exec{raco setup} actions.}
@ -330,7 +336,8 @@ update a compiled file's timestamp if the file is not recompiled.
@DFlag{fail-fast} flags.}
#:changed "6.1.1" @elem{Added the @DFlag{force-user-docs} flag.}
#:changed "6.1.1.6" @elem{Added the @DFlag{only-foreign-libs} flag.}
#:changed "6.6.0.3" @elem{Added support for @envvar{PLT_COMPILED_FILE_CHECK}.}]
#:changed "6.6.0.3" @elem{Added support for @envvar{PLT_COMPILED_FILE_CHECK}.}
#:changed "7.0.0.19" @elem{Added @DFlag{places} and @DFlag{processes}.}]
@; ------------------------------------------------------------------------

View File

@ -137,6 +137,7 @@
(define (setup-scribblings
worker-count ; number of cores to use to create documentation
use-places? ; use places when available?
program-name ; name of program that calls setup-scribblings
only-dirs ; limits doc builds
latex-dest ; if not #f, generate Latex output
@ -302,7 +303,7 @@
;; If places are not available, then tasks will be run
;; in separate OS processes, and we can do without an
;; extra lock.
(when (place-enabled?)
(when use-places?
(set!-values (lock-ch lock-ch-in) (place-channel))
(thread (lambda ()
(define-values (ch ch-in) (place-channel))
@ -343,7 +344,8 @@
(append
(map (make-sequential-get-info #f)
(take docs num-sequential))
(parallel-do
(parallel-do
#:use-places? use-places?
(min worker-count (length (list-tail docs num-sequential)))
(lambda (workerid)
(init-lock-ch!)
@ -664,7 +666,8 @@
(prep-info! i)
(update-info! i (build-again! latex-dest i with-record-error no-lock
main-doc-exists?)))
(parallel-do
(parallel-do
#:use-places? use-places?
(min worker-count (length need-rerun))
(lambda (workerid)
(init-lock-ch!)

View File

@ -1,5 +1,8 @@
#lang racket/base
(require racket/future)
(require (only-in racket/future
processor-count)
(only-in racket/place
place-enabled?))
;; other params are provided by declaration
(provide call-with-flag-params
@ -57,6 +60,7 @@
(if (fixnum? (arithmetic-shift 1 40))
8 ; 64-bit machine
4))) ; 32-bit machine
(define-flag-param parallel-use-places (place-enabled?))
(define-flag-param verbose #f)
(define-flag-param make-verbose #f)
(define-flag-param compiler-verbose #f)

View File

@ -4,7 +4,6 @@
racket/list
racket/match
racket/path
racket/fasl
racket/serialize
"private/cc-struct.rkt"
setup/parallel-do
@ -261,9 +260,10 @@
(define/public (get-results) results)
(super-new)))
(define (parallel-build work-queue worker-count)
(define (parallel-build work-queue worker-count #:use-places? use-places?)
(define do-log-forwarding (log-level? pb-logger 'info 'setup/parallel-build))
(parallel-do
#:use-places? use-places?
worker-count
(lambda (workerid) (list workerid do-log-forwarding))
work-queue
@ -350,19 +350,23 @@
(define (parallel-compile-files list-of-files
#:worker-count [worker-count (processor-count)]
#:handler [handler void]
#:options [options '()])
#:options [options '()]
#:use-places? [use-places? #t])
(unless (exact-positive-integer? worker-count)
(raise-argument-error 'parallel-compile-files "exact-positive-integer?" worker-count))
(unless (and (list? list-of-files) (andmap path-string? list-of-files))
(raise-argument-error 'parallel-compile-files "(listof path-string?)" list-of-files))
(unless (and (procedure? handler) (procedure-arity-includes? handler 6))
(raise-argument-error 'parallel-compile-files "(procedure-arity-includes/c 6)" handler))
(parallel-build (make-object file-list-queue% list-of-files handler options) worker-count))
(parallel-build (make-object file-list-queue% list-of-files handler options) worker-count
#:use-places? use-places?))
(define (parallel-compile worker-count setup-fprintf append-error collects-tree)
(define (parallel-compile worker-count setup-fprintf append-error collects-tree
#:use-places? [use-places? #t])
(setup-fprintf (current-output-port) #f "--- parallel build using ~a jobs ---" worker-count)
(define collects-queue (make-object collects-queue% collects-tree setup-fprintf append-error '(set-directory)))
(parallel-build collects-queue worker-count))
(parallel-build collects-queue worker-count
#:use-places? use-places?))
(define (start-prefetch-thread send/add)
(define pf (make-log-receiver (current-logger) 'info 'module-prefetch))

View File

@ -4,7 +4,6 @@
racket/future
racket/place
racket/port
racket/fasl
racket/match
racket/path
racket/class
@ -189,9 +188,8 @@
(path->complete-path p (or (path-only (current-executable-path))
(find-system-path 'orig-dir))))))
(define (parallel-do-event-loop module-path funcname initialmsg work-queue nprocs [stopat #f])
(define use-places? (place-enabled?)) ; set to #f to use processes instead of places
(define (parallel-do-event-loop module-path funcname initialmsg work-queue nprocs [stopat #f]
#:use-places? use-places?)
(define (spawn id)
;; spawns a new worker
(define wrkr (if use-places? (new place-worker%) (new worker%)))
@ -472,13 +470,14 @@
(define-syntax (parallel-do stx)
(syntax-case stx (define-worker)
[(_ worker-count initalmsg work-queue (define-worker (name args ...) body ...))
[(_ #:use-places? use-places?
worker-count initalmsg work-queue (define-worker (name args ...) body ...))
(begin
(with-syntax ([interal-def-name (syntax-local-lift-expression #'(lambda-worker (args ...) body ...))])
(syntax-local-lift-provide #'(rename interal-def-name name)))
#'(let ([wq work-queue])
(define module-path (path->string (resolved-module-path-name (variable-reference->resolved-module-path (#%variable-reference)))))
(parallel-do-event-loop module-path 'name initalmsg wq worker-count)
(parallel-do-event-loop module-path 'name initalmsg wq worker-count #:use-places? use-places?)
(queue/results wq)))]))

View File

@ -130,6 +130,12 @@
#:once-each
[("-j" "--jobs" "--workers") n "Use <n> parallel jobs"
(add-flags `((parallel-workers ,(string->number n))))]
#:once-any
[("--places") "Use places for parallel jobs"
(add-flags `((parallel-use-places #t)))]
[("--processes") "Use processes for parallel jobs"
(add-flags `((parallel-use-places #f)))]
#:once-each
[("-v" "--verbose") "See names of compiled files and info printfs"
(add-flags '((verbose #t)))]
[("-m" "--make-verbose") "See make and compiler usual messages"

View File

@ -1113,7 +1113,8 @@
(collection-tree-map top-level-plt-collects
has-module-suffix?)))))
(iterate-cct clean-cc cct)
(parallel-compile (parallel-workers) setup-fprintf handle-error cct)
(parallel-compile (parallel-workers) setup-fprintf handle-error cct
#:use-places? (parallel-use-places))
(for/fold ([gcs 0]) ([cc planet-dirs-to-compile])
(compile-cc cc gcs has-module-suffix?)))))
(with-specified-mode
@ -1361,6 +1362,7 @@
(define (doc:setup-scribblings latex-dest auto-start-doc?)
(scr:call 'setup-scribblings
(parallel-workers)
(parallel-use-places)
name-str
(if no-specific-collections? #f (map cc-path ccs-to-compile))
latex-dest auto-start-doc? (make-user) (force-user-docs)

View File

@ -313,9 +313,9 @@ Threads, Threads, Atomicity, Atomicity, and Atomicity
Racket's thread layer does not use Chez Scheme threads. Chez Scheme
threads correspond to OS threads. Racket threads are implemented in
terms of engines at the Rumble layer. At the same time, futures and
places will use Chez Scheme threads, and so parts of Rumble are meant
to be thread-safe with respect to Chez Scheme and OS threads. The FFI
also exposes elements of Chez Scheme / OS threads.
places use Chez Scheme threads, and so parts of Rumble are meant to be
thread-safe with respect to Chez Scheme and OS threads. The FFI also
exposes elements of Chez Scheme / OS threads.
As a result of these layers, there are multiple ways to implement
atomic regions:
@ -386,6 +386,11 @@ Status and Thoughts on Various Racket Subsystems
* The Racket and Chez Scheme numeric systems likely differ in some
ways, and I don't know how much work that will be.
* Places are implemented as Chez Scheme threads. Possibly because a
GC is stop-the-world across all threads, however, this
implementation currently does not scale as much as the traditional
Racket implementation's places.
* For futures, Chez Scheme exposes OS-level threads with limited
safety guarantees. An implementation of futures can probably take
advantage of threads with thread-unsafe primitives wrapped to
@ -399,7 +404,7 @@ Status and Thoughts on Various Racket Subsystems
* For now, `make setup` builds platform-specific ".zo" files in a
subdirectory of "compiled" named by the Chez Scheme platform name
(e.g., "a6osx"). Longer term, although bytecode as it currently
(e.g., "ta6osx"). Longer term, although bytecode as it currently
exists goes away, platform-independent ".zo" files might contain
fully expanded source (possibly also run through Chez Scheme's
source-to-source optimizer) with `raco setup` gaining a new step in

View File

@ -107,7 +107,8 @@
(define flush-handle
(plumber-add-flush! plumber
(lambda (h)
(flush-buffer-fully #f))))
(atomically
(flush-buffer-fully #f)))))
(when (eq? buffer-mode 'infer)
(if (rktio_fd_is_terminal rktio fd)