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

Provide access to subprocess-based parallel builds even when places
are available.

pkgs/racket-doc/scribblings/raco/make.scrbl

@@ -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.}]}
 
 @; ----------------------------------------------------------------------
 

pkgs/racket-doc/scribblings/raco/setup.scrbl

@@ -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}.}]
 
 @; ------------------------------------------------------------------------
 

pkgs/racket-index/setup/scribble.rkt

@@ -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!)

racket/collects/setup/option.rkt

@@ -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)

racket/collects/setup/parallel-build.rkt

@@ -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))

racket/collects/setup/parallel-do.rkt

@@ -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)))]))
 
 

racket/collects/setup/setup-cmdline.rkt

@@ -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"

racket/collects/setup/setup-core.rkt

@@ -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)

racket/src/cs/README.txt

@@ -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

racket/src/io/port/fd-port.rkt

@@ -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)